home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
chrchpr2.zip
/
CSELODGE.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1987-01-06
|
8KB
|
294 lines
* Program CSELODGE - Tracks lodging assignments
Select secondary
Store 'ROOM=' to infield
If len(MSEL) > 1
Store msel+' ' to msel
Store $(msel,2,3) to inlodg
Store infield+inlodg to sfield
Find &sfield
If #=0
Accept 'Lodging code not found. Press <return> ' to xx
RETURN
endif
else
? ' ',ename,' LODGING names '+curdate
Find &INFIELD
If #=0
Accept 'No Lodgings found. You must enter some from SET UP. Press <retn>' to XX
RETURN
endif
Store ' ' to romvalid
Set raw on
Do while spact=infield
Store romvalid+$(spact,5,4) to romvalid
Store $(spact,1,9) to innf
? '[',$(spact,6,3),'] ',$(spact,9,30)
Do while spact=innf.or.$(spact,9,1)='.'
SKIP
enddo
enddo
Store 'Y' to xsel
?
? 'VALID LODGING CODES: ',romvalid
Set raw off
?
Accept ' Select a Lodging code (3 characters) ' to inlodg
Store F to goodlodg
Do while .not. goodlodg
Store $(inlodg,1,3) to inlodg
Store '='+inlodg to innlodge
Store T to goodlodg
If !(inlodg)='Q' .and. len(inlodg)=1
Store T to goodlodg
Store 'Q ' to inlodg
else
If @(innlodge,romvalid)=0
Accept 'Lodging code is not found. Enter another ' to inlodg
Store F to goodlodg
else
Store 'ROOM'+innlodge to sfield
Find &sfield
If #=0
Accept 'Lodging code is not found. Enter another' to inlodg
Store 'n' to xsel
Store F to goodlodg
endif
endif
endif
enddo
endif
If inlodg<>'Q '
Store '['+$(spact,6,3)+'] '+trim($(spact,9,30)) to romname
Store $(spact,1,9) to sfield
Release inlodg,romvalid,goodlodg,innlodge,innf
Store ' ' to xsel
Store str(#,5) to xrec
Do while !(xsel)<>'Q'
Select secondary
GOTO &xrec
SKIP
Erase
@ 1,0 say ROMNAME+' '+ename
@ 1,64 say curdate
Store 3 to I
Store 3 to J
Do while spact=sfield .and. .not. EOF
Store 3 to I
Store 3 to J
Do while J<80 .and. spact=sfield .and. .not. EOF
@ I,J say $(spact,9,30)
SKIP
store I+1 to I
If I=23
Store J+40 to J
Store 3 to I
endif
enddo
enddo
Store ' ' to xsel
Store I-3 to II
If J=43
Store II+20 to II
endif
Do while !(xsel)<>'Q'.and.!(xsel)<>'S'
@ 22,78 say ' '
Accept ;
'Select: A]dd C]hange D]elete R]eport S]creen V]erify Q]uit ' ;
to xsel
Do CASE
CASE !(xsel)='V'
Select secondary
GOTO &xrec
SKIP
If spact<>sfield
Accept "No names are assigned to this Lodging. Press <retn>" to xx
else
? 'Now verifying EDIRFILE names against Lodging assignments in MEMBERSE.'
?? date()
? 'This routine clears any names in the EDIRFILE that do not match in MEMBERSE'
Accept 'OK? ' to xx
If !(xx)='Y'
Do while spact=sfield
Store $(spact,15,11) to nfind
Store trim($(spact,27,10)) to ffind
Select primary
Store F to nfound
If NFIND<>' '
Find &NFIND
If #<>0
Do while last:name=nfind .and. first:name<>ffind.and. .not. EOF
SKIP
enddo
If last:name=nfind.and. first:name=ffind
Store T to nfound
endif
endif
If nfound
If $(S.spact,6,9)=room
? room,' ',nfind,ffind,' > > > VERIFIED < < <'
else
? room,' ',nfind,ffind,' Lodging does not match in MEMBERSE '
Select secondary
SKIP -1
Store str(#,5) to orec
SKIP
Replace spact with $(spact,1,14)
GOTO &orec
endif
else
? ' ',nfind,ffind,' Name is not found in MEMBERSE.'
Select secondary
SKIP -1
Store str(#,5) to orec
SKIP
Replace spact with $(spact,1,14)
GOTO &OREC
endif
endif
Select secondary
SKIP
enddo
endif
CASE !(xsel)='A'
If II>39
Accept 'Maximum assignments for this Lodging have been reached. Press <retn>' ;
to xx
else
Select secondary
Store xsel+' ' to xsel
If $(xsel,2,5)=' '
Accept 'Enter a Room/Bed assignment ' to inbed
Store inbed+' ' to inbed
else
Store $(xsel,2,5) to inbed
Store 'A ' to xsel
endif
Store $(inbed,1,5) to inbed
If !(inbed)<>'Q ' .and. inbed<>' '
Store ' ' to names
Store T to RBCHANGE
Store F to RBAPPEND
Store sfield+inbed to infind
Find &infind
If #<>0
Store str(#,5) to oldrec
If $(spact,15,10)<>' '
? 'This Room/Bed code found with name - ',$(spact,15,22)
? 'No Add made.'
Store F to RBCHANGE
endif
else
Store T to RBappend
endif
If RBCHANGE
? 'Enter a new name for this Room/Bed.'
Select primary
Do CSECHECK.CMD
If FOUND
Store F to CHOLD
Store $(last:name,1,11)+' '+$(first:name,1,10) to names
If ROOM = ' '
Store T to CHOLD
Replace room with $(infind,6,9)
else
Store $(room,5,5) to xx
Store 'ROOM='+room to nnfind
Store $(last:name,1,11)+' '+$(first:name,1,10) to names
Select secondary
Find &nnfind
If #=0 .or. names<>$(spact,15,22)
Store T to CHOLD
? nnfind,' is not valid for - ',names,'Now being replaced.'
Select primary
Replace room with ' '
else
? 'This name already has a Room/Bed. You must select another.'
endif
endif
else
? 'This Room/Bed is added without a name.'
store T to chold
store T to RBAPPEND
endif * FOUND
If CHOLD
Select secondary
If RBappend
Append blank
Store II+1 to II
else
GOTO &oldrec
endif
? 'New Room/Bed assignment: ',$(infind,6,9),'-->',names
Replace spact with infind+names
endif
endif * #<>0
endif * valid "inbed"
Store 'A' to xsel
CASE !(XSEL)='C' .or. !(XSEL)='D'
Do CSELCHNG.CMD
CASE !(xsel)='R'
Release inbed,nnfind,ffind,oldrec,chold
GOTO &xrec
SKIP
Set format to print
Store ROMNAME+' '+ename to xx
If len(xx)>60
Store $(xx,1,60) to xx
endif
@ 1,0 say xx
@ 1,62 say curdate
Store 1 to I
Store 3 to J
Store str(#,5) to irec
Store ' 0' to jrec
Do while I<21.and.spact=sfield.and..not.EOF
SKIP
Store I+1 to I
enddo
If spact=sfield
Store str(#,5) to Jrec
endif
GOTO &IREC
Store 3 to I
Do while (spact=sfield .and. I<23) .and. .not. EOF
@ I,3 say $(spact,9,30)
SKIP
Store str(#,5) to irec
If jrec<>' 0'
GOTO &jrec
@ I,40 say $(spact,9,30)
SKIP
Store str(#,5) to jrec
If spact<>sfield
Store ' 0' to jrec
endif
endif
Store I+1 to I
GOTO &IREC
enddo
EJECT
Set format to screen
CASE !(xsel)='Q' .or.!(xsel)='S' .or. xsel=' '
otherwise
? 'Invalid entry. Please enter again '
endcase
?
enddo
enddo
endif
Release infield,romname,sfield,xrec,I,J,nobed,inbed,infind,found,names
Release nfind,nnfind,ffind,nfound,oldrec,CHOLD,irec,jrec
RETURN
r. !(XSEL)='D'
Do CSELCHNG.CMD
CASE !(xsel)='R'
Release inbed,nnfind,ffind,oldrec,chold
GOTO &xrec
SKIP
Set format to print
Store ROMNAME+' '+ename to xx
If len(xx)>60
Store $(xx,1,60) to xx
endif
@ 1,0 say xx