- 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 Feb 18, 2025@23:51:40 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