home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
chrchpr2.zip
/
CSETRANS.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1987-01-06
|
8KB
|
277 lines
* Program CSETRANS - Tracks transportation assignments
Select secondary
Store 'TRAN=' to infield
If len(MSEL) > 2
Store msel+' ' to msel
Store $(msel,2,5) to inlodg
Store infield+inlodg to sfield
Find &sfield
If #=0
Accept 'Transportation code not found. Press <return> ' to xx
RETURN
endif
else
? ' ',ename,' TRANSPORTATION names '+curdate
Find &INFIELD
If #=0
Accept 'No Transportation codes found. Enter them from Set Up. Press <retn>' ;
to xx
RETURN
endif
Store ' ' to romvalid
Set raw on
Do while spact=infield.and. .not. EOF
Store romvalid+$(spact,5,6) to romvalid
Store $(spact,1,11) to innf
? '[',$(spact,6,5),'] ',$(spact,11,28)
Do while (spact=innf.or.$(spact,11,1)='.').and. .not.EOF
SKIP
enddo
enddo
Store 'Y' to xsel
?
? 'VALID TRANSPORTATION CODES: ',romvalid
Set raw off
?
Accept ' Select a TRANSPORTATION code (5 characters) ' to inlodg
Store F to goodlodg
Do while .not. goodlodg
STORE INLODG+' ' to inlodg
Store $(inlodg,1,5) to inlodg
Store '='+inlodg to innlodge
Store T to goodlodg
If !(inlodg)='Q '
Store T to goodlodg
else
If @(innlodge,romvalid)=0
Accept 'Transportation code is not found. Enter another ' to inlodg
Store F to goodlodg
else
Store 'TRAN'+innlodge to sfield
Find &sfield
If #=0
Accept 'Transportation 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,5)+'] '+trim($(spact,11,28)) to romname
Store $(spact,1,11) 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
Store ' ' to inumbs
Store 0 to II
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
Store II+1 to II
@ I,J say str(II,2)
@ I,J+3 say $(spact,11,28)
Store inumbs+str(#,5) to inumbs
SKIP
store I+1 to I
If I=23
Store J+40 to J
Store 3 to I
endif
enddo
enddo
Store ' ' to xsel
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
Store F to nonams
SKIP
If spact<>sfield
Store T to nonams
endif
If nonams
Accept "No names are assigned to Transportation code. Press <retn>" to xx
else
? 'Now verifying EDIRFILE names against Transportation assignments in MEMBERSE'
? ;
'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,6,6) to sfind
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
If nfound
If transpor=sfind
? transpor,' ',nfind,ffind,' > > > VERIFIED < < <'
else
? transpor,' ',nfind,ffind,' Transportation does not match in MEMBERSE '
Select secondary
SKIP -1
Store str(#,5) to orec
SKIP
Replace spact with $(spact,1,10)+'.'
GOTO &orec
endif
else
? transpor,' ',nfind,ffind,' Name is not found in MEMBERSE.'
Select secondary
SKIP -1
Store str(#,5) to orec
SKIP
Replace spact with $(spact,1,10)+'.'
GOTO &OREC
endif
endif
Select secondary
SKIP
enddo
endif
endif
CASE !(xsel)='A'
If II>39
Accept 'Maximum Transportation assignments have been reached. Press <retn> to x
else
Select secondary
Store xsel+' ' to xsel
? 'Enter a new name for this Transportation code'
Select primary
Do CSECHECK.CMD
If FOUND
Store F to CHOLD
Store $(last:name,1,11)+' '+$(first:name,1,10) to names
If transpor = ' '
Store T to CHOLD
Replace transpor with $(sfield,6,5)
else
Store transpor to xx
Store 'TRAN='+transpor to nnfind
Store $(last:name,1,11)+' '+$(first:name,1,10) to names
Select secondary
Find &nnfind
If #=0 .or. names<>$(spact,12,22)
Store T to CHOLD
? nnfind,' is not valid for - ',names,'Now being replaced.'
Select primary
Replace transpor with ' '
else
? 'This name already has a Transportation. You must select another.'
endif
endif
else *FOUND
? 'No Transportation Name added.'
store F to chold
endif * FOUND
If CHOLD
Select secondary
Append blank
Store II+1 to II
? 'New Transportation assignment: ',$(sfield,6,5),' -->',names
Replace spact with sfield+names
endif
endif * valid "intrans"
CASE !(XSEL)='C' .or. !(XSEL)='D'
Do CSETCHNG.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)>59
Store $(xx,1,59) to xx
endif
@ 1,0 say xx
@ 1,62 say curdate
Store 1 to I
Store 0 to II
Store 3 to J
Store ' ' to inumbs
Store ' ' to xx
Store str(#,5) to irec
Store ' 0' to jrec
Do while I<21.and.spact=sfield.and..not.EOF
Store II+1 to II
Store xx+str(II,2) to xx
Store inumbs+str(#,5) to inumbs
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 $(xx,I*2,2)+$(spact,11,28)
SKIP
Store str(#,5) to irec
If jrec<>' 0'
Store II+1 to II
GOTO &jrec
Store inumbs+str(#,5) to inumbs
@ I,40 say str(I+18,2)+$(spact,11,28)
Store
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
RETURN
,irec,jrec
RETURN
c
RETURN
HOLD,irec,jrec
RETURN
Append blank
Store II+1 to II
? 'New Tr