| 1 | PRSATAPE ; HISC/FPT-Load 8B's onto Tape ;8/17/95 08:43
|
|---|
| 2 | ;;4.0;PAID;;Sep 21, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; HEADER = header for tape
|
|---|
| 5 | ; IEN = employee's internal entry number (file 450)
|
|---|
| 6 | ; LENGTH = length of record
|
|---|
| 7 | ; LOOP = 'for' loop variable
|
|---|
| 8 | ; MSGCNT = mail message count
|
|---|
| 9 | ; NAME = employee's name
|
|---|
| 10 | ; PPIEN = pay period internal entry number (file 458)
|
|---|
| 11 | ; RECCNT = number of 8b records
|
|---|
| 12 | ; RECORD = 8b record
|
|---|
| 13 | ; STUB = characters 1-32 of the 8b record
|
|---|
| 14 | ; SN = station number
|
|---|
| 15 | ;
|
|---|
| 16 | Q
|
|---|
| 17 | TAPE ; make a tape of 8b records
|
|---|
| 18 | S PPIEN=$P($G(^PRST(458,0)),U,3) I PPIEN<1 D KILL Q
|
|---|
| 19 | K DIC S DIC="^PRST(458,",DIC(0)="AEMQZ",DIC("B")=$P(^PRST(458,PPIEN,0),U,1) D ^DIC K DIC I +Y<1 D KILL Q
|
|---|
| 20 | S PPIEN=+Y
|
|---|
| 21 | K %ZIS S %ZIS("A")="Select TAPE Device: ",%ZIS("B")="",%ZIS="M" D ^%ZIS K %ZIS I POP D KILL,HOME^%ZIS Q
|
|---|
| 22 | U IO D LOAD D ^%ZISC,KILL Q
|
|---|
| 23 | LOAD ; load records onto tape
|
|---|
| 24 | S SN=$P($G(^XMB(1,1,"XUS")),"^",17),SN=$S(+SN>0:$P($G(^DIC(4,SN,99)),"^",1),1:"")
|
|---|
| 25 | S XMSUB=^DD("SITE")_" ("_SN_") PAYROLL DATA (PAY PERIOD "_$P($P(^PRST(458,PPIEN,0),U),"-",2)_")"
|
|---|
| 26 | S XMSUB=XMSUB_$J("",80-$L(XMSUB)),XMSUB=$E(XMSUB,1,80) U IO W XMSUB
|
|---|
| 27 | S (IEN,RECCNT)=0
|
|---|
| 28 | F S IEN=$O(^PRST(458,PPIEN,"E",IEN)) Q:IEN<1 D PROCESS I RECCNT#100=0 U IO(0) W "."
|
|---|
| 29 | U IO W "*** END ***"_$J("",69)
|
|---|
| 30 | Q
|
|---|
| 31 | PROCESS ; write records onto tape
|
|---|
| 32 | I '$D(^PRST(458,PPIEN,"E",IEN,5)) S NAME=$P($G(^PRSPC(IEN,0)),U,1) U IO(0) W !,"Missing 8B Record for ",$S(NAME'="":NAME,1:IEN) K NAME Q
|
|---|
| 33 | S RECORD=^PRST(458,PPIEN,"E",IEN,5),STUB=$E(RECORD,1,32)
|
|---|
| 34 | AGAIN I $L(RECORD)<81 S RECCNT=RECCNT+1 U IO W RECORD_$J("",80-$L(RECORD)) K LENGTH,RECORD,STUB Q
|
|---|
| 35 | F LENGTH=80:-1:33 Q:$E(RECORD,LENGTH-1,LENGTH)?2U
|
|---|
| 36 | U IO W $E(RECORD,1,LENGTH-2)_$J("",80-(LENGTH-2)) S RECCNT=RECCNT+1,RECORD=STUB_$E(RECORD,LENGTH-1,$L(RECORD)) G AGAIN
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | MAIL ; move 8b tape data into mail messages
|
|---|
| 40 | K %ZIS S %ZIS("A")="Select TAPE Device: ",%ZIS("B")="",%ZIS="M" D ^%ZIS K %ZIS I POP D KILL,HOME^%ZIS Q
|
|---|
| 41 | S (MSGCNT,RECCNT)=0 U IO R HEADER:60 D M1 D ^%ZISC
|
|---|
| 42 | W !!,RECCNT," Records / ",MSGCNT," Messages",!
|
|---|
| 43 | KILL K %ZIS,HEADER,IEN,LOOP,MSGCNT,POP,PPIEN,RECCNT,SN,X,XMDUZ,XMSUB,XMTEXT,XMY,Y
|
|---|
| 44 | Q
|
|---|
| 45 | M1 ; move 8b records to mail messages
|
|---|
| 46 | K ^TMP($J) U IO F LOOP=1:1:175 R X:60 G:'$T!(X["*** END") M2 S ^TMP($J,LOOP,0)=X,RECCNT=RECCNT+1
|
|---|
| 47 | D M3 G M1
|
|---|
| 48 | M2 I $D(^TMP($J)) D M3 K ^TMP($J)
|
|---|
| 49 | Q
|
|---|
| 50 | M3 U IO(0) S XMY("XXX@Q-TAB.VA.GOV")="" U IO(0) W "."
|
|---|
| 51 | S XMSUB=HEADER
|
|---|
| 52 | S XMTEXT="^TMP($J,",XMDUZ=.5 D ^XMD S MSGCNT=MSGCNT+1
|
|---|
| 53 | Q
|
|---|
