VAFHPST2 ;ALB/JRP,PKE - KIDS PRE INSTALL ROUTINE;07-JUN-1996
;;5.3;Registration;**179**;AUG 13, 1993
;
I $G(XPDQUES("POS1"))=1 DO
.; I $$PRODE^XPDUTL("VAFC HL7 INPATIENT CAPTURE","0-disable")
.; IF D BMES^XPDUTL("VAFC HL7 INPATIENT CAPTURE Protocol...Disabled")
.;
.; I $$PRODE^XPDUTL("VAFC HL7 OUTPATIENT CAPTURE","0-disable")
.; IF D BMES^XPDUTL(" VAFC HL7 OUTPATIENT CAPTURE Protocol...Disabled")
.; I $$PRODE^XPDUTL("VAFC HL7 INPATIENT CAPTURE","1-enable") DO
. DO DISABLE
. DO UNSUB
.; .; D BMES^XPDUTL(" VAFC HL7 INPATIENT CAPTURE Protocol...Enabled")
.; E D BMES^XPDUTL(" VAFC HL7 INPATIENT CAPTURE Protocol was not Enabled")
.;
.; I $$PRODE^XPDUTL("VAFC HL7 OUTPATIENT CAPTURE","1-enable") DO
.; . D BMES^XPDUTL(" VAFC HL7 OUTPATIENT CAPTURE Protocol...Enabled")
.; E D BMES^XPDUTL(" VAFC HL7 OUTPATIENT CAPTURE Protocol was not Enabled")
;
I $G(XPDQUES("POS2"))=1 D STATION
;
Q
;
DISABLE ;disable server protocols to prevent unwanted messages
;a04,a08 remain enabled for cirn
N DIC,DIR,DA,DR,C,D,DI,D0,DQ,%,X,Y,DTOUT,DUOUT
;
F VAFZ=1,2,3,6,7,8,9 S VAFS=$T(SPROTO+VAFZ),VAFC=$T(CPROTO+VAFZ) DO
. S VAFS=$P(VAFS,";",3)
.;
.;look up server entry
. S DIC="^ORD(101,",DIC(0)="X"
. S X=VAFS D ^DIC
. I Y<1 DO QUIT
. . D BMES^XPDUTL(">>> "_VAFS_" entry NOT found in File #101")
. . D BMES^XPDUTL("... ")
.;
.;
.;check if already disabled---less confusing if patch is re-run.
. I $P($G(^ORD(101,+Y,0)),"^",3)]""
. E Q
.;
.;disable server
. S DIE="^ORD(101,"
. S DR="2///Disabld DG53*179, enable to activate"
. S DA=+Y D ^DIE
. K DA,DIE
. D BMES^XPDUTL("> "_VAFS_" protocol was disabled")
;
;now do erroneous noww in vafh a01, vafc adt-a08-sched server
;look up server entry
F VAFZ="VAFH A01","VAFC ADT-A08-SCHED SERVER" DO
.
. S DIC="^ORD(101,",DIC(0)="X"
. S X=VAFZ D ^DIC
. I Y<1 DO QUIT
. . D BMES^XPDUTL(">>> "_VAFZ_" entry NOT found in File #101 <<<")
. . D BMES^XPDUTL("... ")
.;
.;check if erroneous distribution
. I $E($P($G(^ORD(101,+Y,0)),"^",3),1,4)="NOWW"
. E Q
.;disable server
. S DIE="^ORD(101,"
. S DR="2///@"
. S DA=+Y D ^DIE
. K DA,DIE
. D BMES^XPDUTL(">>> "_VAFZ_" protocol was enabled <<<")
Q
;
UNSUB ;remove a04, a08 items from VAFC server protocols to unsubscribe clients
;CIRN has its own clients for A04, A08
N DIC,DIK,DA,DR,C,D,DI,D0,DQ,%,X,Y,DTOUT,DUOUT
F VAFZ=4,5 S VAFS=$T(SPROTO+VAFZ),VAFC=$T(CPROTO+VAFZ) DO
. S VAFS=$P(VAFS,";",3),VAFC=$P(VAFC,";",3)
.;look up server entry
. S DIC="^ORD(101,",DIC(0)="X"
. S X=VAFS D ^DIC
. I Y<1 DO QUIT
. . D BMES^XPDUTL(">>> "_VAFS_" entry NOT found in File #101")
. . D BMES^XPDUTL("... ")
.;
.;look up client item
. S DA(1)=+Y
. S DIC="^ORD(101,"_DA(1)_",10,",DIC(0)="XZ"
. S X=VAFC D ^DIC
. I Y<1 DO QUIT
. . D BMES^XPDUTL(">>> "_VAFC_" entry NOT found in ITEM subfile #101.01")
. . D BMES^XPDUTL("... ")
.;
.;delete client item
. S DIK="^ORD(101,"_DA(1)_",10,"
. S DA=+Y D ^DIK
. K DA,DIK
.D BMES^XPDUTL("> "_$G(Y(0,0))_" deleted from "_VAFS_" protocol")
;
Q
;
SPROTO ;; server protocols
;;VAFC ADT-A01 SERVER;1
;;VAFC ADT-A02 SERVER;2
;;VAFC ADT-A03 SERVER;3
;;VAFC ADT-A04 SERVER;4
;;VAFC ADT-A08 SERVER;5
;;VAFC ADT-A11 SERVER;6
;;VAFC ADT-A12 SERVER;7
;;VAFC ADT-A13 SERVER;8
;;VAFC ADT-A19 SERVER;9
;
; client protocols to unsubscribe, remove
CPROTO ;; from item subfield of corresponding server protocol.
;;VAFC ADT-A01 CLIENT;1
;;VAFC ADT-A02 CLIENT;2
;;VAFC ADT-A03 CLIENT;3
;;VAFC ADT-A04 CLIENT;4
;;VAFC ADT-A08 CLIENT;5
;;VAFC ADT-A11 CLIENT;6
;;VAFC ADT-A12 CLIENT;7
;;VAFC ADT-A13 CLIENT;8
;;VAFC ADT-A19 CLIENT;9
;
;
;
STATION ;set facility name in HL7 APPLICATIONS #771
;
;input : None
;ouput : None
D BMES^XPDUTL(">>> Adding Facility-Station number to 'VAFH PIMS' entry in File #771")
N DIC,DIE,DA,DR,C,D,DI,D0,DQ,%,X,Y,DTOUT,DUOUT
S X="VAFH PIMS",DIC(0)="MZ" S (DIE,DIC)="^HL(771,"
D ^DIC
I Y<1 DO QUIT
. D BMES^XPDUTL(">>> 'VAFH PIMS' entry NOT found in File #771")
. D BMES^XPDUTL("... ")
S DA=+Y
I +($P($$SITE^VASITE(),U,3))=+($$SITE^VASITE()) Q
S DR="3///^S X=+($P($$SITE^VASITE(),U,3))"
D ^DIE
;
D BMES^XPDUTL(">>> Adding Facility-Station number to 'VAFC PIMS' entry in File #771")
N DIC,DIE,DA,DR,C,D,DI,D0,DQ,%,X,Y,DTOUT,DUOUT
S X="VAFC PIMS",DIC(0)="MZ" S (DIE,DIC)="^HL(771,"
D ^DIC
I Y<1 DO QUIT
. D BMES^XPDUTL(">>> 'VAFC PIMS' entry NOT found in File #771")
. D BMES^XPDUTL("... ")
S DA=+Y,DR="3///^S X=+($P($$SITE^VASITE(),U,3))"
D ^DIE
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHPST2 4678 printed Sep 23, 2025@20:39:41 Page 2
VAFHPST2 ;ALB/JRP,PKE - KIDS PRE INSTALL ROUTINE;07-JUN-1996
+1 ;;5.3;Registration;**179**;AUG 13, 1993
+2 ;
+3 IF $GET(XPDQUES("POS1"))=1
Begin DoDot:1
+4 ; I $$PRODE^XPDUTL("VAFC HL7 INPATIENT CAPTURE","0-disable")
+5 ; IF D BMES^XPDUTL("VAFC HL7 INPATIENT CAPTURE Protocol...Disabled")
+6 ;
+7 ; I $$PRODE^XPDUTL("VAFC HL7 OUTPATIENT CAPTURE","0-disable")
+8 ; IF D BMES^XPDUTL(" VAFC HL7 OUTPATIENT CAPTURE Protocol...Disabled")
+9 ; I $$PRODE^XPDUTL("VAFC HL7 INPATIENT CAPTURE","1-enable") DO
+10 DO DISABLE
+11 DO UNSUB
+12 ; .; D BMES^XPDUTL(" VAFC HL7 INPATIENT CAPTURE Protocol...Enabled")
+13 ; E D BMES^XPDUTL(" VAFC HL7 INPATIENT CAPTURE Protocol was not Enabled")
+14 ;
+15 ; I $$PRODE^XPDUTL("VAFC HL7 OUTPATIENT CAPTURE","1-enable") DO
+16 ; . D BMES^XPDUTL(" VAFC HL7 OUTPATIENT CAPTURE Protocol...Enabled")
+17 ; E D BMES^XPDUTL(" VAFC HL7 OUTPATIENT CAPTURE Protocol was not Enabled")
End DoDot:1
+18 ;
+19 IF $GET(XPDQUES("POS2"))=1
DO STATION
+20 ;
+21 QUIT
+22 ;
DISABLE ;disable server protocols to prevent unwanted messages
+1 ;a04,a08 remain enabled for cirn
+2 NEW DIC,DIR,DA,DR,C,D,DI,D0,DQ,%,X,Y,DTOUT,DUOUT
+3 ;
+4 FOR VAFZ=1,2,3,6,7,8,9
SET VAFS=$TEXT(SPROTO+VAFZ)
SET VAFC=$TEXT(CPROTO+VAFZ)
Begin DoDot:1
+5 SET VAFS=$PIECE(VAFS,";",3)
+6 ;
+7 ;look up server entry
+8 SET DIC="^ORD(101,"
SET DIC(0)="X"
+9 SET X=VAFS
DO ^DIC
+10 IF Y<1
Begin DoDot:2
+11 DO BMES^XPDUTL(">>> "_VAFS_" entry NOT found in File #101")
+12 DO BMES^XPDUTL("... ")
End DoDot:2
QUIT
+13 ;
+14 ;
+15 ;check if already disabled---less confusing if patch is re-run.
+16 IF $PIECE($GET(^ORD(101,+Y,0)),"^",3)]""
+17 IF '$TEST
QUIT
+18 ;
+19 ;disable server
+20 SET DIE="^ORD(101,"
+21 SET DR="2///Disabld DG53*179, enable to activate"
+22 SET DA=+Y
DO ^DIE
+23 KILL DA,DIE
+24 DO BMES^XPDUTL("> "_VAFS_" protocol was disabled")
End DoDot:1
+25 ;
+26 ;now do erroneous noww in vafh a01, vafc adt-a08-sched server
+27 ;look up server entry
+28 FOR VAFZ="VAFH A01","VAFC ADT-A08-SCHED SERVER"
Begin DoDot:1
+29 +30 SET DIC="^ORD(101,"
SET DIC(0)="X"
+31 SET X=VAFZ
DO ^DIC
+32 IF Y<1
Begin DoDot:2
+33 DO BMES^XPDUTL(">>> "_VAFZ_" entry NOT found in File #101 <<<")
+34 DO BMES^XPDUTL("... ")
End DoDot:2
QUIT
+35 ;
+36 ;check if erroneous distribution
+37 IF $EXTRACT($PIECE($GET(^ORD(101,+Y,0)),"^",3),1,4)="NOWW"
+38 IF '$TEST
QUIT
+39 ;disable server
+40 SET DIE="^ORD(101,"
+41 SET DR="2///@"
+42 SET DA=+Y
DO ^DIE
+43 KILL DA,DIE
+44 DO BMES^XPDUTL(">>> "_VAFZ_" protocol was enabled <<<")
End DoDot:1
+45 QUIT
+46 ;
UNSUB ;remove a04, a08 items from VAFC server protocols to unsubscribe clients
+1 ;CIRN has its own clients for A04, A08
+2 NEW DIC,DIK,DA,DR,C,D,DI,D0,DQ,%,X,Y,DTOUT,DUOUT
+3 FOR VAFZ=4,5
SET VAFS=$TEXT(SPROTO+VAFZ)
SET VAFC=$TEXT(CPROTO+VAFZ)
Begin DoDot:1
+4 SET VAFS=$PIECE(VAFS,";",3)
SET VAFC=$PIECE(VAFC,";",3)
+5 ;look up server entry
+6 SET DIC="^ORD(101,"
SET DIC(0)="X"
+7 SET X=VAFS
DO ^DIC
+8 IF Y<1
Begin DoDot:2
+9 DO BMES^XPDUTL(">>> "_VAFS_" entry NOT found in File #101")
+10 DO BMES^XPDUTL("... ")
End DoDot:2
QUIT
+11 ;
+12 ;look up client item
+13 SET DA(1)=+Y
+14 SET DIC="^ORD(101,"_DA(1)_",10,"
SET DIC(0)="XZ"
+15 SET X=VAFC
DO ^DIC
+16 IF Y<1
Begin DoDot:2
+17 DO BMES^XPDUTL(">>> "_VAFC_" entry NOT found in ITEM subfile #101.01")
+18 DO BMES^XPDUTL("... ")
End DoDot:2
QUIT
+19 ;
+20 ;delete client item
+21 SET DIK="^ORD(101,"_DA(1)_",10,"
+22 SET DA=+Y
DO ^DIK
+23 KILL DA,DIK
+24 DO BMES^XPDUTL("> "_$GET(Y(0,0))_" deleted from "_VAFS_" protocol")
End DoDot:1
+25 ;
+26 QUIT
+27 ;
SPROTO ;; server protocols
+1 ;;VAFC ADT-A01 SERVER;1
+2 ;;VAFC ADT-A02 SERVER;2
+3 ;;VAFC ADT-A03 SERVER;3
+4 ;;VAFC ADT-A04 SERVER;4
+5 ;;VAFC ADT-A08 SERVER;5
+6 ;;VAFC ADT-A11 SERVER;6
+7 ;;VAFC ADT-A12 SERVER;7
+8 ;;VAFC ADT-A13 SERVER;8
+9 ;;VAFC ADT-A19 SERVER;9
+10 ;
+11 ; client protocols to unsubscribe, remove
CPROTO ;; from item subfield of corresponding server protocol.
+1 ;;VAFC ADT-A01 CLIENT;1
+2 ;;VAFC ADT-A02 CLIENT;2
+3 ;;VAFC ADT-A03 CLIENT;3
+4 ;;VAFC ADT-A04 CLIENT;4
+5 ;;VAFC ADT-A08 CLIENT;5
+6 ;;VAFC ADT-A11 CLIENT;6
+7 ;;VAFC ADT-A12 CLIENT;7
+8 ;;VAFC ADT-A13 CLIENT;8
+9 ;;VAFC ADT-A19 CLIENT;9
+10 ;
+11 ;
+12 ;
STATION ;set facility name in HL7 APPLICATIONS #771
+1 ;
+2 ;input : None
+3 ;ouput : None
+4 DO BMES^XPDUTL(">>> Adding Facility-Station number to 'VAFH PIMS' entry in File #771")
+5 NEW DIC,DIE,DA,DR,C,D,DI,D0,DQ,%,X,Y,DTOUT,DUOUT
+6 SET X="VAFH PIMS"
SET DIC(0)="MZ"
SET (DIE,DIC)="^HL(771,"
+7 DO ^DIC
+8 IF Y<1
Begin DoDot:1
+9 DO BMES^XPDUTL(">>> 'VAFH PIMS' entry NOT found in File #771")
+10 DO BMES^XPDUTL("... ")
End DoDot:1
QUIT
+11 SET DA=+Y
+12 IF +($PIECE($$SITE^VASITE(),U,3))=+($$SITE^VASITE())
QUIT
+13 SET DR="3///^S X=+($P($$SITE^VASITE(),U,3))"
+14 DO ^DIE
+15 ;
+16 DO BMES^XPDUTL(">>> Adding Facility-Station number to 'VAFC PIMS' entry in File #771")
+17 NEW DIC,DIE,DA,DR,C,D,DI,D0,DQ,%,X,Y,DTOUT,DUOUT
+18 SET X="VAFC PIMS"
SET DIC(0)="MZ"
SET (DIE,DIC)="^HL(771,"
+19 DO ^DIC
+20 IF Y<1
Begin DoDot:1
+21 DO BMES^XPDUTL(">>> 'VAFC PIMS' entry NOT found in File #771")
+22 DO BMES^XPDUTL("... ")
End DoDot:1
QUIT
+23 SET DA=+Y
SET DR="3///^S X=+($P($$SITE^VASITE(),U,3))"
+24 DO ^DIE
+25 QUIT
+26 ;
