PRSDDL ;HISC/GWB-PAID SEPARATION DOWNLOAD ROUTINE ;8/20/93 11:35
;;4.0;PAID;;Sep 21, 1995
K ^TMP($J)
S ECNT=0,XMPOS=2 F AA=1:1:EMPCNT D LOOP
D REMSB^PRSDSERV
S MTYPE="Separation" D ^PRSDSTAT
K ^TMP($J),^XTMP("PRS",STA,"NOSEP"),TL,CCORG,OST,OSTX,Y,DATA,X1,X2,X
Q
LOOP S ECOUNT=0 D REC^XMS3 S RCD=$P(XMRG,":",1),RCD=$E(RCD,4,999)
F BB=1:9 S SSN=$E(RCD,BB,BB+8) Q:(SSN="")!(SSN=999999999) D PROC K STANUM
S ECNT=ECNT+ECOUNT Q
PROC I $D(^XTMP("PRS",STA,"NOSEP",SSN)) K ^XTMP("PRS",STA,"NOSEP",SSN) Q
I '$D(^PRSPC("SSN",SSN)) S ERRMSG="SSN "_$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)_" not found" D ERR^PRSDSERV Q
S IEN=$O(^PRSPC("SSN",SSN,0)) Q:IEN="" S STANUM=$P(^PRSPC(IEN,0),U,7) Q:STANUM'=STA D
.S NAME=$P(^PRSPC(IEN,0),U,1),TL=$P(^PRSPC(IEN,0),U,8)
.S CCORG=$P(^PRSPC(IEN,0),U,49)
.I TL'="" K ^PRSPC("ATL"_TL,NAME,IEN)
.I CCORG'="" K ^PRSPC("ACC",CCORG,IEN)
.S $P(^PRSPC(IEN,0),U,8)=""
.I $D(^PRSPC(IEN,1)),$P(^PRSPC(IEN,1),U,1)'="S" D
..S $P(^PRSPC(IEN,1),U,1)="S"
..S DATA=DATE D DATE^PRSDUTIL S X1=DATA,X2=-5 D C^%DTC
..S $P(^PRSPC(IEN,1),U,2)=X
..S $P(^PRSPC(IEN,1),U,3)="SEP"
.S $P(^PRSPC(IEN,1),U,33)="Y",ECOUNT=ECOUNT+1
.S OST=$P(^PRSPC(IEN,0),U,17),OSTX="",Y=OST X ^DD(450,16,2)
.S:OST'=OSTX OSTX=Y
.S ^TMP($J,"PRS",NAME,SSN)=$E(OST,1,4)_U_OSTX
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSDDL 1317 printed Dec 13, 2024@02:25:09 Page 2
PRSDDL ;HISC/GWB-PAID SEPARATION DOWNLOAD ROUTINE ;8/20/93 11:35
+1 ;;4.0;PAID;;Sep 21, 1995
+2 KILL ^TMP($JOB)
+3 SET ECNT=0
SET XMPOS=2
FOR AA=1:1:EMPCNT
DO LOOP
+4 DO REMSB^PRSDSERV
+5 SET MTYPE="Separation"
DO ^PRSDSTAT
+6 KILL ^TMP($JOB),^XTMP("PRS",STA,"NOSEP"),TL,CCORG,OST,OSTX,Y,DATA,X1,X2,X
+7 QUIT
LOOP SET ECOUNT=0
DO REC^XMS3
SET RCD=$PIECE(XMRG,":",1)
SET RCD=$EXTRACT(RCD,4,999)
+1 FOR BB=1:9
SET SSN=$EXTRACT(RCD,BB,BB+8)
if (SSN="")!(SSN=999999999)
QUIT
DO PROC
KILL STANUM
+2 SET ECNT=ECNT+ECOUNT
QUIT
PROC IF $DATA(^XTMP("PRS",STA,"NOSEP",SSN))
KILL ^XTMP("PRS",STA,"NOSEP",SSN)
QUIT
+1 IF '$DATA(^PRSPC("SSN",SSN))
SET ERRMSG="SSN "_$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,9)_" not found"
DO ERR^PRSDSERV
QUIT
+2 SET IEN=$ORDER(^PRSPC("SSN",SSN,0))
if IEN=""
QUIT
SET STANUM=$PIECE(^PRSPC(IEN,0),U,7)
if STANUM'=STA
QUIT
Begin DoDot:1
+3 SET NAME=$PIECE(^PRSPC(IEN,0),U,1)
SET TL=$PIECE(^PRSPC(IEN,0),U,8)
+4 SET CCORG=$PIECE(^PRSPC(IEN,0),U,49)
+5 IF TL'=""
KILL ^PRSPC("ATL"_TL,NAME,IEN)
+6 IF CCORG'=""
KILL ^PRSPC("ACC",CCORG,IEN)
+7 SET $PIECE(^PRSPC(IEN,0),U,8)=""
+8 IF $DATA(^PRSPC(IEN,1))
IF $PIECE(^PRSPC(IEN,1),U,1)'="S"
Begin DoDot:2
+9 SET $PIECE(^PRSPC(IEN,1),U,1)="S"
+10 SET DATA=DATE
DO DATE^PRSDUTIL
SET X1=DATA
SET X2=-5
DO C^%DTC
+11 SET $PIECE(^PRSPC(IEN,1),U,2)=X
+12 SET $PIECE(^PRSPC(IEN,1),U,3)="SEP"
End DoDot:2
+13 SET $PIECE(^PRSPC(IEN,1),U,33)="Y"
SET ECOUNT=ECOUNT+1
+14 SET OST=$PIECE(^PRSPC(IEN,0),U,17)
SET OSTX=""
SET Y=OST
XECUTE ^DD(450,16,2)
+15 if OST'=OSTX
SET OSTX=Y
+16 SET ^TMP($JOB,"PRS",NAME,SSN)=$EXTRACT(OST,1,4)_U_OSTX
End DoDot:1
+17 QUIT
