DG53209 ;BP-CIOFO/JRP - KIDS INSTALL ROUTINE FOR DG*5.3*209;8/25/98
;;5.3;Registration;**209**;Aug 13, 1993
;
ENV ;Environment check
N DG53209
;Check for existance of required domain
Q:$$FIND1^DIC(4.2,,"QX","Q-NPP.DOMAIN.EXT","B",,"DG53209")
;Required domain not found
W !
W !,"***"
W !,"*** Installation of this patch requires that the domain"
W !,"*** Q-NPP.DOMAIN.EXT be defined. Installation aborted."
W !,"***"
W !
S XPDQUIT=1
Q
;
PRE ;Pre-init
;Turn off ADT/R HL7 messaging
D BMES^XPDUTL("Disabling PIMS v2.3 messages")
D STOP23^VAFHPOST
Q
;
POST ;Post-init
N PROT,PROTFIX,DG53209,OFFSET,CLIENT,SERVER
POST1 ;Make sure required ADT-Axx protocols are enabled
D MES^XPDUTL(" ")
D BMES^XPDUTL("Ensuring that required HL7 protocols are enabled")
F OFFSET=1:1 S PROT=$P($T(DATA1+OFFSET),";;",2) Q:(PROT="") D
.S PROTFIX=$$PROTON(PROT)
.S DG53209=PROT_$S(('PROTFIX):" could not be ",1:" ")_"enabled"
.S DG53209=" "_$S(('PROTFIX):"** ",1:"")_DG53209
.D MES^XPDUTL(DG53209)
POST2 ;Remove subscription of VAFC ADT-xxx CLIENT to VAFC ADT-xxx SERVER
I ('$G(XPDQUES("POS-REMOVE-SUBSCRIPTION"),1)) G POST3
D MES^XPDUTL(" ")
D BMES^XPDUTL("Removing subscription of VAFC ADT-xxx CLIENT to VAFC ADT-xxx SERVER")
F OFFSET=1:1 S PROT=$P($T(DATA2+OFFSET),";;",2) Q:(PROT="") D
.S CLIENT=$P(PROT,"^",1)
.S SERVER=$P(PROT,"^",2)
.S PROTFIX=$$UNSUB(CLIENT,SERVER)
.S DG53209=CLIENT_$S(('PROTFIX):" could not be ",1:" ")_"removed from "
.S DG53209=" "_$S(('PROTFIX):"*** ",1:"")_DG53209_SERVER
.D MES^XPDUTL(DG53209)
POST3 ;Turn on ADT/R HL7 messaging
D MES^XPDUTL(" ")
D BMES^XPDUTL("Enabling PIMS v2.3 messages")
D SEND23^VAFHPOST
Q
;
PROTON(NAME) ;Enable protocol
;Input : NAME - Name of protocol
;Output : 1 - Protocol enabled
; 0 - Protocol couldn't be enabled
;
Q:($G(NAME)="") 0
N PTR101,FDAROOT,MSGROOT,IENS
S FDAROOT=$NA(^TMP("FDAROOT",$J))
S MSGROOT=$NA(^TMP("DIERR",$J))
K @FDAROOT,@MSGROOT
;Find entry in PROTOCOL file (#101)
S PTR101=$$FIND1^DIC(101,,"X",NAME,"B",,MSGROOT)
;Not found
I ('PTR101) K @FDAROOT,@MSGROOT Q 0
;Enable protocol - delete text from DISABLE field (#2)
K @FDAROOT,@MSGROOT
S IENS=PTR101_","
S @FDAROOT@(101,IENS,2)="@"
D FILE^DIE("S",FDAROOT,MSGROOT)
;Error
I ($D(@MSGROOT)) K @FDAROOT,@MSGROOT Q 0
K @FDAROOT,@MSGROOT
Q 1
;
UNSUB(CLIENT,SERVER) ;Remove subscription of client from server
;Input : CLIENT - Name of HL7 client protocol
; SERVER - Name of HL7 server protocol
;Output : 1 - Success (subscription removed)
; 0 - Failure (subscription not removed)
;
;Bad input
Q:(($G(CLIENT)="")!($G(SERVER)="")) 0
;Declare variables
N PTR101,FDAROOT,MSGROOT,IENS
S FDAROOT=$NA(^TMP("FDAROOT",$J))
S MSGROOT=$NA(^TMP("DIERR",$J))
K @FDAROOT,@MSGROOT
;Find server in PROTOCOL file (#101)
S PTR101=$$FIND1^DIC(101,,"X",SERVER,"B",,MSGROOT)
;Not found (return failure)
I ('PTR101) K @FDAROOT,@MSGROOT Q 0
;Find client in ITEM multiple (#10) of server protocol
S IENS=","_PTR101_","
S PTR101M=$$FIND1^DIC(101.01,IENS,"X",CLIENT,"B",,MSGROOT)
;Not found (return success)
I ('PTR101M) K @FDAROOT,@MSGROOT Q 1
;Remove client from ITEM multiple
S IENS=PTR101M_","_PTR101_","
S @FDAROOT@(101.01,IENS,.01)="@"
K @MSGROOT
D FILE^DIE("",FDAROOT,MSGROOT)
;Failure
I ($D(@MSGROOT)) K @FDAROOT,@MSGROOT Q 0
;Success
K @FDAROOT,@MSGROOT
Q 1
;
;
DATA1 ;
;;VAFC ADT-A01 SERVER
;;VAFC ADT-A02 SERVER
;;VAFC ADT-A03 SERVER
;;VAFC ADT-A04 SERVER
;;VAFC ADT-A08 SERVER
;;VAFC ADT-A08-TSP SERVER
;;VAFC ADT-A11 SERVER
;;VAFC ADT-A12 SERVER
;;VAFC ADT-A13 SERVER
;;DG PTF ADT-A01 CLIENT
;;DG PTF ADT-A02 CLIENT
;;DG PTF ADT-A03 CLIENT
;;DG PTF ADT-A04 CLIENT
;;DG PTF ADT-A08 CLIENT
;;DG PTF ADT-A08-TSP CLIENT
;;DG PTF ADT-A11 CLIENT
;;DG PTF ADT-A12 CLIENT
;;DG PTF ADT-A13 CLIENT
;;
;
;
DATA2 ;;Client Protocol^Server Protocol
;;VAFC ADT-A01 CLIENT^VAFC ADT-A01 SERVER
;;VAFC ADT-A02 CLIENT^VAFC ADT-A02 SERVER
;;VAFC ADT-A03 CLIENT^VAFC ADT-A03 SERVER
;;VAFC ADT-A04 CLIENT^VAFC ADT-A04 SERVER
;;VAFC ADT-A08 CLIENT^VAFC ADT-A08 SERVER
;;VAFC ADT-A08-SCHED CLIENT^VAFC ADT-A08-SCHED SERVER
;;VAFC ADT-A08-SDAM CLIENT^VAFC ADT-A08-SDAM SERVER
;;VAFC ADT-A08-TSP CLIENT^VAFC ADT-A08-TSP SERVER
;;VAFC ADT-A11 CLIENT^VAFC ADT-A11 SERVER
;;VAFC ADT-A12 CLIENT^VAFC ADT-A12 SERVER
;;VAFC ADT-A13 CLIENT^VAFC ADT-A13 SERVER
;;VAFC ADT-A19 CLIENT^VAFC ADT-A19 SERVER
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53209 4568 printed Oct 16, 2024@18:37:20 Page 2
DG53209 ;BP-CIOFO/JRP - KIDS INSTALL ROUTINE FOR DG*5.3*209;8/25/98
+1 ;;5.3;Registration;**209**;Aug 13, 1993
+2 ;
ENV ;Environment check
+1 NEW DG53209
+2 ;Check for existance of required domain
+3 if $$FIND1^DIC(4.2,,"QX","Q-NPP.DOMAIN.EXT","B",,"DG53209")
QUIT
+4 ;Required domain not found
+5 WRITE !
+6 WRITE !,"***"
+7 WRITE !,"*** Installation of this patch requires that the domain"
+8 WRITE !,"*** Q-NPP.DOMAIN.EXT be defined. Installation aborted."
+9 WRITE !,"***"
+10 WRITE !
+11 SET XPDQUIT=1
+12 QUIT
+13 ;
PRE ;Pre-init
+1 ;Turn off ADT/R HL7 messaging
+2 DO BMES^XPDUTL("Disabling PIMS v2.3 messages")
+3 DO STOP23^VAFHPOST
+4 QUIT
+5 ;
POST ;Post-init
+1 NEW PROT,PROTFIX,DG53209,OFFSET,CLIENT,SERVER
POST1 ;Make sure required ADT-Axx protocols are enabled
+1 DO MES^XPDUTL(" ")
+2 DO BMES^XPDUTL("Ensuring that required HL7 protocols are enabled")
+3 FOR OFFSET=1:1
SET PROT=$PIECE($TEXT(DATA1+OFFSET),";;",2)
if (PROT="")
QUIT
Begin DoDot:1
+4 SET PROTFIX=$$PROTON(PROT)
+5 SET DG53209=PROT_$SELECT(('PROTFIX):" could not be ",1:" ")_"enabled"
+6 SET DG53209=" "_$SELECT(('PROTFIX):"** ",1:"")_DG53209
+7 DO MES^XPDUTL(DG53209)
End DoDot:1
POST2 ;Remove subscription of VAFC ADT-xxx CLIENT to VAFC ADT-xxx SERVER
+1 IF ('$GET(XPDQUES("POS-REMOVE-SUBSCRIPTION"),1))
GOTO POST3
+2 DO MES^XPDUTL(" ")
+3 DO BMES^XPDUTL("Removing subscription of VAFC ADT-xxx CLIENT to VAFC ADT-xxx SERVER")
+4 FOR OFFSET=1:1
SET PROT=$PIECE($TEXT(DATA2+OFFSET),";;",2)
if (PROT="")
QUIT
Begin DoDot:1
+5 SET CLIENT=$PIECE(PROT,"^",1)
+6 SET SERVER=$PIECE(PROT,"^",2)
+7 SET PROTFIX=$$UNSUB(CLIENT,SERVER)
+8 SET DG53209=CLIENT_$SELECT(('PROTFIX):" could not be ",1:" ")_"removed from "
+9 SET DG53209=" "_$SELECT(('PROTFIX):"*** ",1:"")_DG53209_SERVER
+10 DO MES^XPDUTL(DG53209)
End DoDot:1
POST3 ;Turn on ADT/R HL7 messaging
+1 DO MES^XPDUTL(" ")
+2 DO BMES^XPDUTL("Enabling PIMS v2.3 messages")
+3 DO SEND23^VAFHPOST
+4 QUIT
+5 ;
PROTON(NAME) ;Enable protocol
+1 ;Input : NAME - Name of protocol
+2 ;Output : 1 - Protocol enabled
+3 ; 0 - Protocol couldn't be enabled
+4 ;
+5 if ($GET(NAME)="")
QUIT 0
+6 NEW PTR101,FDAROOT,MSGROOT,IENS
+7 SET FDAROOT=$NAME(^TMP("FDAROOT",$JOB))
+8 SET MSGROOT=$NAME(^TMP("DIERR",$JOB))
+9 KILL @FDAROOT,@MSGROOT
+10 ;Find entry in PROTOCOL file (#101)
+11 SET PTR101=$$FIND1^DIC(101,,"X",NAME,"B",,MSGROOT)
+12 ;Not found
+13 IF ('PTR101)
KILL @FDAROOT,@MSGROOT
QUIT 0
+14 ;Enable protocol - delete text from DISABLE field (#2)
+15 KILL @FDAROOT,@MSGROOT
+16 SET IENS=PTR101_","
+17 SET @FDAROOT@(101,IENS,2)="@"
+18 DO FILE^DIE("S",FDAROOT,MSGROOT)
+19 ;Error
+20 IF ($DATA(@MSGROOT))
KILL @FDAROOT,@MSGROOT
QUIT 0
+21 KILL @FDAROOT,@MSGROOT
+22 QUIT 1
+23 ;
UNSUB(CLIENT,SERVER) ;Remove subscription of client from server
+1 ;Input : CLIENT - Name of HL7 client protocol
+2 ; SERVER - Name of HL7 server protocol
+3 ;Output : 1 - Success (subscription removed)
+4 ; 0 - Failure (subscription not removed)
+5 ;
+6 ;Bad input
+7 if (($GET(CLIENT)="")!($GET(SERVER)=""))
QUIT 0
+8 ;Declare variables
+9 NEW PTR101,FDAROOT,MSGROOT,IENS
+10 SET FDAROOT=$NAME(^TMP("FDAROOT",$JOB))
+11 SET MSGROOT=$NAME(^TMP("DIERR",$JOB))
+12 KILL @FDAROOT,@MSGROOT
+13 ;Find server in PROTOCOL file (#101)
+14 SET PTR101=$$FIND1^DIC(101,,"X",SERVER,"B",,MSGROOT)
+15 ;Not found (return failure)
+16 IF ('PTR101)
KILL @FDAROOT,@MSGROOT
QUIT 0
+17 ;Find client in ITEM multiple (#10) of server protocol
+18 SET IENS=","_PTR101_","
+19 SET PTR101M=$$FIND1^DIC(101.01,IENS,"X",CLIENT,"B",,MSGROOT)
+20 ;Not found (return success)
+21 IF ('PTR101M)
KILL @FDAROOT,@MSGROOT
QUIT 1
+22 ;Remove client from ITEM multiple
+23 SET IENS=PTR101M_","_PTR101_","
+24 SET @FDAROOT@(101.01,IENS,.01)="@"
+25 KILL @MSGROOT
+26 DO FILE^DIE("",FDAROOT,MSGROOT)
+27 ;Failure
+28 IF ($DATA(@MSGROOT))
KILL @FDAROOT,@MSGROOT
QUIT 0
+29 ;Success
+30 KILL @FDAROOT,@MSGROOT
+31 QUIT 1
+32 ;
+33 ;
DATA1 ;
+1 ;;VAFC ADT-A01 SERVER
+2 ;;VAFC ADT-A02 SERVER
+3 ;;VAFC ADT-A03 SERVER
+4 ;;VAFC ADT-A04 SERVER
+5 ;;VAFC ADT-A08 SERVER
+6 ;;VAFC ADT-A08-TSP SERVER
+7 ;;VAFC ADT-A11 SERVER
+8 ;;VAFC ADT-A12 SERVER
+9 ;;VAFC ADT-A13 SERVER
+10 ;;DG PTF ADT-A01 CLIENT
+11 ;;DG PTF ADT-A02 CLIENT
+12 ;;DG PTF ADT-A03 CLIENT
+13 ;;DG PTF ADT-A04 CLIENT
+14 ;;DG PTF ADT-A08 CLIENT
+15 ;;DG PTF ADT-A08-TSP CLIENT
+16 ;;DG PTF ADT-A11 CLIENT
+17 ;;DG PTF ADT-A12 CLIENT
+18 ;;DG PTF ADT-A13 CLIENT
+19 ;;
+20 ;
+21 ;
DATA2 ;;Client Protocol^Server Protocol
+1 ;;VAFC ADT-A01 CLIENT^VAFC ADT-A01 SERVER
+2 ;;VAFC ADT-A02 CLIENT^VAFC ADT-A02 SERVER
+3 ;;VAFC ADT-A03 CLIENT^VAFC ADT-A03 SERVER
+4 ;;VAFC ADT-A04 CLIENT^VAFC ADT-A04 SERVER
+5 ;;VAFC ADT-A08 CLIENT^VAFC ADT-A08 SERVER
+6 ;;VAFC ADT-A08-SCHED CLIENT^VAFC ADT-A08-SCHED SERVER
+7 ;;VAFC ADT-A08-SDAM CLIENT^VAFC ADT-A08-SDAM SERVER
+8 ;;VAFC ADT-A08-TSP CLIENT^VAFC ADT-A08-TSP SERVER
+9 ;;VAFC ADT-A11 CLIENT^VAFC ADT-A11 SERVER
+10 ;;VAFC ADT-A12 CLIENT^VAFC ADT-A12 SERVER
+11 ;;VAFC ADT-A13 CLIENT^VAFC ADT-A13 SERVER
+12 ;;VAFC ADT-A19 CLIENT^VAFC ADT-A19 SERVER
+13 ;;
