SCMSP1 ;ALB/JRP - POST INIT ROUTINE;07-JUN-1996
;;5.3;Scheduling;**44**;AUG 13, 1993
;
FIXEVNT ;Enable Ambulatory Care event handler
;
;Input : None
;Output : None
;Notes : This is a KIDS complient check point
;
;Declare variables
N DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT,MSGTXT,PTRPROT
D BMES^XPDUTL(">>> Enabling Ambulatory Care event handler")
;Find protocol
S PTRPROT=+$O(^ORD(101,"B","SCDX AMBCARE EVENT",""))
I ('PTRPROT) D Q
.S MSGTXT(1)=" ** Unable to find SCDX AMBCARE EVENT in PROTOCOL file (#101)"
.S MSGTXT(2)=" ** Entry must be manually created"
.D MES^XPDUTL(.MSGTXT)
;Enable protocol
S DIE="^ORD(101,"
S DA=PTRPROT
S DR="2///@"
D ^DIE
;Done
Q
;
FIXSRVR ;Fix entry in PROTOCOL file (#101) for server protocol
;
;Input : None
;Output : None
;Notes : This is a KIDS complient check point
;
;Declare variables
N DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT,MSGTXT,PTRPROT,PTRAPP
D BMES^XPDUTL(">>> Correcting entry in PROTOCOL file (#101) for server protocol")
;Find server protocol
S PTRPROT=+$O(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",""))
I ('PTRPROT) D Q
.S MSGTXT(1)=" ** Unable to find SCDX AMBCARE SEND SERVER FOR ADT-Z00"
.S MSGTXT(2)=" in PROTOCOL file (#101)"
.S MSGTXT(3)=" ** Entry must be manually created"
.D MES^XPDUTL(.MSGTXT)
;Find server application
S PTRAPP=+$O(^HL(771,"B","AMBCARE-DHCP",""))
I ('PTRAPP) D Q
.S MSGTXT(1)=" ** Unable to find AMBCARE-DHCP in HL7 APPLICATION file (#771)"
.S MSGTXT(2)=" ** Entry must be manually created and attached to"
.S MSGTXT(3)=" the SCDX AMBCARE SEND SERVER FOR ADT-Z00 protocol"
.D MES^XPDUTL(.MSGTXT)
;Fix entry
S DIE="^ORD(101,"
S DA=PTRPROT
S DR="2///@;770.1////^S X=PTRAPP;770.3///ADT;770.11///ADT;770.4///Z00;770.8///NE;770.9///AL;770.95///2.2"
D ^DIE
;Done
Q
;
FIXCLNT ;Fix entry in PROTOCOL file (#101) for client protocol
;
;Input : None
;Output : None
;Notes : This is a KIDS complient check point
;
;Declare variables
N DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT,MSGTXT,PTRPROT,PTRAPP,PTRLINK
D BMES^XPDUTL(">>> Correcting entry in PROTOCOL file (#101) for client protocol")
;Find client protocol
S PTRPROT=+$O(^ORD(101,"B","SCDX AMBCARE SEND CLIENT FOR ADT-Z00",""))
I ('PTRPROT) D Q
.S MSGTXT(1)=" ** Unable to find SCDX AMBCARE SEND CLIENT FOR ADT-Z00"
.S MSGTXT(2)=" in PROTOCOL file (#101)"
.S MSGTXT(3)=" ** Entry must be manually created"
.D MES^XPDUTL(.MSGTXT)
;Find client application
S PTRAPP=+$O(^HL(771,"B","NPCD-AAC",""))
I ('PTRAPP) D Q
.S MSGTXT(1)=" ** Unable to find NPCD-AAC in HL7 APPLICATION file (#771)"
.S MSGTXT(2)=" ** Entry must be manually created and attached to"
.S MSGTXT(3)=" the SCDX AMBCARE SEND CLIENT FOR ADT-Z00 protocol"
.D MES^XPDUTL(.MSGTXT)
;Find logical link
S PTRLINK=+$O(^HLCS(870,"B","AMB-CARE",0))
I ('PTRLINK) D Q
.S MSGTXT(1)=" ** Unable to find AMB-CARE in HL LOGICAL LINK file (#870)"
.S MSGTXT(2)=" ** Entry must be manually created and attached to"
.S MSGTXT(3)=" the SCDX AMBCARE SEND CLIENT FOR ADT-Z00 protocol"
.D MES^XPDUTL(.MSGTXT)
;Fix entry
S DIE="^ORD(101,"
S DA=PTRPROT
S DR="2///@;770.2////^S X=PTRAPP;770.3///ADT;770.11///ADT;770.4///Z00;770.7////^S X=PTRLINK;770.95///2.2"
D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMSP1 3361 printed Dec 13, 2024@02:41:53 Page 2
SCMSP1 ;ALB/JRP - POST INIT ROUTINE;07-JUN-1996
+1 ;;5.3;Scheduling;**44**;AUG 13, 1993
+2 ;
FIXEVNT ;Enable Ambulatory Care event handler
+1 ;
+2 ;Input : None
+3 ;Output : None
+4 ;Notes : This is a KIDS complient check point
+5 ;
+6 ;Declare variables
+7 NEW DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT,MSGTXT,PTRPROT
+8 DO BMES^XPDUTL(">>> Enabling Ambulatory Care event handler")
+9 ;Find protocol
+10 SET PTRPROT=+$ORDER(^ORD(101,"B","SCDX AMBCARE EVENT",""))
+11 IF ('PTRPROT)
Begin DoDot:1
+12 SET MSGTXT(1)=" ** Unable to find SCDX AMBCARE EVENT in PROTOCOL file (#101)"
+13 SET MSGTXT(2)=" ** Entry must be manually created"
+14 DO MES^XPDUTL(.MSGTXT)
End DoDot:1
QUIT
+15 ;Enable protocol
+16 SET DIE="^ORD(101,"
+17 SET DA=PTRPROT
+18 SET DR="2///@"
+19 DO ^DIE
+20 ;Done
+21 QUIT
+22 ;
FIXSRVR ;Fix entry in PROTOCOL file (#101) for server protocol
+1 ;
+2 ;Input : None
+3 ;Output : None
+4 ;Notes : This is a KIDS complient check point
+5 ;
+6 ;Declare variables
+7 NEW DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT,MSGTXT,PTRPROT,PTRAPP
+8 DO BMES^XPDUTL(">>> Correcting entry in PROTOCOL file (#101) for server protocol")
+9 ;Find server protocol
+10 SET PTRPROT=+$ORDER(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",""))
+11 IF ('PTRPROT)
Begin DoDot:1
+12 SET MSGTXT(1)=" ** Unable to find SCDX AMBCARE SEND SERVER FOR ADT-Z00"
+13 SET MSGTXT(2)=" in PROTOCOL file (#101)"
+14 SET MSGTXT(3)=" ** Entry must be manually created"
+15 DO MES^XPDUTL(.MSGTXT)
End DoDot:1
QUIT
+16 ;Find server application
+17 SET PTRAPP=+$ORDER(^HL(771,"B","AMBCARE-DHCP",""))
+18 IF ('PTRAPP)
Begin DoDot:1
+19 SET MSGTXT(1)=" ** Unable to find AMBCARE-DHCP in HL7 APPLICATION file (#771)"
+20 SET MSGTXT(2)=" ** Entry must be manually created and attached to"
+21 SET MSGTXT(3)=" the SCDX AMBCARE SEND SERVER FOR ADT-Z00 protocol"
+22 DO MES^XPDUTL(.MSGTXT)
End DoDot:1
QUIT
+23 ;Fix entry
+24 SET DIE="^ORD(101,"
+25 SET DA=PTRPROT
+26 SET DR="2///@;770.1////^S X=PTRAPP;770.3///ADT;770.11///ADT;770.4///Z00;770.8///NE;770.9///AL;770.95///2.2"
+27 DO ^DIE
+28 ;Done
+29 QUIT
+30 ;
FIXCLNT ;Fix entry in PROTOCOL file (#101) for client protocol
+1 ;
+2 ;Input : None
+3 ;Output : None
+4 ;Notes : This is a KIDS complient check point
+5 ;
+6 ;Declare variables
+7 NEW DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT,MSGTXT,PTRPROT,PTRAPP,PTRLINK
+8 DO BMES^XPDUTL(">>> Correcting entry in PROTOCOL file (#101) for client protocol")
+9 ;Find client protocol
+10 SET PTRPROT=+$ORDER(^ORD(101,"B","SCDX AMBCARE SEND CLIENT FOR ADT-Z00",""))
+11 IF ('PTRPROT)
Begin DoDot:1
+12 SET MSGTXT(1)=" ** Unable to find SCDX AMBCARE SEND CLIENT FOR ADT-Z00"
+13 SET MSGTXT(2)=" in PROTOCOL file (#101)"
+14 SET MSGTXT(3)=" ** Entry must be manually created"
+15 DO MES^XPDUTL(.MSGTXT)
End DoDot:1
QUIT
+16 ;Find client application
+17 SET PTRAPP=+$ORDER(^HL(771,"B","NPCD-AAC",""))
+18 IF ('PTRAPP)
Begin DoDot:1
+19 SET MSGTXT(1)=" ** Unable to find NPCD-AAC in HL7 APPLICATION file (#771)"
+20 SET MSGTXT(2)=" ** Entry must be manually created and attached to"
+21 SET MSGTXT(3)=" the SCDX AMBCARE SEND CLIENT FOR ADT-Z00 protocol"
+22 DO MES^XPDUTL(.MSGTXT)
End DoDot:1
QUIT
+23 ;Find logical link
+24 SET PTRLINK=+$ORDER(^HLCS(870,"B","AMB-CARE",0))
+25 IF ('PTRLINK)
Begin DoDot:1
+26 SET MSGTXT(1)=" ** Unable to find AMB-CARE in HL LOGICAL LINK file (#870)"
+27 SET MSGTXT(2)=" ** Entry must be manually created and attached to"
+28 SET MSGTXT(3)=" the SCDX AMBCARE SEND CLIENT FOR ADT-Z00 protocol"
+29 DO MES^XPDUTL(.MSGTXT)
End DoDot:1
QUIT
+30 ;Fix entry
+31 SET DIE="^ORD(101,"
+32 SET DA=PTRPROT
+33 SET DR="2///@;770.2////^S X=PTRAPP;770.3///ADT;770.11///ADT;770.4///Z00;770.7////^S X=PTRLINK;770.95///2.2"
+34 DO ^DIE
+35 QUIT
