Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFHPST2

VAFHPST2.m

Go to the documentation of this file.
  1. VAFHPST2 ;ALB/JRP,PKE - KIDS PRE INSTALL ROUTINE;07-JUN-1996
  1. ;;5.3;Registration;**179**;AUG 13, 1993
  1. ;
  1. I $G(XPDQUES("POS1"))=1 DO
  1. .; I $$PRODE^XPDUTL("VAFC HL7 INPATIENT CAPTURE","0-disable")
  1. .; IF D BMES^XPDUTL("VAFC HL7 INPATIENT CAPTURE Protocol...Disabled")
  1. .;
  1. .; I $$PRODE^XPDUTL("VAFC HL7 OUTPATIENT CAPTURE","0-disable")
  1. .; IF D BMES^XPDUTL(" VAFC HL7 OUTPATIENT CAPTURE Protocol...Disabled")
  1. .; I $$PRODE^XPDUTL("VAFC HL7 INPATIENT CAPTURE","1-enable") DO
  1. . DO DISABLE
  1. . DO UNSUB
  1. .; .; D BMES^XPDUTL(" VAFC HL7 INPATIENT CAPTURE Protocol...Enabled")
  1. .; E D BMES^XPDUTL(" VAFC HL7 INPATIENT CAPTURE Protocol was not Enabled")
  1. .;
  1. .; I $$PRODE^XPDUTL("VAFC HL7 OUTPATIENT CAPTURE","1-enable") DO
  1. .; . D BMES^XPDUTL(" VAFC HL7 OUTPATIENT CAPTURE Protocol...Enabled")
  1. .; E D BMES^XPDUTL(" VAFC HL7 OUTPATIENT CAPTURE Protocol was not Enabled")
  1. ;
  1. I $G(XPDQUES("POS2"))=1 D STATION
  1. ;
  1. Q
  1. ;
  1. DISABLE ;disable server protocols to prevent unwanted messages
  1. ;a04,a08 remain enabled for cirn
  1. N DIC,DIR,DA,DR,C,D,DI,D0,DQ,%,X,Y,DTOUT,DUOUT
  1. ;
  1. F VAFZ=1,2,3,6,7,8,9 S VAFS=$T(SPROTO+VAFZ),VAFC=$T(CPROTO+VAFZ) DO
  1. . S VAFS=$P(VAFS,";",3)
  1. .;
  1. .;look up server entry
  1. . S DIC="^ORD(101,",DIC(0)="X"
  1. . S X=VAFS D ^DIC
  1. . I Y<1 DO QUIT
  1. . . D BMES^XPDUTL(">>> "_VAFS_" entry NOT found in File #101")
  1. . . D BMES^XPDUTL("... ")
  1. .;
  1. .;
  1. .;check if already disabled---less confusing if patch is re-run.
  1. . I $P($G(^ORD(101,+Y,0)),"^",3)]""
  1. . E Q
  1. .;
  1. .;disable server
  1. . S DIE="^ORD(101,"
  1. . S DR="2///Disabld DG53*179, enable to activate"
  1. . S DA=+Y D ^DIE
  1. . K DA,DIE
  1. . D BMES^XPDUTL("> "_VAFS_" protocol was disabled")
  1. ;
  1. ;now do erroneous noww in vafh a01, vafc adt-a08-sched server
  1. ;look up server entry
  1. F VAFZ="VAFH A01","VAFC ADT-A08-SCHED SERVER" DO
  1. .
  1. . S DIC="^ORD(101,",DIC(0)="X"
  1. . S X=VAFZ D ^DIC
  1. . I Y<1 DO QUIT
  1. . . D BMES^XPDUTL(">>> "_VAFZ_" entry NOT found in File #101 <<<")
  1. . . D BMES^XPDUTL("... ")
  1. .;
  1. .;check if erroneous distribution
  1. . I $E($P($G(^ORD(101,+Y,0)),"^",3),1,4)="NOWW"
  1. . E Q
  1. .;disable server
  1. . S DIE="^ORD(101,"
  1. . S DR="2///@"
  1. . S DA=+Y D ^DIE
  1. . K DA,DIE
  1. . D BMES^XPDUTL(">>> "_VAFZ_" protocol was enabled <<<")
  1. Q
  1. ;
  1. UNSUB ;remove a04, a08 items from VAFC server protocols to unsubscribe clients
  1. ;CIRN has its own clients for A04, A08
  1. N DIC,DIK,DA,DR,C,D,DI,D0,DQ,%,X,Y,DTOUT,DUOUT
  1. F VAFZ=4,5 S VAFS=$T(SPROTO+VAFZ),VAFC=$T(CPROTO+VAFZ) DO
  1. . S VAFS=$P(VAFS,";",3),VAFC=$P(VAFC,";",3)
  1. .;look up server entry
  1. . S DIC="^ORD(101,",DIC(0)="X"
  1. . S X=VAFS D ^DIC
  1. . I Y<1 DO QUIT
  1. . . D BMES^XPDUTL(">>> "_VAFS_" entry NOT found in File #101")
  1. . . D BMES^XPDUTL("... ")
  1. .;
  1. .;look up client item
  1. . S DA(1)=+Y
  1. . S DIC="^ORD(101,"_DA(1)_",10,",DIC(0)="XZ"
  1. . S X=VAFC D ^DIC
  1. . I Y<1 DO QUIT
  1. . . D BMES^XPDUTL(">>> "_VAFC_" entry NOT found in ITEM subfile #101.01")
  1. . . D BMES^XPDUTL("... ")
  1. .;
  1. .;delete client item
  1. . S DIK="^ORD(101,"_DA(1)_",10,"
  1. . S DA=+Y D ^DIK
  1. . K DA,DIK
  1. .D BMES^XPDUTL("> "_$G(Y(0,0))_" deleted from "_VAFS_" protocol")
  1. ;
  1. Q
  1. ;
  1. SPROTO ;; server protocols
  1. ;;VAFC ADT-A01 SERVER;1
  1. ;;VAFC ADT-A02 SERVER;2
  1. ;;VAFC ADT-A03 SERVER;3
  1. ;;VAFC ADT-A04 SERVER;4
  1. ;;VAFC ADT-A08 SERVER;5
  1. ;;VAFC ADT-A11 SERVER;6
  1. ;;VAFC ADT-A12 SERVER;7
  1. ;;VAFC ADT-A13 SERVER;8
  1. ;;VAFC ADT-A19 SERVER;9
  1. ;
  1. ; client protocols to unsubscribe, remove
  1. CPROTO ;; from item subfield of corresponding server protocol.
  1. ;;VAFC ADT-A01 CLIENT;1
  1. ;;VAFC ADT-A02 CLIENT;2
  1. ;;VAFC ADT-A03 CLIENT;3
  1. ;;VAFC ADT-A04 CLIENT;4
  1. ;;VAFC ADT-A08 CLIENT;5
  1. ;;VAFC ADT-A11 CLIENT;6
  1. ;;VAFC ADT-A12 CLIENT;7
  1. ;;VAFC ADT-A13 CLIENT;8
  1. ;;VAFC ADT-A19 CLIENT;9
  1. ;
  1. ;
  1. ;
  1. STATION ;set facility name in HL7 APPLICATIONS #771
  1. ;
  1. ;input : None
  1. ;ouput : None
  1. D BMES^XPDUTL(">>> Adding Facility-Station number to 'VAFH PIMS' entry in File #771")
  1. N DIC,DIE,DA,DR,C,D,DI,D0,DQ,%,X,Y,DTOUT,DUOUT
  1. S X="VAFH PIMS",DIC(0)="MZ" S (DIE,DIC)="^HL(771,"
  1. D ^DIC
  1. I Y<1 DO QUIT
  1. . D BMES^XPDUTL(">>> 'VAFH PIMS' entry NOT found in File #771")
  1. . D BMES^XPDUTL("... ")
  1. S DA=+Y
  1. I +($P($$SITE^VASITE(),U,3))=+($$SITE^VASITE()) Q
  1. S DR="3///^S X=+($P($$SITE^VASITE(),U,3))"
  1. D ^DIE
  1. ;
  1. D BMES^XPDUTL(">>> Adding Facility-Station number to 'VAFC PIMS' entry in File #771")
  1. N DIC,DIE,DA,DR,C,D,DI,D0,DQ,%,X,Y,DTOUT,DUOUT
  1. S X="VAFC PIMS",DIC(0)="MZ" S (DIE,DIC)="^HL(771,"
  1. D ^DIC
  1. I Y<1 DO QUIT
  1. . D BMES^XPDUTL(">>> 'VAFC PIMS' entry NOT found in File #771")
  1. . D BMES^XPDUTL("... ")
  1. S DA=+Y,DR="3///^S X=+($P($$SITE^VASITE(),U,3))"
  1. D ^DIE
  1. Q
  1. ;