30 lines
1.3 KiB
Mathematica
30 lines
1.3 KiB
Mathematica
|
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
|