- 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 Feb 19, 2025@00:29:49 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 ;