source: FOIAVistA/trunk/r/PAID-PRS/PRSDERR.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 1.7 KB
Line 
1PRSDERR ;HISC/GWB-PAID DOWNLOAD ERROR CHECKER ;8/20/93 09:47
2 ;;4.0;PAID;;Sep 21, 1995
3ERRCHK I $D(^XTMP("PRS","LSN",TYPE,DATE,STA)) S SEQNUM=^XTMP("PRS","LSN",TYPE,DATE,STA),MSCNUM="" F AA=1:1 Q:AA>SEQNUM S AA=$E("0000",1,4-$L(AA))_AA,DLID=TYPE_"-"_DATE_"-"_STA_"-"_AA,PRSDIEN=$O(^PRSD(450.12,"C",DLID,0)) D GAPCHK
4 K ^XTMP("PRS","LSN",TYPE,DATE,STA),MSCNUM Q
5GAPCHK I PRSDIEN'>0 S ERRMSG=MTYPE_" message "_AA_" not received. Previous message: "_MSCNUM D ERR^PRSDSERV S ^XTMP("PRS","MNR",TYPE,DATE,STA,AA)="" Q
6 S XMZ=$P(^PRSD(450.12,PRSDIEN,0),U)
7 F BB=1:1:5 Q:$P(^PRSD(450.12,PRSDIEN,0),U,3)="S" H 180
8 I $P(^PRSD(450.12,PRSDIEN,0),U,3)'="S" S ERRMSG=MTYPE_" download message #"_XMZ_" not processed" D ERR^PRSDSERV
9 S:$D(^XMB(3.9,XMZ,0)) MSCNUM=$P(^XMB(3.9,XMZ,0),"^",1)
10KILL S DIK="^PRSD(450.12,",DA=PRSDIEN D ^DIK
11 S PRSDIEN=$O(^PRSD(450.12,"C",DLID,0)) I PRSDIEN>0 S XMZ=$P(^PRSD(450.12,PRSDIEN,0),U),ERRMSG="Duplicate "_MTYPE_" download message. Message # = "_XMZ_" Sequential number = "_$P(DLID,"-",4) D ERR^PRSDSERV G KILL
12 Q
13TRANSCK Q:'$D(^PRSPC("SSN",SSN))
14 S IEN=0,IEN=$O(^PRSPC("SSN",SSN,IEN))
15 S SEPIND="" I $D(^PRSPC(IEN,1)) S SEPIND=$P(^PRSPC(IEN,1),U,33)
16 S STATFR=$P(XMRG,":",2),STATFR=$E(STATFR,16,18)
17 S ACCSEP=$P(XMRG,":",3),ACCSEP=$E(ACCSEP,2)
18 I SEPIND="N",ACCSEP="S" S KFLG=""
19 I STA=STATFR S ^XTMP("PRS",STA,"NOSEP",SSN)=""
20 K IEN,SEPIND,STATFR,ACCSEP
21 Q
22CHGSSN ;Change SSN
23 S IEN=0 I $D(^PRSPC("SSN",OLDSSN)) S IEN=$O(^PRSPC("SSN",OLDSSN,IEN)),DR="8///"_SSN,DIE="^PRSPC(",DA=IEN D ^DIE S ^TMP($J,"PRS",NAME,SSN)="SSN change (old SSN = "_$E(OLDSSN,1,3)_"-"_$E(OLDSSN,4,5)_"-"_$E(OLDSSN,6,9)_")"
24 I $D(^VA(200,"SSN",OLDSSN)) S DA=$O(^VA(200,"SSN",OLDSSN,0)),DR="9///"_SSN,DIE="^VA(200,",VAIEN=DA D ^DIE
25 Q
Note: See TracBrowser for help on using the repository browser.