source: WorldVistAEHR/trunk/r/PAID-PRS/PRSDERR.m@ 1150

PRSDERR ;HISC/GWB-PAID DOWNLOAD ERROR CHECKER ;8/20/93  09:47
 ;;4.0;PAID;;Sep 21, 1995
ERRCHK 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
 K ^XTMP("PRS","LSN",TYPE,DATE,STA),MSCNUM Q
GAPCHK 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
 S XMZ=$P(^PRSD(450.12,PRSDIEN,0),U)
 F BB=1:1:5 Q:$P(^PRSD(450.12,PRSDIEN,0),U,3)="S"  H 180
 I $P(^PRSD(450.12,PRSDIEN,0),U,3)'="S" S ERRMSG=MTYPE_" download message #"_XMZ_" not processed" D ERR^PRSDSERV
 S:$D(^XMB(3.9,XMZ,0)) MSCNUM=$P(^XMB(3.9,XMZ,0),"^",1)
KILL S DIK="^PRSD(450.12,",DA=PRSDIEN D ^DIK
 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
 Q
TRANSCK Q:'$D(^PRSPC("SSN",SSN))
 S IEN=0,IEN=$O(^PRSPC("SSN",SSN,IEN))
 S SEPIND="" I $D(^PRSPC(IEN,1)) S SEPIND=$P(^PRSPC(IEN,1),U,33)
 S STATFR=$P(XMRG,":",2),STATFR=$E(STATFR,16,18)
 S ACCSEP=$P(XMRG,":",3),ACCSEP=$E(ACCSEP,2)
 I SEPIND="N",ACCSEP="S" S KFLG=""
 I STA=STATFR S ^XTMP("PRS",STA,"NOSEP",SSN)=""
 K IEN,SEPIND,STATFR,ACCSEP
 Q
CHGSSN ;Change SSN
 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)_")"
 I $D(^VA(200,"SSN",OLDSSN)) S DA=$O(^VA(200,"SSN",OLDSSN,0)),DR="9///"_SSN,DIE="^VA(200,",VAIEN=DA D ^DIE
 Q