SCDXUTL5 ;ALB/ABR - RETRANSMIT CORRECTED HL7 UTILITY ; 10/25/96
;;5.3;Scheduling;**70**;AUG 13, 1993
;
EN ;
N DA,DIE,DR,ENC,ENCNODE,II,SDDATE,SDDAY,SDEN,SDN,SDPATCH,X,X1,X2
; +SDPATCH = date/time of patch install
; SDDATE = last date run (starting point for today's run
S SDPATCH=$G(^SD(404.91,1,"PATCH70")) Q:'SDPATCH
S (SDDATE,X1)=$P(SDPATCH,U,2),X2=3
Q:'SDDATE ;update complete
;
D C^%DTC ; find date + 3
S $P(SDDATE,".",2)=9,SDDAY=$P(X,".") I SDDAY>DT S SDDAY=DT ; cannot be greater than today
S SDEND=SDDAY+.9,SDSTA=SDDATE ; end date, start from date
;
D DELTX
D NOXMIT
D SETFL
I SDDATE,SDDAY<DT S $P(^SD(404.91,1,"PATCH70"),U,2)=SDDAY G ENQ
D CLNDONE
ENQ Q
;
DELTX ; deleted encounters
N SDEL
S SDEL=0
F S SDEL=$O(^SD(409.73,"ADEL",SDEL)) Q:'SDEL D
. I +$G(^SD(409.74,SDEL,0))<SDDATE Q ; quit if delete for already xmited enc.
. S SDN=$O(^SD(409.73,"ADEL",SDEL,0))
. ; clean out files, reset 0-nodes
. D KILL("^SD(409.74,",SDEL)
. D:SDN KILL("^SD(409.73,",SDN)
Q
KILL(DIK,DA) ; cleans out deleted encounters
D ^DIK
Q
;
NOXMIT ; don't transmit encounters out of date range
N SDX,SDX1
S SDX=0
F S SDX=$O(^SD(409.73,"AACXMIT",SDX)) Q:'SDX D
. F SDX1=0:0 S SDX1=$O(^SD(409.73,"AACXMIT",SDX,SDX1)) Q:'SDX1 D
..; check if encounter beyond today's send range
.. S SDEN=+$P($G(^SD(409.73,SDX1,0)),U,2) Q:'SDEN I $G(^SCE(SDEN,0))>SDEND!('$G(^SCE(SDEN,0))) D
...S DIE="^SD(409.73,",DA=SDX1,DR=".04////0" D ^DIE
Q
SETFL ; loop checks encounters transmitted up through date/time of patch installation
F S SDDATE=$O(^SCE("B",SDDATE)) Q:'SDDATE!(SDDATE>SDEND) D
. F SDEN=0:0 S SDEN=$O(^SCE("B",SDDATE,SDEN)) Q:'SDEN S SDN=$O(^SD(409.73,"AENC",SDEN,0)) I SDN D
.. ; quit if xmit date after patch install or already set to YES
.. Q:($G(^SD(409.73,SDN,1))>SDPATCH)!$P($G(^(0)),U,4)
.. S DIE="^SD(409.73,",DR=".04////1",DA=SDN D ^DIE
Q
;
CLNDONE ; cleanup done
;update node and create bulletin
S $P(^SD(404.91,1,"PATCH70"),U,2)=""
;
MSG N MSGTXT,XMB,XMTEXT,XMY,XMDUZ,XMDT,XMZ,DIFROM
S XMB="SCDX AMBCARE TO NPCDB SUMMARY"
; recipients are same as for SCDX AMBCARE TO NPCDB SUMMARY bulletin
; and group at Albany IRMFO
S XMY("G.ACRP MAINTENANCE@ISC-ALBANY")=""
S XMB(1)="** HL7 TRANSMISSIONS UP-TO-DATE **" ;subject
; message text
S MSGTXT(1)="Patch SD*5.3*70 began retransmitting Ambulatory Care Reporting Project"
S MSGTXT(2)="(ACRP) data beginning with encounters on 10/1. The retransmission of past"
S MSGTXT(3)="workload is now complete. The nightly background job will now resume"
S MSGTXT(4)="normal operations."
S XMTEXT="MSGTXT("
;
D ^XMB
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCDXUTL5 2689 printed Apr 09, 2024@21:49:55 Page 2
SCDXUTL5 ;ALB/ABR - RETRANSMIT CORRECTED HL7 UTILITY ; 10/25/96
+1 ;;5.3;Scheduling;**70**;AUG 13, 1993
+2 ;
EN ;
+1 NEW DA,DIE,DR,ENC,ENCNODE,II,SDDATE,SDDAY,SDEN,SDN,SDPATCH,X,X1,X2
+2 ; +SDPATCH = date/time of patch install
+3 ; SDDATE = last date run (starting point for today's run
+4 SET SDPATCH=$GET(^SD(404.91,1,"PATCH70"))
if 'SDPATCH
QUIT
+5 SET (SDDATE,X1)=$PIECE(SDPATCH,U,2)
SET X2=3
+6 ;update complete
if 'SDDATE
QUIT
+7 ;
+8 ; find date + 3
DO C^%DTC
+9 ; cannot be greater than today
SET $PIECE(SDDATE,".",2)=9
SET SDDAY=$PIECE(X,".")
IF SDDAY>DT
SET SDDAY=DT
+10 ; end date, start from date
SET SDEND=SDDAY+.9
SET SDSTA=SDDATE
+11 ;
+12 DO DELTX
+13 DO NOXMIT
+14 DO SETFL
+15 IF SDDATE
IF SDDAY<DT
SET $PIECE(^SD(404.91,1,"PATCH70"),U,2)=SDDAY
GOTO ENQ
+16 DO CLNDONE
ENQ QUIT
+1 ;
DELTX ; deleted encounters
+1 NEW SDEL
+2 SET SDEL=0
+3 FOR
SET SDEL=$ORDER(^SD(409.73,"ADEL",SDEL))
if 'SDEL
QUIT
Begin DoDot:1
+4 ; quit if delete for already xmited enc.
IF +$GET(^SD(409.74,SDEL,0))<SDDATE
QUIT
+5 SET SDN=$ORDER(^SD(409.73,"ADEL",SDEL,0))
+6 ; clean out files, reset 0-nodes
+7 DO KILL("^SD(409.74,",SDEL)
+8 if SDN
DO KILL("^SD(409.73,",SDN)
End DoDot:1
+9 QUIT
KILL(DIK,DA) ; cleans out deleted encounters
+1 DO ^DIK
+2 QUIT
+3 ;
NOXMIT ; don't transmit encounters out of date range
+1 NEW SDX,SDX1
+2 SET SDX=0
+3 FOR
SET SDX=$ORDER(^SD(409.73,"AACXMIT",SDX))
if 'SDX
QUIT
Begin DoDot:1
+4 FOR SDX1=0:0
SET SDX1=$ORDER(^SD(409.73,"AACXMIT",SDX,SDX1))
if 'SDX1
QUIT
Begin DoDot:2
+5 ; check if encounter beyond today's send range
+6 SET SDEN=+$PIECE($GET(^SD(409.73,SDX1,0)),U,2)
if 'SDEN
QUIT
IF $GET(^SCE(SDEN,0))>SDEND!('$GET(^SCE(SDEN,0)))
Begin DoDot:3
+7 SET DIE="^SD(409.73,"
SET DA=SDX1
SET DR=".04////0"
DO ^DIE
End DoDot:3
End DoDot:2
End DoDot:1
+8 QUIT
SETFL ; loop checks encounters transmitted up through date/time of patch installation
+1 FOR
SET SDDATE=$ORDER(^SCE("B",SDDATE))
if 'SDDATE!(SDDATE>SDEND)
QUIT
Begin DoDot:1
+2 FOR SDEN=0:0
SET SDEN=$ORDER(^SCE("B",SDDATE,SDEN))
if 'SDEN
QUIT
SET SDN=$ORDER(^SD(409.73,"AENC",SDEN,0))
IF SDN
Begin DoDot:2
+3 ; quit if xmit date after patch install or already set to YES
+4 if ($GET(^SD(409.73,SDN,1))>SDPATCH)!$PIECE($GET(^(0)),U,4)
QUIT
+5 SET DIE="^SD(409.73,"
SET DR=".04////1"
SET DA=SDN
DO ^DIE
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
CLNDONE ; cleanup done
+1 ;update node and create bulletin
+2 SET $PIECE(^SD(404.91,1,"PATCH70"),U,2)=""
+3 ;
MSG NEW MSGTXT,XMB,XMTEXT,XMY,XMDUZ,XMDT,XMZ,DIFROM
+1 SET XMB="SCDX AMBCARE TO NPCDB SUMMARY"
+2 ; recipients are same as for SCDX AMBCARE TO NPCDB SUMMARY bulletin
+3 ; and group at Albany IRMFO
+4 SET XMY("G.ACRP MAINTENANCE@ISC-ALBANY")=""
+5 ;subject
SET XMB(1)="** HL7 TRANSMISSIONS UP-TO-DATE **"
+6 ; message text
+7 SET MSGTXT(1)="Patch SD*5.3*70 began retransmitting Ambulatory Care Reporting Project"
+8 SET MSGTXT(2)="(ACRP) data beginning with encounters on 10/1. The retransmission of past"
+9 SET MSGTXT(3)="workload is now complete. The nightly background job will now resume"
+10 SET MSGTXT(4)="normal operations."
+11 SET XMTEXT="MSGTXT("
+12 ;
+13 DO ^XMB
+14 QUIT
