source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMSP1.m@ 1303

Last change on this file since 1303 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1SCMSP1 ;ALB/JRP - POST INIT ROUTINE;07-JUN-1996
2 ;;5.3;Scheduling;**44**;AUG 13, 1993
3 ;
4FIXEVNT ;Enable Ambulatory Care event handler
5 ;
6 ;Input : None
7 ;Output : None
8 ;Notes : This is a KIDS complient check point
9 ;
10 ;Declare variables
11 N DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT,MSGTXT,PTRPROT
12 D BMES^XPDUTL(">>> Enabling Ambulatory Care event handler")
13 ;Find protocol
14 S PTRPROT=+$O(^ORD(101,"B","SCDX AMBCARE EVENT",""))
15 I ('PTRPROT) D Q
16 .S MSGTXT(1)=" ** Unable to find SCDX AMBCARE EVENT in PROTOCOL file (#101)"
17 .S MSGTXT(2)=" ** Entry must be manually created"
18 .D MES^XPDUTL(.MSGTXT)
19 ;Enable protocol
20 S DIE="^ORD(101,"
21 S DA=PTRPROT
22 S DR="2///@"
23 D ^DIE
24 ;Done
25 Q
26 ;
27FIXSRVR ;Fix entry in PROTOCOL file (#101) for server protocol
28 ;
29 ;Input : None
30 ;Output : None
31 ;Notes : This is a KIDS complient check point
32 ;
33 ;Declare variables
34 N DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT,MSGTXT,PTRPROT,PTRAPP
35 D BMES^XPDUTL(">>> Correcting entry in PROTOCOL file (#101) for server protocol")
36 ;Find server protocol
37 S PTRPROT=+$O(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",""))
38 I ('PTRPROT) D Q
39 .S MSGTXT(1)=" ** Unable to find SCDX AMBCARE SEND SERVER FOR ADT-Z00"
40 .S MSGTXT(2)=" in PROTOCOL file (#101)"
41 .S MSGTXT(3)=" ** Entry must be manually created"
42 .D MES^XPDUTL(.MSGTXT)
43 ;Find server application
44 S PTRAPP=+$O(^HL(771,"B","AMBCARE-DHCP",""))
45 I ('PTRAPP) D Q
46 .S MSGTXT(1)=" ** Unable to find AMBCARE-DHCP in HL7 APPLICATION file (#771)"
47 .S MSGTXT(2)=" ** Entry must be manually created and attached to"
48 .S MSGTXT(3)=" the SCDX AMBCARE SEND SERVER FOR ADT-Z00 protocol"
49 .D MES^XPDUTL(.MSGTXT)
50 ;Fix entry
51 S DIE="^ORD(101,"
52 S DA=PTRPROT
53 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"
54 D ^DIE
55 ;Done
56 Q
57 ;
58FIXCLNT ;Fix entry in PROTOCOL file (#101) for client protocol
59 ;
60 ;Input : None
61 ;Output : None
62 ;Notes : This is a KIDS complient check point
63 ;
64 ;Declare variables
65 N DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT,MSGTXT,PTRPROT,PTRAPP,PTRLINK
66 D BMES^XPDUTL(">>> Correcting entry in PROTOCOL file (#101) for client protocol")
67 ;Find client protocol
68 S PTRPROT=+$O(^ORD(101,"B","SCDX AMBCARE SEND CLIENT FOR ADT-Z00",""))
69 I ('PTRPROT) D Q
70 .S MSGTXT(1)=" ** Unable to find SCDX AMBCARE SEND CLIENT FOR ADT-Z00"
71 .S MSGTXT(2)=" in PROTOCOL file (#101)"
72 .S MSGTXT(3)=" ** Entry must be manually created"
73 .D MES^XPDUTL(.MSGTXT)
74 ;Find client application
75 S PTRAPP=+$O(^HL(771,"B","NPCD-AAC",""))
76 I ('PTRAPP) D Q
77 .S MSGTXT(1)=" ** Unable to find NPCD-AAC in HL7 APPLICATION file (#771)"
78 .S MSGTXT(2)=" ** Entry must be manually created and attached to"
79 .S MSGTXT(3)=" the SCDX AMBCARE SEND CLIENT FOR ADT-Z00 protocol"
80 .D MES^XPDUTL(.MSGTXT)
81 ;Find logical link
82 S PTRLINK=+$O(^HLCS(870,"B","AMB-CARE",0))
83 I ('PTRLINK) D Q
84 .S MSGTXT(1)=" ** Unable to find AMB-CARE in HL LOGICAL LINK file (#870)"
85 .S MSGTXT(2)=" ** Entry must be manually created and attached to"
86 .S MSGTXT(3)=" the SCDX AMBCARE SEND CLIENT FOR ADT-Z00 protocol"
87 .D MES^XPDUTL(.MSGTXT)
88 ;Fix entry
89 S DIE="^ORD(101,"
90 S DA=PTRPROT
91 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"
92 D ^DIE
93 Q
Note: See TracBrowser for help on using the repository browser.