- 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 Mar 13, 2025@21:10:43 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 ;
