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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSDERR 1761 printed Oct 16, 2024@18:25:56 Page 2
PRSDERR ;HISC/GWB-PAID DOWNLOAD ERROR CHECKER ;8/20/93 09:47
+1 ;;4.0;PAID;;Sep 21, 1995
ERRCHK IF $DATA(^XTMP("PRS","LSN",TYPE,DATE,STA))
SET SEQNUM=^XTMP("PRS","LSN",TYPE,DATE,STA)
SET MSCNUM=""
FOR AA=1:1
if AA>SEQNUM
QUIT
SET AA=$EXTRACT("0000",1,4-$LENGTH(AA))_AA
SET DLID=TYPE_"-"_DATE_"-"_STA_"-"_AA
SET PRSDIEN=$ORDER(^PRSD(450.12,"C",DLID,0))
DO GAPCHK
+1 KILL ^XTMP("PRS","LSN",TYPE,DATE,STA),MSCNUM
QUIT
GAPCHK IF PRSDIEN'>0
SET ERRMSG=MTYPE_" message "_AA_" not received. Previous message: "_MSCNUM
DO ERR^PRSDSERV
SET ^XTMP("PRS","MNR",TYPE,DATE,STA,AA)=""
QUIT
+1 SET XMZ=$PIECE(^PRSD(450.12,PRSDIEN,0),U)
+2 FOR BB=1:1:5
if $PIECE(^PRSD(450.12,PRSDIEN,0),U,3)="S"
QUIT
HANG 180
+3 IF $PIECE(^PRSD(450.12,PRSDIEN,0),U,3)'="S"
SET ERRMSG=MTYPE_" download message #"_XMZ_" not processed"
DO ERR^PRSDSERV
+4 if $DATA(^XMB(3.9,XMZ,0))
SET MSCNUM=$PIECE(^XMB(3.9,XMZ,0),"^",1)
KILL SET DIK="^PRSD(450.12,"
SET DA=PRSDIEN
DO ^DIK
+1 SET PRSDIEN=$ORDER(^PRSD(450.12,"C",DLID,0))
IF PRSDIEN>0
SET XMZ=$PIECE(^PRSD(450.12,PRSDIEN,0),U)
SET ERRMSG="Duplicate "_MTYPE_" download message. Message # = "_XMZ_" Sequential number = "_$PIECE(DLID,"-",4)
DO ERR^PRSDSERV
GOTO KILL
+2 QUIT
TRANSCK if '$DATA(^PRSPC("SSN",SSN))
QUIT
+1 SET IEN=0
SET IEN=$ORDER(^PRSPC("SSN",SSN,IEN))
+2 SET SEPIND=""
IF $DATA(^PRSPC(IEN,1))
SET SEPIND=$PIECE(^PRSPC(IEN,1),U,33)
+3 SET STATFR=$PIECE(XMRG,":",2)
SET STATFR=$EXTRACT(STATFR,16,18)
+4 SET ACCSEP=$PIECE(XMRG,":",3)
SET ACCSEP=$EXTRACT(ACCSEP,2)
+5 IF SEPIND="N"
IF ACCSEP="S"
SET KFLG=""
+6 IF STA=STATFR
SET ^XTMP("PRS",STA,"NOSEP",SSN)=""
+7 KILL IEN,SEPIND,STATFR,ACCSEP
+8 QUIT
CHGSSN ;Change SSN
+1 SET IEN=0
IF $DATA(^PRSPC("SSN",OLDSSN))
SET IEN=$ORDER(^PRSPC("SSN",OLDSSN,IEN))
SET DR="8///"_SSN
SET DIE="^PRSPC("
SET DA=IEN
DO ^DIE
SET ^TMP($JOB,"PRS",NAME,SSN)="SSN change (old SSN = "_$EXTRACT(OLDSSN,1,3)_"-"_$EXTRACT(OLDSSN,4,5)_"-"_$EXTRACT(OLDSSN,6,9)_")"
+2 IF $DATA(^VA(200,"SSN",OLDSSN))
SET DA=$ORDER(^VA(200,"SSN",OLDSSN,0))
SET DR="9///"_SSN
SET DIE="^VA(200,"
SET VAIEN=DA
DO ^DIE
+3 QUIT
