PSJ317P ;BIR/MHA - PADE POST INSTALL ROUTINE; 07/07/15
;;5.0;INPATIENT MEDICATIONS;**317**;16 DEC 97;Build 130
;Reference to ^ORD(101 supported by DBIA #872
;
Q
POST ; Add client to event driver as a subscriber
N SNAM,EX,I,J,LN,SEQ,IN,RETURN S SNAM="PSJ ADT-A01 ROUTER",EX=0
S I=$O(^ORD(101,"B",SNAM,0))
I 'I D MES^XPDUTL(SNAM_" Router Protocol Does Not Exist - Quitting!") Q
F SEQ=1:1 S LN=$T(TAG+SEQ) Q:$P(LN,";",3)="END" D Q:EX
. S J=$P(LN,";",3)_" SERVER",IN=$O(^ORD(101,"B",J,0))
. I 'IN D MES^XPDUTL(J_" Protocol Does Not Exist") S EX=1 Q
. I $D(^ORD(101,IN,775,"B",I)) D Q ;Skip if already present
. . D MES^XPDUTL(SNAM_" is already a Subscribing Protocol to "_J)
. ;Add subscriber to event driver
. S PEN(1)=IN,DATA(.01)=I
. S RETURN=$$ADD(101.0775,.PEN,.DATA,.ERROR)
. D MES^XPDUTL("Added "_SNAM_" as a subscriber to "_J)
;S SNAM="PSJ ADT-A08-SDAM ROUTER"
S SNAM="PSJ SIU-SDAM ROUTER"
S I=$O(^ORD(101,"B",SNAM,0))
I 'I D MES^XPDUTL(SNAM_" Router Protocol Does Not Exist - Quitting!") Q
S J="VAFC ADT-A08-SDAM SERVER",IN=$O(^ORD(101,"B",J,0))
I 'IN D MES^XPDUTL(J_" Protocol Does Not Exist") Q
I $D(^ORD(101,IN,775,"B",I)) D G LL ;Skip if already present
. D MES^XPDUTL(SNAM_" is already a Subscribing Protocol to "_J)
;Add subscriber to event driver
S PEN(1)=IN,DATA(.01)=I
S RETURN=$$ADD(101.0775,.PEN,.DATA,.ERROR)
D MES^XPDUTL("Added "_SNAM_" as a subscriber to "_J)
;as per the VIE/HL7 team, hard set AUTOSTART field(4.5) to 1 (Enabled) & DO NOT PING field (#24) to "Yes" for PSJ PADE Logical Link
LL K DIC,DIE S (DIC,DIE)=870,DIC(0)="",X="PSJ PADE" D ^DIC Q:Y<0
S DR="4.5////1;24////1",DA=+Y D ^DIE K DIC,DIE,DR,DA
Q
;
ADD(FILE,PEN,DATA,ERROR,IEN) ; Add
N FDA,FIELD,IENA,IENS,ERRORS,DIERR
S PEN="+1"
S IENS=$$IENS^DILF(.PEN)
S FIELD=0
F S FIELD=$O(DATA(FIELD)) Q:'FIELD S FDA(FILE,IENS,FIELD)=$G(DATA(FIELD))
I $G(IEN) S IENA(1)=IEN
D UPDATE^DIE("","FDA","IENA","ERRORS(1)")
I +$G(DIERR) D
. D MES^XPDUTL($G(ERRORS(1,"DIERR",1,"TEXT",1)))
. S IEN=""
E D
. S IEN=IENA(1)
D CLEAN^DILF
Q IEN
TAG ;
;;VAFC ADT-A01
;;VAFC ADT-A02
;;VAFC ADT-A03
;;VAFC ADT-A08
;;VAFC ADT-A08-TSP
;;VAFC ADT-A11
;;VAFC ADT-A12
;;VAFC ADT-A13
;;END
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJ317P 2270 printed Sep 23, 2025@19:41:57 Page 2
PSJ317P ;BIR/MHA - PADE POST INSTALL ROUTINE; 07/07/15
+1 ;;5.0;INPATIENT MEDICATIONS;**317**;16 DEC 97;Build 130
+2 ;Reference to ^ORD(101 supported by DBIA #872
+3 ;
+4 QUIT
POST ; Add client to event driver as a subscriber
+1 NEW SNAM,EX,I,J,LN,SEQ,IN,RETURN
SET SNAM="PSJ ADT-A01 ROUTER"
SET EX=0
+2 SET I=$ORDER(^ORD(101,"B",SNAM,0))
+3 IF 'I
DO MES^XPDUTL(SNAM_" Router Protocol Does Not Exist - Quitting!")
QUIT
+4 FOR SEQ=1:1
SET LN=$TEXT(TAG+SEQ)
if $PIECE(LN,";",3)="END"
QUIT
Begin DoDot:1
+5 SET J=$PIECE(LN,";",3)_" SERVER"
SET IN=$ORDER(^ORD(101,"B",J,0))
+6 IF 'IN
DO MES^XPDUTL(J_" Protocol Does Not Exist")
SET EX=1
QUIT
+7 ;Skip if already present
IF $DATA(^ORD(101,IN,775,"B",I))
Begin DoDot:2
+8 DO MES^XPDUTL(SNAM_" is already a Subscribing Protocol to "_J)
End DoDot:2
QUIT
+9 ;Add subscriber to event driver
+10 SET PEN(1)=IN
SET DATA(.01)=I
+11 SET RETURN=$$ADD(101.0775,.PEN,.DATA,.ERROR)
+12 DO MES^XPDUTL("Added "_SNAM_" as a subscriber to "_J)
End DoDot:1
if EX
QUIT
+13 ;S SNAM="PSJ ADT-A08-SDAM ROUTER"
+14 SET SNAM="PSJ SIU-SDAM ROUTER"
+15 SET I=$ORDER(^ORD(101,"B",SNAM,0))
+16 IF 'I
DO MES^XPDUTL(SNAM_" Router Protocol Does Not Exist - Quitting!")
QUIT
+17 SET J="VAFC ADT-A08-SDAM SERVER"
SET IN=$ORDER(^ORD(101,"B",J,0))
+18 IF 'IN
DO MES^XPDUTL(J_" Protocol Does Not Exist")
QUIT
+19 ;Skip if already present
IF $DATA(^ORD(101,IN,775,"B",I))
Begin DoDot:1
+20 DO MES^XPDUTL(SNAM_" is already a Subscribing Protocol to "_J)
End DoDot:1
GOTO LL
+21 ;Add subscriber to event driver
+22 SET PEN(1)=IN
SET DATA(.01)=I
+23 SET RETURN=$$ADD(101.0775,.PEN,.DATA,.ERROR)
+24 DO MES^XPDUTL("Added "_SNAM_" as a subscriber to "_J)
+25 ;as per the VIE/HL7 team, hard set AUTOSTART field(4.5) to 1 (Enabled) & DO NOT PING field (#24) to "Yes" for PSJ PADE Logical Link
LL KILL DIC,DIE
SET (DIC,DIE)=870
SET DIC(0)=""
SET X="PSJ PADE"
DO ^DIC
if Y<0
QUIT
+1 SET DR="4.5////1;24////1"
SET DA=+Y
DO ^DIE
KILL DIC,DIE,DR,DA
+2 QUIT
+3 ;
ADD(FILE,PEN,DATA,ERROR,IEN) ; Add
+1 NEW FDA,FIELD,IENA,IENS,ERRORS,DIERR
+2 SET PEN="+1"
+3 SET IENS=$$IENS^DILF(.PEN)
+4 SET FIELD=0
+5 FOR
SET FIELD=$ORDER(DATA(FIELD))
if 'FIELD
QUIT
SET FDA(FILE,IENS,FIELD)=$GET(DATA(FIELD))
+6 IF $GET(IEN)
SET IENA(1)=IEN
+7 DO UPDATE^DIE("","FDA","IENA","ERRORS(1)")
+8 IF +$GET(DIERR)
Begin DoDot:1
+9 DO MES^XPDUTL($GET(ERRORS(1,"DIERR",1,"TEXT",1)))
+10 SET IEN=""
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET IEN=IENA(1)
End DoDot:1
+13 DO CLEAN^DILF
+14 QUIT IEN
TAG ;
+1 ;;VAFC ADT-A01
+2 ;;VAFC ADT-A02
+3 ;;VAFC ADT-A03
+4 ;;VAFC ADT-A08
+5 ;;VAFC ADT-A08-TSP
+6 ;;VAFC ADT-A11
+7 ;;VAFC ADT-A12
+8 ;;VAFC ADT-A13
+9 ;;END
+10 ;
