PRSAXMIT ; HISC/FPT-Transmit 8B Records ;8/17/95 08:45
;;4.0;PAID;;Sep 21, 1995
; VARIABLES USED
; --------- ----
; EMPCNT = number of employees processed
; IEN = employee's internal entry number (file 450)
; LENGTH = length of 8b record
; LOOP = for loop variable
; PPE = pay period
; PPI = pay period internal entry number
; RECCNT = number of records per message
; RECORD = 8b record
; STUB = characters 1 thru 32 of the 8b record
; SN = station number
; TLE = t&l unit number
; TLI = t&l unit internal entry number (#455.5)
; TRECCNT = total number of records transmitted
;
; ARRAYS USED
; ------ ----
; ^TMP($J) = 8b records that will be passed to xmtext
; ^TMP("PRSA",$J) = employee iens (used to change status of record)
;
K DIC S DIC="^PRST(458,",DIC(0)="AEMQZ" S PPI=$P($G(^PRST(458,0)),U,3) I PPI<1 D KILL Q
S DIC("B")=$P(^PRST(458,PPI,0),U,1) D ^DIC K DIC I +Y<1 D KILL Q
S PPI=+Y D CHECK G:YN["^" KILL
S PPE=$P($P(^PRST(458,PPI,0),U),"-",2)
K DIR S DIR(0)="Y",DIR("A")="Ready to Transmit to Austin",DIR("B")="NO"
W ! D ^DIR K DIR I $D(DIRUT)!(Y=0) D KILL Q
W !!,"Transmitting to Austin "
K ^TMP("PRSA",$J),^TMP($J)
S (EMPCNT,IEN,RECCNT,TRECCNT)=0
F S IEN=$O(^PRST(458,PPI,"E",IEN)) Q:IEN'>0 I $P($G(^PRST(458,PPI,"E",IEN,0)),U,2)="P" D PROCESS D:RECCNT>174 MAIL
D:RECCNT>0 MAIL
S X="N",%DT="XT" D ^%DT S NOW=+Y K %DT
I EMPCNT>0 S $P(^PRST(458,PPI,0),U,2)=DUZ,$P(^PRST(458,PPI,0),U,3)=NOW,$P(^PRST(458,PPI,0),U,4)=$P(^PRST(458,PPI,0),U,4)+EMPCNT,$P(^PRST(458,PPI,0),U,5)=$P(^PRST(458,PPI,0),U,5)+TRECCNT
;
W !!,EMPCNT," Employees Processed",!
KILL K DIR,DIROUT,DIRUT,DTOUT,DUOUT,EMPCNT,IEN,NOW,PPE,PPI,RECCNT,RECORD,SN,TLE,TLI,TRECCNT,X,Y Q
;
PROCESS ;
S RECORD=$G(^PRST(458,PPI,"E",IEN,5))
I RECORD="" W !,"8B record is missing for ",$P($G(^PRSPC(IEN,0)),U,1) Q
S TLE=$E(RECORD,22,24)
S EMPCNT=EMPCNT+1,STUB=$E(RECORD,1,32)
AGAIN I $L(RECORD)<81 S RECCNT=RECCNT+1,^TMP($J,RECCNT)=RECORD_$J("",80-$L(RECORD)) W:RECCNT#100=1 "." S ^TMP("PRSA",$J,IEN)="" K LENGTH,RECORD,STUB Q
F LENGTH=80:-1:33 Q:$E(RECORD,LENGTH-1,LENGTH)?2U
S RECCNT=RECCNT+1,^TMP($J,RECCNT)=$E(RECORD,1,LENGTH-2)_$J("",80-(LENGTH-2)),RECORD=STUB_$E(RECORD,LENGTH-1,$L(RECORD)) G AGAIN
Q
;
MAIL ; call MailMan
S XMDUZ=.5
S XMY("G.TAB@"_^XMB("NETNAME"))=""
S XMY("XXX@Q-TAB.DOMAIN.EXT")=""
S SN=$P($G(^XMB(1,1,"XUS")),"^",17),SN=$S(+SN>0:$P($G(^DIC(4,SN,99)),"^",1),1:"")
S XMSUB=^DD("SITE")_" ("_SN_") Payroll Data (Pay Period "_PPE_")"
S XMTEXT="^TMP($J,",XMDUZ=.5 D ^XMD
I XMZ>0 D
.S LOOP=0 F S LOOP=$O(^TMP("PRSA",$J,LOOP)) Q:LOOP'>0 S $P(^PRST(458,PPI,"E",LOOP,0),U,2)="X"
.S:'$D(^PRST(458,PPI,"X",0)) ^PRST(458,PPI,"X",0)="^458.03P^^" K DIC,DD,DO S DIC="^PRST(458,PPI,""X"",",DIC(0)="L",DLAYGO=458,DA(1)=PPI,(X,DINUM)=XMZ D FILE^DICN K DIC,DINUM
.D NOW^%DTC
.S $P(^PRST(458,PPI,"X",+Y,0),U,2)=DUZ
.S $P(^PRST(458,PPI,"X",+Y,0),U,3)=%
.S TRECCNT=TRECCNT+RECCNT
S RECCNT=0
K %,^TMP("PRSA",$J),^TMP($J),DA,DD,DIC,DINUM,DLAYGO,DO,LOOP,X,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y,XMLOC,XMMG Q
CHECK ; Run 8B Edit Check
W !!,"Edit Checks will now be run ...",!
D CODES^PRSACED6 S YN="",COUNT=0,HDR=1
S ATL="ATL00" F S ATL=$O(^PRSPC(ATL)) Q:ATL'?1"ATL".E S TL=$E(ATL,4,6),NAM="" F S NAM=$O(^PRSPC(ATL,NAM)) Q:NAM="" F DFN=0:0 S DFN=$O(^PRSPC(ATL,NAM,DFN)) Q:DFN<1 D G:YN["^" AB
.I '$D(^PRST(458,PPI,"E",DFN,5)) Q
.I $P(^PRST(458,PPI,"E",DFN,0),"^",2)'="P" Q
.S COUNT=COUNT+1 D ^PRSACED1 W:COUNT#50=1 "." Q
Q
AB W !,"Edit Checks aborted. NO Transmission.",! Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAXMIT 3724 printed Nov 22, 2024@17:35:02 Page 2
PRSAXMIT ; HISC/FPT-Transmit 8B Records ;8/17/95 08:45
+1 ;;4.0;PAID;;Sep 21, 1995
+2 ; VARIABLES USED
+3 ; --------- ----
+4 ; EMPCNT = number of employees processed
+5 ; IEN = employee's internal entry number (file 450)
+6 ; LENGTH = length of 8b record
+7 ; LOOP = for loop variable
+8 ; PPE = pay period
+9 ; PPI = pay period internal entry number
+10 ; RECCNT = number of records per message
+11 ; RECORD = 8b record
+12 ; STUB = characters 1 thru 32 of the 8b record
+13 ; SN = station number
+14 ; TLE = t&l unit number
+15 ; TLI = t&l unit internal entry number (#455.5)
+16 ; TRECCNT = total number of records transmitted
+17 ;
+18 ; ARRAYS USED
+19 ; ------ ----
+20 ; ^TMP($J) = 8b records that will be passed to xmtext
+21 ; ^TMP("PRSA",$J) = employee iens (used to change status of record)
+22 ;
+23 KILL DIC
SET DIC="^PRST(458,"
SET DIC(0)="AEMQZ"
SET PPI=$PIECE($GET(^PRST(458,0)),U,3)
IF PPI<1
DO KILL
QUIT
+24 SET DIC("B")=$PIECE(^PRST(458,PPI,0),U,1)
DO ^DIC
KILL DIC
IF +Y<1
DO KILL
QUIT
+25 SET PPI=+Y
DO CHECK
if YN["^"
GOTO KILL
+26 SET PPE=$PIECE($PIECE(^PRST(458,PPI,0),U),"-",2)
+27 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Ready to Transmit to Austin"
SET DIR("B")="NO"
+28 WRITE !
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!(Y=0)
DO KILL
QUIT
+29 WRITE !!,"Transmitting to Austin "
+30 KILL ^TMP("PRSA",$JOB),^TMP($JOB)
+31 SET (EMPCNT,IEN,RECCNT,TRECCNT)=0
+32 FOR
SET IEN=$ORDER(^PRST(458,PPI,"E",IEN))
if IEN'>0
QUIT
IF $PIECE($GET(^PRST(458,PPI,"E",IEN,0)),U,2)="P"
DO PROCESS
if RECCNT>174
DO MAIL
+33 if RECCNT>0
DO MAIL
+34 SET X="N"
SET %DT="XT"
DO ^%DT
SET NOW=+Y
KILL %DT
+35 IF EMPCNT>0
SET $PIECE(^PRST(458,PPI,0),U,2)=DUZ
SET $PIECE(^PRST(458,PPI,0),U,3)=NOW
SET $PIECE(^PRST(458,PPI,0),U,4)=$PIECE(^PRST(458,PPI,0),U,4)+EMPCNT
SET $PIECE(^PRST(458,PPI,0),U,5)=$PIECE(^PRST(458,PPI,0),U,5)+TRECCNT
+36 ;
+37 WRITE !!,EMPCNT," Employees Processed",!
KILL KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,EMPCNT,IEN,NOW,PPE,PPI,RECCNT,RECORD,SN,TLE,TLI,TRECCNT,X,Y
QUIT
+1 ;
PROCESS ;
+1 SET RECORD=$GET(^PRST(458,PPI,"E",IEN,5))
+2 IF RECORD=""
WRITE !,"8B record is missing for ",$PIECE($GET(^PRSPC(IEN,0)),U,1)
QUIT
+3 SET TLE=$EXTRACT(RECORD,22,24)
+4 SET EMPCNT=EMPCNT+1
SET STUB=$EXTRACT(RECORD,1,32)
AGAIN IF $LENGTH(RECORD)<81
SET RECCNT=RECCNT+1
SET ^TMP($JOB,RECCNT)=RECORD_$JUSTIFY("",80-$LENGTH(RECORD))
if RECCNT#100=1
WRITE "."
SET ^TMP("PRSA",$JOB,IEN)=""
KILL LENGTH,RECORD,STUB
QUIT
+1 FOR LENGTH=80:-1:33
if $EXTRACT(RECORD,LENGTH-1,LENGTH)?2U
QUIT
+2 SET RECCNT=RECCNT+1
SET ^TMP($JOB,RECCNT)=$EXTRACT(RECORD,1,LENGTH-2)_$JUSTIFY("",80-(LENGTH-2))
SET RECORD=STUB_$EXTRACT(RECORD,LENGTH-1,$LENGTH(RECORD))
GOTO AGAIN
+3 QUIT
+4 ;
MAIL ; call MailMan
+1 SET XMDUZ=.5
+2 SET XMY("G.TAB@"_^XMB("NETNAME"))=""
+3 SET XMY("XXX@Q-TAB.DOMAIN.EXT")=""
+4 SET SN=$PIECE($GET(^XMB(1,1,"XUS")),"^",17)
SET SN=$SELECT(+SN>0:$PIECE($GET(^DIC(4,SN,99)),"^",1),1:"")
+5 SET XMSUB=^DD("SITE")_" ("_SN_") Payroll Data (Pay Period "_PPE_")"
+6 SET XMTEXT="^TMP($J,"
SET XMDUZ=.5
DO ^XMD
+7 IF XMZ>0
Begin DoDot:1
+8 SET LOOP=0
FOR
SET LOOP=$ORDER(^TMP("PRSA",$JOB,LOOP))
if LOOP'>0
QUIT
SET $PIECE(^PRST(458,PPI,"E",LOOP,0),U,2)="X"
+9 if '$DATA(^PRST(458,PPI,"X",0))
SET ^PRST(458,PPI,"X",0)="^458.03P^^"
KILL DIC,DD,DO
SET DIC="^PRST(458,PPI,""X"","
SET DIC(0)="L"
SET DLAYGO=458
SET DA(1)=PPI
SET (X,DINUM)=XMZ
DO FILE^DICN
KILL DIC,DINUM
+10 DO NOW^%DTC
+11 SET $PIECE(^PRST(458,PPI,"X",+Y,0),U,2)=DUZ
+12 SET $PIECE(^PRST(458,PPI,"X",+Y,0),U,3)=%
+13 SET TRECCNT=TRECCNT+RECCNT
End DoDot:1
+14 SET RECCNT=0
+15 KILL %,^TMP("PRSA",$JOB),^TMP($JOB),DA,DD,DIC,DINUM,DLAYGO,DO,LOOP,X,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y,XMLOC,XMMG
QUIT
CHECK ; Run 8B Edit Check
+1 WRITE !!,"Edit Checks will now be run ...",!
+2 DO CODES^PRSACED6
SET YN=""
SET COUNT=0
SET HDR=1
+3 SET ATL="ATL00"
FOR
SET ATL=$ORDER(^PRSPC(ATL))
if ATL'?1"ATL".E
QUIT
SET TL=$EXTRACT(ATL,4,6)
SET NAM=""
FOR
SET NAM=$ORDER(^PRSPC(ATL,NAM))
if NAM=""
QUIT
FOR DFN=0:0
SET DFN=$ORDER(^PRSPC(ATL,NAM,DFN))
if DFN<1
QUIT
Begin DoDot:1
+4 IF '$DATA(^PRST(458,PPI,"E",DFN,5))
QUIT
+5 IF $PIECE(^PRST(458,PPI,"E",DFN,0),"^",2)'="P"
QUIT
+6 SET COUNT=COUNT+1
DO ^PRSACED1
if COUNT#50=1
WRITE "."
QUIT
End DoDot:1
if YN["^"
GOTO AB
+7 QUIT
AB WRITE !,"Edit Checks aborted. NO Transmission.",!
QUIT
