SDRPA04 ;BP-OIFO/ESW - SDRPA00 continuation PAIT - REPAIR ;11/2/04 11:47am ; 5/31/07 5:29pm
;;5.3;Scheduling;**376,491,634,639**;Aug 13, 1993;Build 7
;SD/491 - not to error out while repairing with acks having received
;SD*639 Disable SD-PAIT REPAIR option
Q
MSGT(CRUNID,SDPEN,SDFIN,SDTOT,SDSTOP) ;create completion messages
;CRUNID - current run number
;SDPEN - pendings
;SDFIN - finals
;SDTOT - total
;SDSTOP - task stop flag
N SDB,SDTRF
I '$D(SDTOT) S SDTOT=SDPEN+SDFIN
N SFF S SFF=0
I +SDTOT=0 S (SDPEN,SDFIN)=0,SFF=1
I '$D(SDPEN),'$D(SDFIN) S (SDPEN,SDFIN)="undetermined",SFF=1
N SDB,SDTRF
S SDB=SDTOT\5000 I SDTOT-(5000*SDB)>0 S SDB=SDB+1 ;# of batches
N NOW S NOW=$$NOW^XLFDT S SDTRF=$$FMTE^XLFDT(NOW,2),SDTRF=$P(SDTRF,":",1,2)
N DA,DIE,DR D
.S DA=CRUNID,DIE=409.6,DR="1.3///"_SDTOT_";1.4///"_SDB_";1.5///"_NOW D ^DIE
D CLEAN(CRUNID)
N SDS,SDSTAT,SDIP,SDAR,SDAP,SDMT,SDMS,SD870
;SDS - STATION #
;SDSTAT - SD-PAIT STATUS
;SDIP - IP ADDRESS
;SDAR - COMMIT ACK RECEIVED
;SDAP - COMMIT ACK PROCESSED
;SDMT - MESSAGES (BATCHES) TO SEND
;SDMS - MESSAGES (BATCHES) SENT
S SD870=$O(^HLCS(870,"B","SD-PAIT",""))
N ARRAY D GETS^DIQ(870,SD870_",","4;5;6;7;8;400.01","I","ARRAY")
N SD87 S SD87=SD870_","
S SDSTAT=ARRAY(870,SD87,4,"I")
S SDAR=ARRAY(870,SD87,5,"I")
S SDAP=ARRAY(870,SD87,6,"I")
S SDMS=ARRAY(870,SD87,7,"I")
S SDMT=ARRAY(870,SD87,8,"I")
S SDIP=ARRAY(870,SD87,400.01,"I")
S SDS=$P($$SITE^VASITE(),"^",3)
;S SDS=$E($O(^SDWL(409.6,"AMSG","")),1,3)
N SDBT,STSK,SDSL ; Starting and Last scanned date
S SDBT=$P(^SDWL(409.6,CRUNID,0),U),SDSL=$P(^SDWL(409.6,CRUNID,0),U,4)
S STSK=$P(^SDWL(409.6,CRUNID,0),U,2)
S SDBT=$$FMTE^XLFDT(SDBT,2),SDSL=$$FMTE^XLFDT(SDSL,2)
MSG ;send mail message
N SDAMX,XMSUB,XMY,XMTEXT,XMDUZ
S XMSUB=$G(SDS)_" - PAIT BACKGROUND JOB"
S XMY("G.SD-PAIT")=""
S XMY("S.SD-PAIT-SERVER@DOMAIN.EXT")=""
S XMTEXT="SDAMX("
S DUZ=""
S XMDUZ="POSTMASTER"
S SDAMX(1)=""
S SDAMX(2)="The PAIT job has completed - TASK #: "_STSK_" Log #: "_CRUNID_" on "_SDTRF
S SDAMX(3)="Started: "_SDBT_" Last Scanned: "_SDSL
S SDAMX(4)="Pending appointments: "_$J(SDPEN,10)
S SDAMX(5)="Final appointments: "_$J(SDFIN,10)
S SDAMX(6)=" ----------"
S SDAMX(7)="Total appointments: "_$J(SDTOT,10)_" Number of batches: "_SDB
S SDAMX(8)=""
S SDAMX(9)="Fac Log Bch Appt # Date finished IP Address "
S SDAMX(10)="Gen Sent Com R Com P Status"
S SDAMX(11)="------------------------------------------------------------------------------"
S SDAMX(12)=SDS_"|"_$J(CRUNID,3)_"|"_$J(SDB,3)_"|"_$J(SDTOT,7)_"|"_SDTRF_"|"_$E(SDIP,1,39)_"|"
S SDAMX(13)=$J(SDMT,4)_"|"_$J(SDMS,4)_"|"_$J(SDAR,4)_"|"_$J(SDAP,4)_"| "_SDSTAT
S SDAMX(14)=""
I $G(SDSTOP) S XMY("VHACIONHD@DOMAIN.EXT")="" D D ^XMD Q
.S SDAMX(15)="WARNING: TASK STOPPED BY USER, NEEDS TO BE RESTARTED."
.S SDAMX(16)="Initiate a Remedy ticket TO FOLLOW UP."
I 'SFF I SDMT>0!(SDB=0) D D ^XMD K ^TMP("SDDPT",$J) Q
.I (SDMT-SDMS)=0 D Q
..S SDAMX(15)="SUCCESS: Transmission completed."
.I (SDMT-SDMS)<SDB!(SDB=1&(SDMT-SDMS)'<SDB)&(SDSTAT'["Shutdown") D Q
..S SDAMX(15)="WARNING: "_(SDMT-SDMS)_" out of "_SDB_" batches still have to be transmitted,"
..S SDAMX(16)="please verify with the HL7 System Monitor."
.S XMY("VHACIONHD@DOMAIN.EXT")=""
.I SDB>0 I (SDMT-SDMS)'<SDB D Q
..S XMY("VHACIONHD@DOMAIN.EXT")=""
..I SDSTAT["Shutdown" D
...S SDAMX(15)="SD-PAIT Logical Link has to be started, initiate Remedy ticket for Scheduling PAIT."
..E S SDAMX(15)="Initiate a Remedy ticket for Interface Engine - communication problem."
I SFF D D ^XMD K ^TMP("SDDPT",$J) Q
.S SDAMX(15)="WARNING!!!: Transmission of run#: "_CRUNID_" has been repaired, you may restart."
.I SDB>0 I (SDMT-SDMS)'<SDB D
..S XMY("VHACIONHD@DOMAIN.EXT")=""
..I SDSTAT["Shutdown" D Q
...S SDAMX(16)="SD-PAIT Logical Link has to be started, initiate Remedy ticket for Scheduling PAIT."
..S SDAMX(16)="Initiate a Remedy ticket for Interface Engine - communication problem."
Q
CLEAN(CRUNID) ;housekeeping
;clean up batches previous to current one by checking for "AE",("S" or "R") xref and
;deleting if entry in xref exists
;RUN : run # (ien of multiple entry)
;V1 : previous run # (ien of multiple entry)
;V2 : ien (ien in multiple)
N V1,V2,V3,ZNODE,DIK
S V1=CRUNID F S V1=$O(^SDWL(409.6,V1),-1) Q:'V1 D
.F V3="R","S" S V2=0 F S V2=$O(^SDWL(409.6,"AE",V3,V1,V2)) Q:'V2 D
..S ZNODE=$G(^SDWL(409.6,V1,1,V2,0))
..S ^XTMP("SDRPA-"_$P(ZNODE,"^",3),0)=$$HTFM^XLFDT($H+7,1)_U_$$HTFM^XLFDT($H,1)
..S DIK="^SDWL(409.6,"_V1_",1,"
..S DA(1)=V1,DA=V2 D ^DIK
..S ^XTMP("SDRPA-"_$P(ZNODE,"^",3),"CLEAN",+$P(ZNODE,"^",4),0)=ZNODE ;diagnostics
Q
RPAIT(RUN) ;
; SD*639 Disable SD-PAIT REPAIR option
D BMES^XPDUTL("This SD-PAIT REPAIR option has been placed Out of Order")
D MES^XPDUTL("by SD*5.3*639.")
D MES^XPDUTL("")
Q
;
;RUN - run number - entry ^SDWL(409.6,RUN,0) to be repaired
Q:+$G(RUN)'>1
W !,"The repairing in progress...",!
N SDE,SDEB,SDFE,SDLSD,SDRCNT,ZTSK
S SDE=$G(^SDWL(409.6,RUN,0)) Q:SDE=""
S ZTSK=$P(SDE,"^",2) D STAT^%ZTLOAD I ZTSK(1)=1!(ZTSK(1)=2) W !,"Task "_ZTSK_"is still active!" Q
S SDEB=+$P(SDE,"^",3) ; last batch # submitted to HL7
S SDRCNT=$O(^SDWL(409.6,RUN,1,999999999),-1) ;last entry
I SDEB=0 S SDFE=0 S $P(^SDWL(409.6,RUN,0),U,4)=$P(^SDWL(409.6,RUN-1,0),U,4)
I +SDEB>0 D
.S SDFE=SDRCNT+1 F S SDFE=$O(^SDWL(409.6,RUN,1,SDFE),-1) I $P(^SDWL(409.6,RUN,1,SDFE,0),U,3)'>SDEB&($P(^SDWL(409.6,RUN,1,SDFE,0),U,3)'="") Q ; SD/491
.N SDLSD1 S SDLSD1=$P(^SDWL(409.6,RUN,1,SDFE,0),U,7) ;retrieve the last used creation date of HL7 created
.N SDLSD2 S SDLSD2=$P($G(^SDWL(409.6,RUN,1,SDFE+1,0)),U,7)
.S SDLSD=$P(SDE,U,4) ; last scanned date
.I SDLSD="" D
..S $P(^SDWL(409.6,RUN,0),U,4)=$S(SDLSD2>SDLSD1:SDLSD1,1:SDLSD1-1)
.E S $P(^SDWL(409.6,RUN,0),U,4)=SDLSD-1
N SDS,DIK F SDS=SDFE+1:1:SDRCNT I $D(^SDWL(409.6,RUN,1,SDS,0)) D EVAL(RUN,SDS) S DIK="^SDWL(409.6,"_RUN_",1,",DA(1)=RUN,DA=SDS D ^DIK
S SDB=+$P($G(^SDWL(409.6,RUN,2,0)),U,3)
S NOW=$$NOW^XLFDT,SDFE=5000*SDB
S $P(^SDWL(409.6,RUN,0),U,5)=SDFE
S $P(^SDWL(409.6,RUN,0),U,6)=SDB
S $P(^SDWL(409.6,RUN,0),U,7)=NOW
D MSGT(RUN,,,SDFE)
W !!,"The last run number has been repaired, you may ONE TIME QUEUE the next one.",!
Q
EVAL(RUN,SDS) ;
;evaluate if to update any 'S' or 'R' Retention Flags for
;the previous entry if exists.
N SDSTR,DFN,SDDT S SDSTR=^SDWL(409.6,RUN,1,SDS,0)
S DFN=+SDSTR,SDDT=$P(SDSTR,"^",2)
Q:SDDT=""
;find a prior entry SDRUN
N SDRUN S SDRUN=$O(^SDWL(409.6,"AC",DFN,SDDT,RUN),-1) Q:SDRUN=""
N SDSQ S SDSQ=$O(^SDWL(409.6,"AC",DFN,SDDT,SDRUN,""))
N SDSTRP S SDSTRP=^SDWL(409.6,SDRUN,1,SDSQ,0)
N SDRET S SDRET=$P(SDSTRP,"^",5)
I SDRET="S"!(SDRET="R") N DIC D
.S SDRET="Y",DIC="^SDWL(409.6,"_SDRUN_",1,",DA(1)=SDRUN,DA=SDSQ,DIE=DIC,DR="4///"_SDRET D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDRPA04 7036 printed Dec 13, 2024@03:00:14 Page 2
SDRPA04 ;BP-OIFO/ESW - SDRPA00 continuation PAIT - REPAIR ;11/2/04 11:47am ; 5/31/07 5:29pm
+1 ;;5.3;Scheduling;**376,491,634,639**;Aug 13, 1993;Build 7
+2 ;SD/491 - not to error out while repairing with acks having received
+3 ;SD*639 Disable SD-PAIT REPAIR option
+4 QUIT
MSGT(CRUNID,SDPEN,SDFIN,SDTOT,SDSTOP) ;create completion messages
+1 ;CRUNID - current run number
+2 ;SDPEN - pendings
+3 ;SDFIN - finals
+4 ;SDTOT - total
+5 ;SDSTOP - task stop flag
+6 NEW SDB,SDTRF
+7 IF '$DATA(SDTOT)
SET SDTOT=SDPEN+SDFIN
+8 NEW SFF
SET SFF=0
+9 IF +SDTOT=0
SET (SDPEN,SDFIN)=0
SET SFF=1
+10 IF '$DATA(SDPEN)
IF '$DATA(SDFIN)
SET (SDPEN,SDFIN)="undetermined"
SET SFF=1
+11 NEW SDB,SDTRF
+12 ;# of batches
SET SDB=SDTOT\5000
IF SDTOT-(5000*SDB)>0
SET SDB=SDB+1
+13 NEW NOW
SET NOW=$$NOW^XLFDT
SET SDTRF=$$FMTE^XLFDT(NOW,2)
SET SDTRF=$PIECE(SDTRF,":",1,2)
+14 NEW DA,DIE,DR
Begin DoDot:1
+15 SET DA=CRUNID
SET DIE=409.6
SET DR="1.3///"_SDTOT_";1.4///"_SDB_";1.5///"_NOW
DO ^DIE
End DoDot:1
+16 DO CLEAN(CRUNID)
+17 NEW SDS,SDSTAT,SDIP,SDAR,SDAP,SDMT,SDMS,SD870
+18 ;SDS - STATION #
+19 ;SDSTAT - SD-PAIT STATUS
+20 ;SDIP - IP ADDRESS
+21 ;SDAR - COMMIT ACK RECEIVED
+22 ;SDAP - COMMIT ACK PROCESSED
+23 ;SDMT - MESSAGES (BATCHES) TO SEND
+24 ;SDMS - MESSAGES (BATCHES) SENT
+25 SET SD870=$ORDER(^HLCS(870,"B","SD-PAIT",""))
+26 NEW ARRAY
DO GETS^DIQ(870,SD870_",","4;5;6;7;8;400.01","I","ARRAY")
+27 NEW SD87
SET SD87=SD870_","
+28 SET SDSTAT=ARRAY(870,SD87,4,"I")
+29 SET SDAR=ARRAY(870,SD87,5,"I")
+30 SET SDAP=ARRAY(870,SD87,6,"I")
+31 SET SDMS=ARRAY(870,SD87,7,"I")
+32 SET SDMT=ARRAY(870,SD87,8,"I")
+33 SET SDIP=ARRAY(870,SD87,400.01,"I")
+34 SET SDS=$PIECE($$SITE^VASITE(),"^",3)
+35 ;S SDS=$E($O(^SDWL(409.6,"AMSG","")),1,3)
+36 ; Starting and Last scanned date
NEW SDBT,STSK,SDSL
+37 SET SDBT=$PIECE(^SDWL(409.6,CRUNID,0),U)
SET SDSL=$PIECE(^SDWL(409.6,CRUNID,0),U,4)
+38 SET STSK=$PIECE(^SDWL(409.6,CRUNID,0),U,2)
+39 SET SDBT=$$FMTE^XLFDT(SDBT,2)
SET SDSL=$$FMTE^XLFDT(SDSL,2)
MSG ;send mail message
+1 NEW SDAMX,XMSUB,XMY,XMTEXT,XMDUZ
+2 SET XMSUB=$GET(SDS)_" - PAIT BACKGROUND JOB"
+3 SET XMY("G.SD-PAIT")=""
+4 SET XMY("S.SD-PAIT-SERVER@DOMAIN.EXT")=""
+5 SET XMTEXT="SDAMX("
+6 SET DUZ=""
+7 SET XMDUZ="POSTMASTER"
+8 SET SDAMX(1)=""
+9 SET SDAMX(2)="The PAIT job has completed - TASK #: "_STSK_" Log #: "_CRUNID_" on "_SDTRF
+10 SET SDAMX(3)="Started: "_SDBT_" Last Scanned: "_SDSL
+11 SET SDAMX(4)="Pending appointments: "_$JUSTIFY(SDPEN,10)
+12 SET SDAMX(5)="Final appointments: "_$JUSTIFY(SDFIN,10)
+13 SET SDAMX(6)=" ----------"
+14 SET SDAMX(7)="Total appointments: "_$JUSTIFY(SDTOT,10)_" Number of batches: "_SDB
+15 SET SDAMX(8)=""
+16 SET SDAMX(9)="Fac Log Bch Appt # Date finished IP Address "
+17 SET SDAMX(10)="Gen Sent Com R Com P Status"
+18 SET SDAMX(11)="------------------------------------------------------------------------------"
+19 SET SDAMX(12)=SDS_"|"_$JUSTIFY(CRUNID,3)_"|"_$JUSTIFY(SDB,3)_"|"_$JUSTIFY(SDTOT,7)_"|"_SDTRF_"|"_$EXTRACT(SDIP,1,39)_"|"
+20 SET SDAMX(13)=$JUSTIFY(SDMT,4)_"|"_$JUSTIFY(SDMS,4)_"|"_$JUSTIFY(SDAR,4)_"|"_$JUSTIFY(SDAP,4)_"| "_SDSTAT
+21 SET SDAMX(14)=""
+22 IF $GET(SDSTOP)
SET XMY("VHACIONHD@DOMAIN.EXT")=""
Begin DoDot:1
+23 SET SDAMX(15)="WARNING: TASK STOPPED BY USER, NEEDS TO BE RESTARTED."
+24 SET SDAMX(16)="Initiate a Remedy ticket TO FOLLOW UP."
End DoDot:1
DO ^XMD
QUIT
+25 IF 'SFF
IF SDMT>0!(SDB=0)
Begin DoDot:1
+26 IF (SDMT-SDMS)=0
Begin DoDot:2
+27 SET SDAMX(15)="SUCCESS: Transmission completed."
End DoDot:2
QUIT
+28 IF (SDMT-SDMS)<SDB!(SDB=1&(SDMT-SDMS)'<SDB)&(SDSTAT'["Shutdown")
Begin DoDot:2
+29 SET SDAMX(15)="WARNING: "_(SDMT-SDMS)_" out of "_SDB_" batches still have to be transmitted,"
+30 SET SDAMX(16)="please verify with the HL7 System Monitor."
End DoDot:2
QUIT
+31 SET XMY("VHACIONHD@DOMAIN.EXT")=""
+32 IF SDB>0
IF (SDMT-SDMS)'<SDB
Begin DoDot:2
+33 SET XMY("VHACIONHD@DOMAIN.EXT")=""
+34 IF SDSTAT["Shutdown"
Begin DoDot:3
+35 SET SDAMX(15)="SD-PAIT Logical Link has to be started, initiate Remedy ticket for Scheduling PAIT."
End DoDot:3
+36 IF '$TEST
SET SDAMX(15)="Initiate a Remedy ticket for Interface Engine - communication problem."
End DoDot:2
QUIT
End DoDot:1
DO ^XMD
KILL ^TMP("SDDPT",$JOB)
QUIT
+37 IF SFF
Begin DoDot:1
+38 SET SDAMX(15)="WARNING!!!: Transmission of run#: "_CRUNID_" has been repaired, you may restart."
+39 IF SDB>0
IF (SDMT-SDMS)'<SDB
Begin DoDot:2
+40 SET XMY("VHACIONHD@DOMAIN.EXT")=""
+41 IF SDSTAT["Shutdown"
Begin DoDot:3
+42 SET SDAMX(16)="SD-PAIT Logical Link has to be started, initiate Remedy ticket for Scheduling PAIT."
End DoDot:3
QUIT
+43 SET SDAMX(16)="Initiate a Remedy ticket for Interface Engine - communication problem."
End DoDot:2
End DoDot:1
DO ^XMD
KILL ^TMP("SDDPT",$JOB)
QUIT
+44 QUIT
CLEAN(CRUNID) ;housekeeping
+1 ;clean up batches previous to current one by checking for "AE",("S" or "R") xref and
+2 ;deleting if entry in xref exists
+3 ;RUN : run # (ien of multiple entry)
+4 ;V1 : previous run # (ien of multiple entry)
+5 ;V2 : ien (ien in multiple)
+6 NEW V1,V2,V3,ZNODE,DIK
+7 SET V1=CRUNID
FOR
SET V1=$ORDER(^SDWL(409.6,V1),-1)
if 'V1
QUIT
Begin DoDot:1
+8 FOR V3="R","S"
SET V2=0
FOR
SET V2=$ORDER(^SDWL(409.6,"AE",V3,V1,V2))
if 'V2
QUIT
Begin DoDot:2
+9 SET ZNODE=$GET(^SDWL(409.6,V1,1,V2,0))
+10 SET ^XTMP("SDRPA-"_$PIECE(ZNODE,"^",3),0)=$$HTFM^XLFDT($HOROLOG+7,1)_U_$$HTFM^XLFDT($HOROLOG,1)
+11 SET DIK="^SDWL(409.6,"_V1_",1,"
+12 SET DA(1)=V1
SET DA=V2
DO ^DIK
+13 ;diagnostics
SET ^XTMP("SDRPA-"_$PIECE(ZNODE,"^",3),"CLEAN",+$PIECE(ZNODE,"^",4),0)=ZNODE
End DoDot:2
End DoDot:1
+14 QUIT
RPAIT(RUN) ;
+1 ; SD*639 Disable SD-PAIT REPAIR option
+2 DO BMES^XPDUTL("This SD-PAIT REPAIR option has been placed Out of Order")
+3 DO MES^XPDUTL("by SD*5.3*639.")
+4 DO MES^XPDUTL("")
+5 QUIT
+6 ;
+7 ;RUN - run number - entry ^SDWL(409.6,RUN,0) to be repaired
+8 if +$GET(RUN)'>1
QUIT
+9 WRITE !,"The repairing in progress...",!
+10 NEW SDE,SDEB,SDFE,SDLSD,SDRCNT,ZTSK
+11 SET SDE=$GET(^SDWL(409.6,RUN,0))
if SDE=""
QUIT
+12 SET ZTSK=$PIECE(SDE,"^",2)
DO STAT^%ZTLOAD
IF ZTSK(1)=1!(ZTSK(1)=2)
WRITE !,"Task "_ZTSK_"is still active!"
QUIT
+13 ; last batch # submitted to HL7
SET SDEB=+$PIECE(SDE,"^",3)
+14 ;last entry
SET SDRCNT=$ORDER(^SDWL(409.6,RUN,1,999999999),-1)
+15 IF SDEB=0
SET SDFE=0
SET $PIECE(^SDWL(409.6,RUN,0),U,4)=$PIECE(^SDWL(409.6,RUN-1,0),U,4)
+16 IF +SDEB>0
Begin DoDot:1
+17 ; SD/491
SET SDFE=SDRCNT+1
FOR
SET SDFE=$ORDER(^SDWL(409.6,RUN,1,SDFE),-1)
IF $PIECE(^SDWL(409.6,RUN,1,SDFE,0),U,3)'>SDEB&($PIECE(^SDWL(409.6,RUN,1,SDFE,0),U,3)'="")
QUIT
+18 ;retrieve the last used creation date of HL7 created
NEW SDLSD1
SET SDLSD1=$PIECE(^SDWL(409.6,RUN,1,SDFE,0),U,7)
+19 NEW SDLSD2
SET SDLSD2=$PIECE($GET(^SDWL(409.6,RUN,1,SDFE+1,0)),U,7)
+20 ; last scanned date
SET SDLSD=$PIECE(SDE,U,4)
+21 IF SDLSD=""
Begin DoDot:2
+22 SET $PIECE(^SDWL(409.6,RUN,0),U,4)=$SELECT(SDLSD2>SDLSD1:SDLSD1,1:SDLSD1-1)
End DoDot:2
+23 IF '$TEST
SET $PIECE(^SDWL(409.6,RUN,0),U,4)=SDLSD-1
End DoDot:1
+24 NEW SDS,DIK
FOR SDS=SDFE+1:1:SDRCNT
IF $DATA(^SDWL(409.6,RUN,1,SDS,0))
DO EVAL(RUN,SDS)
SET DIK="^SDWL(409.6,"_RUN_",1,"
SET DA(1)=RUN
SET DA=SDS
DO ^DIK
+25 SET SDB=+$PIECE($GET(^SDWL(409.6,RUN,2,0)),U,3)
+26 SET NOW=$$NOW^XLFDT
SET SDFE=5000*SDB
+27 SET $PIECE(^SDWL(409.6,RUN,0),U,5)=SDFE
+28 SET $PIECE(^SDWL(409.6,RUN,0),U,6)=SDB
+29 SET $PIECE(^SDWL(409.6,RUN,0),U,7)=NOW
+30 DO MSGT(RUN,,,SDFE)
+31 WRITE !!,"The last run number has been repaired, you may ONE TIME QUEUE the next one.",!
+32 QUIT
EVAL(RUN,SDS) ;
+1 ;evaluate if to update any 'S' or 'R' Retention Flags for
+2 ;the previous entry if exists.
+3 NEW SDSTR,DFN,SDDT
SET SDSTR=^SDWL(409.6,RUN,1,SDS,0)
+4 SET DFN=+SDSTR
SET SDDT=$PIECE(SDSTR,"^",2)
+5 if SDDT=""
QUIT
+6 ;find a prior entry SDRUN
+7 NEW SDRUN
SET SDRUN=$ORDER(^SDWL(409.6,"AC",DFN,SDDT,RUN),-1)
if SDRUN=""
QUIT
+8 NEW SDSQ
SET SDSQ=$ORDER(^SDWL(409.6,"AC",DFN,SDDT,SDRUN,""))
+9 NEW SDSTRP
SET SDSTRP=^SDWL(409.6,SDRUN,1,SDSQ,0)
+10 NEW SDRET
SET SDRET=$PIECE(SDSTRP,"^",5)
+11 IF SDRET="S"!(SDRET="R")
NEW DIC
Begin DoDot:1
+12 SET SDRET="Y"
SET DIC="^SDWL(409.6,"_SDRUN_",1,"
SET DA(1)=SDRUN
SET DA=SDSQ
SET DIE=DIC
SET DR="4///"_SDRET
DO ^DIE
End DoDot:1
+13 QUIT
