source: WorldVistAEHR/trunk/r/PAID-PRS/PRSDDL.m@ 1078

Last change on this file since 1078 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1PRSDDL ;HISC/GWB-PAID SEPARATION DOWNLOAD ROUTINE ;8/20/93 11:35
2 ;;4.0;PAID;;Sep 21, 1995
3 K ^TMP($J)
4 S ECNT=0,XMPOS=2 F AA=1:1:EMPCNT D LOOP
5 D REMSB^PRSDSERV
6 S MTYPE="Separation" D ^PRSDSTAT
7 K ^TMP($J),^XTMP("PRS",STA,"NOSEP"),TL,CCORG,OST,OSTX,Y,DATA,X1,X2,X
8 Q
9LOOP S ECOUNT=0 D REC^XMS3 S RCD=$P(XMRG,":",1),RCD=$E(RCD,4,999)
10 F BB=1:9 S SSN=$E(RCD,BB,BB+8) Q:(SSN="")!(SSN=999999999) D PROC K STANUM
11 S ECNT=ECNT+ECOUNT Q
12PROC I $D(^XTMP("PRS",STA,"NOSEP",SSN)) K ^XTMP("PRS",STA,"NOSEP",SSN) Q
13 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
14 S IEN=$O(^PRSPC("SSN",SSN,0)) Q:IEN="" S STANUM=$P(^PRSPC(IEN,0),U,7) Q:STANUM'=STA D
15 .S NAME=$P(^PRSPC(IEN,0),U,1),TL=$P(^PRSPC(IEN,0),U,8)
16 .S CCORG=$P(^PRSPC(IEN,0),U,49)
17 .I TL'="" K ^PRSPC("ATL"_TL,NAME,IEN)
18 .I CCORG'="" K ^PRSPC("ACC",CCORG,IEN)
19 .S $P(^PRSPC(IEN,0),U,8)=""
20 .I $D(^PRSPC(IEN,1)),$P(^PRSPC(IEN,1),U,1)'="S" D
21 ..S $P(^PRSPC(IEN,1),U,1)="S"
22 ..S DATA=DATE D DATE^PRSDUTIL S X1=DATA,X2=-5 D C^%DTC
23 ..S $P(^PRSPC(IEN,1),U,2)=X
24 ..S $P(^PRSPC(IEN,1),U,3)="SEP"
25 .S $P(^PRSPC(IEN,1),U,33)="Y",ECOUNT=ECOUNT+1
26 .S OST=$P(^PRSPC(IEN,0),U,17),OSTX="",Y=OST X ^DD(450,16,2)
27 .S:OST'=OSTX OSTX=Y
28 .S ^TMP($J,"PRS",NAME,SSN)=$E(OST,1,4)_U_OSTX
29 Q
Note: See TracBrowser for help on using the repository browser.