SCDXUTL5.m

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 ---SCDXUTL5   2689     printed  Apr 23, 2025@18:54:13                                                                                                                                                                                                    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