SD5370PT.m

SD5370PT ;ALB/ABR - Initialize new parameters in Scheduling Param file ; 10/28/96

 ;;5.3;Scheduling;**70**;AUG 13, 1993

 ;

EN ;

 I $G(^SD(404.91,1,"PATCH70")) D BMES^XPDUTL(" ** Cannot re-run this post-install **") Q  ; do not allow re-run of post-install

 D FILEK

 D FILEC

 D HLAPP

 D SDPAR

 D HLM

 Q

FILEC ;clean up of file 409.73

 N DIK,DA

 D BMES^XPDUTL(">>Re-set of file 409.73 - TRANSMITTED OUTPATIENT ENCOUNTER begun")

 N SDN,SDTEN,XPDIDTOT,SDI

 D XREF

 S SDN=0,XPDIDTOT=$P(^SD(409.73,0),U,4),SDTEN=XPDIDTOT\10+1

 F SDI=1:1 S SDN=$O(^SD(409.73,SDN)) Q:'SDN  D  I '(SDI#SDTEN) D UPDATE^XPDID(SDI)

 . I $P($G(^SD(409.73,SDN,0)),U,5)=3 D  Q

 .. ; remove deleted encounters records

 .. S DIK="^SD(409.73,",DA=SDN D ^DIK

 .. Q

 . ; set to transmission not required, delete x-mit refs.

 . S $P(^SD(409.73,SDN,0),U,4)=0,^(1)="^^^^"

 . Q

 Q

 ;

XREF ;  x-ref cleanup

 D MES^XPDUTL(">>cleaning up cross references.")

 K ^SD(409.73,"AACBID"),^("AACLST"),^("AACMID"),^("AACNOACK"),^("AACXMIT")

 Q

 ;

FILEK ; clear out files 409.74,409.75

 N SDN,SDNODE

 D MES^XPDUTL(">> Cleaning out DELETED OUTPATIENT ENCOUNTER file (#409.74)")

 S SDNODE=$P(^SD(409.74,0),U,1,2)_"^0^0"

 K ^SD(409.74)

 S ^SD(409.74,0)=SDNODE ; reset 0-node

 D MES^XPDUTL(">> Cleaning out TRANSMITTED OUTPATIENT ENCOUNTER ERROR file (#409.75)")

 S SDNODE=$P(^SD(409.75,0),U,1,2)_"^0^0"

 K ^SD(409.75)

 S ^SD(409.75,0)=SDNODE ; reset 0-node

 Q

 ;

HLAPP ;  change AMBCARE-DHCP application name to AMBCARE-DH70

 N DIE,DIC,DA,DR,X,Y

 S DIC="^HL(771,",DIC(0)="X",X="AMBCARE-DHCP" D ^DIC

 I Y<0 D BMES^XPDUTL(">>  AMBCARE-DHCP application not found") Q

 S DIE=DIC,DA=+Y,DR=".01///AMBCARE-DH70" D ^DIE

 Q

 ;

SDPAR ;  This sets the SD70 INSTALL DATE to TODAY, and the 

 ;  SD70 LAST DATE to 9/30/96 

 ;  and AMBCARE MESSAGE LINES to 2000

 N SDINS

 S SDINS=$$HTFM^XLFDT($H)

 S ^SD(404.91,1,"PATCH70")=SDINS_U_2960930,$P(^("AMB"),U,8)=2000

 ;

 D BMES^XPDUTL("New Scheduling parameters initialized in file #404.91")

 D MES^XPDUTL("  SD70 INSTALL DATE set to: "_$$FMTE^XLFDT(SDINS))

 D MES^XPDUTL("  SD70 LAST DATE set to: Sept. 30, 1996")

 D MES^XPDUTL("  AMBCARE MESSAGE LINES set to:  2000")

 Q 

 ;

HLM ; change status to '3' (SUCCESSFULLY COMPLETED) to enable purge of messages

 D BMES^XPDUTL(">> Beginning HL7 message file update")

 N DA,DIC,DIE,DR,X,Y,SDAPP,HLI,XPDIDTOT,HLC,HLTEN

 S XPDIDTOT=$P($G(^HL(772,0)),U,4),HLTEN=XPDIDTOT\10+1

 S DIC="^HL(771,",DIC(0)="M",X="AMBCARE-DH" D ^DIC

 I Y<0 D BMES^XPDUTL(">> AMBCARE-DHCP application not found") Q

 S SDAPP=+Y,DIE="^HL(772,",DR="20////3"

 S HLI=0

 F HLC=1:1 S HLI=$O(^HL(772,HLI)) Q:'HLI  D  I '(HLC#HLTEN) D UPDATE^XPDID(HLC)

 . I $P($G(^HL(772,HLI,0)),U,3)'=SDAPP Q  ;only edit AMBCARE entries.

 . S DA=HLI D ^DIE

 D MES^XPDUTL(">> HL7 message file update complete")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SD5370PT   2857     printed  Feb 19, 2025@00:11:50                                                                                                                                                                                                    Page 2

SD5370PT  ;ALB/ABR - Initialize new parameters in Scheduling Param file ; 10/28/96

 +1       ;;5.3;Scheduling;**70**;AUG 13, 1993

 +2       ;

EN        ;

 +1       ; do not allow re-run of post-install

           IF $GET(^SD(404.91,1,"PATCH70"))

               DO BMES^XPDUTL(" ** Cannot re-run this post-install **")

               QUIT 

 +2        DO FILEK

 +3        DO FILEC

 +4        DO HLAPP

 +5        DO SDPAR

 +6        DO HLM

 +7        QUIT 

FILEC     ;clean up of file 409.73

 +1        NEW DIK,DA

 +2        DO BMES^XPDUTL(">>Re-set of file 409.73 - TRANSMITTED OUTPATIENT ENCOUNTER begun")

 +3        NEW SDN,SDTEN,XPDIDTOT,SDI

 +4        DO XREF

 +5        SET SDN=0

           SET XPDIDTOT=$PIECE(^SD(409.73,0),U,4)

           SET SDTEN=XPDIDTOT\10+1

 +6        FOR SDI=1:1

               SET SDN=$ORDER(^SD(409.73,SDN))

               if 'SDN

                   QUIT 

               Begin DoDot:1

 +7                IF $PIECE($GET(^SD(409.73,SDN,0)),U,5)=3

                       Begin DoDot:2

 +8       ; remove deleted encounters records

 +9                        SET DIK="^SD(409.73,"

                           SET DA=SDN

                           DO ^DIK

 +10                       QUIT 

                       End DoDot:2

                       QUIT 

 +11      ; set to transmission not required, delete x-mit refs.

 +12               SET $PIECE(^SD(409.73,SDN,0),U,4)=0

                   SET ^(1)="^^^^"

 +13               QUIT 

               End DoDot:1

               IF '(SDI#SDTEN)

                   DO UPDATE^XPDID(SDI)

 +14       QUIT 

 +15      ;

XREF      ;  x-ref cleanup

 +1        DO MES^XPDUTL(">>cleaning up cross references.")

 +2        KILL ^SD(409.73,"AACBID"),^("AACLST"),^("AACMID"),^("AACNOACK"),^("AACXMIT")

 +3        QUIT 

 +4       ;

FILEK     ; clear out files 409.74,409.75

 +1        NEW SDN,SDNODE

 +2        DO MES^XPDUTL(">> Cleaning out DELETED OUTPATIENT ENCOUNTER file (#409.74)")

 +3        SET SDNODE=$PIECE(^SD(409.74,0),U,1,2)_"^0^0"

 +4        KILL ^SD(409.74)

 +5       ; reset 0-node

           SET ^SD(409.74,0)=SDNODE

 +6        DO MES^XPDUTL(">> Cleaning out TRANSMITTED OUTPATIENT ENCOUNTER ERROR file (#409.75)")

 +7        SET SDNODE=$PIECE(^SD(409.75,0),U,1,2)_"^0^0"

 +8        KILL ^SD(409.75)

 +9       ; reset 0-node

           SET ^SD(409.75,0)=SDNODE

 +10       QUIT 

 +11      ;

HLAPP     ;  change AMBCARE-DHCP application name to AMBCARE-DH70

 +1        NEW DIE,DIC,DA,DR,X,Y

 +2        SET DIC="^HL(771,"

           SET DIC(0)="X"

           SET X="AMBCARE-DHCP"

           DO ^DIC

 +3        IF Y<0

               DO BMES^XPDUTL(">>  AMBCARE-DHCP application not found")

               QUIT 

 +4        SET DIE=DIC

           SET DA=+Y

           SET DR=".01///AMBCARE-DH70"

           DO ^DIE

 +5        QUIT 

 +6       ;

SDPAR     ;  This sets the SD70 INSTALL DATE to TODAY, and the 

 +1       ;  SD70 LAST DATE to 9/30/96 

 +2       ;  and AMBCARE MESSAGE LINES to 2000

 +3        NEW SDINS

 +4        SET SDINS=$$HTFM^XLFDT($HOROLOG)

 +5        SET ^SD(404.91,1,"PATCH70")=SDINS_U_2960930

           SET $PIECE(^("AMB"),U,8)=2000

 +6       ;

 +7        DO BMES^XPDUTL("New Scheduling parameters initialized in file #404.91")

 +8        DO MES^XPDUTL("  SD70 INSTALL DATE set to: "_$$FMTE^XLFDT(SDINS))

 +9        DO MES^XPDUTL("  SD70 LAST DATE set to: Sept. 30, 1996")

 +10       DO MES^XPDUTL("  AMBCARE MESSAGE LINES set to:  2000")

 +11       QUIT 

 +12      ;

HLM       ; change status to '3' (SUCCESSFULLY COMPLETED) to enable purge of messages

 +1        DO BMES^XPDUTL(">> Beginning HL7 message file update")

 +2        NEW DA,DIC,DIE,DR,X,Y,SDAPP,HLI,XPDIDTOT,HLC,HLTEN

 +3        SET XPDIDTOT=$PIECE($GET(^HL(772,0)),U,4)

           SET HLTEN=XPDIDTOT\10+1

 +4        SET DIC="^HL(771,"

           SET DIC(0)="M"

           SET X="AMBCARE-DH"

           DO ^DIC

 +5        IF Y<0

               DO BMES^XPDUTL(">> AMBCARE-DHCP application not found")

               QUIT 

 +6        SET SDAPP=+Y

           SET DIE="^HL(772,"

           SET DR="20////3"

 +7        SET HLI=0

 +8        FOR HLC=1:1

               SET HLI=$ORDER(^HL(772,HLI))

               if 'HLI

                   QUIT 

               Begin DoDot:1

 +9       ;only edit AMBCARE entries.

                   IF $PIECE($GET(^HL(772,HLI,0)),U,3)'=SDAPP

                       QUIT 

 +10               SET DA=HLI

                   DO ^DIE

               End DoDot:1

               IF '(HLC#HLTEN)

                   DO UPDATE^XPDID(HLC)

 +11       DO MES^XPDUTL(">> HL7 message file update complete")

 +12       QUIT