home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
chrchpr2.zip
/
CSETCHNG.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1987-01-06
|
4KB
|
123 lines
* Program CSETCHNG - Changes or Deletes lodging Room/Bed assignments.
* Called by CSETRANS from selecting 3-C or 3-D CSEVENTS
* By Rod Williams; WaterWares, March, 1985.
Store xsel+' ' to xsel
Store $(xsel,2,5) to inbed
If inbed=' '
Accept "Enter a person's number " to inbed
endif
If !(inbed)<>'Q ' .and.inbed<>' '
Select secondary
Store val(inbed) to ixx
If ixx>II
? 'This number not assigned.'
else
Store $(inumbs,ixx*5,5) to oldrec
GOTO &oldrec
Store $(spact,1,10) to infind
Store $(spact,12,11) to nfind
Store trim($(spact,24,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
endif
If nfound
Store nfind+' '+ffind to nfind
Store 'for '+nfind to nnfind
else
Store ' ' to nnfind
endif
If !(xsel)='D'
? 'Now deleting -',nfind,' ... ',$(S.spact,1,10)
If nfound
Replace transpor with ' '
endif
Select secondary
Replace spact with $(spact,1,10)+'.'+$(spact,12,28)
DELETE
else
If nfound
Store F to chold
If transpor=$(infind,6,5) .or.transpor=' '
Store T to chold
else
? 'The Transportation assignment in MEMBERSE does not match for this person.'
Store sfield to sfieldx
Select secondary
Find &sfieldx
If #<>0
? 'The Name is cleared in the EDIRFILE. '
GOTO &oldrec
Replace spact with $(spact,1,10)+'.'
else
? "This person's Transportation is being re-assigned."
Store T to CHOLD
endif
endif
If CHOLD
Accept 'Enter a new Transportation assignment ' to inbed1
Store inbed1+' ' to inbed1
If !(inbed1)<>'Q ' .and. inbed1<>' '
Store T to RBCHANGE
Store F to RBAPPEND
Store sfield to sfieldx
Select secondary
Store 'TRAN='+$(inbed1,1,5)+' ' to xx
Find &xx
If #=0
? 'This Transportation name, "',$(inbed1,1,5),'" not found. No change made.'
Store F to RBCHANGE
else
Store T to RBAPPEND
endif
If RBCHANGE
? 'Now replacing',infind,'with',xx,nnfind
Select primary
Replace transpor with inbed1
Select secondary
GOTO &oldrec
Replace spact with $(spact,1,4)+'>'
If RBAPPEND
Append blank
Store II+1 to II
Replace spact with xx+nfind
endif
endif * RBCHANGE
endif
endif
else
Set raw on
? 'Name "',nfind,ffind,'" is not found in MEMBERSE. Now cleared from EDIRFILE.'
Set raw off
Select secondary
GOTO &OLDREC
Replace spact with $(spact,1,10)+'.'
DELETE
endif
endif
endif * #=0
endif
Store 'C' to xsel
RETURN
N
Store 'C' to xsel
RETURN
Find &NFIND
If #<>0
Do while last:name=nfind .and. first:name<>ffind.and. .not. EOF
SKIP
enddo
If last:name=nfind.and. first