source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMSP0.m@ 1328

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1SCMSP0 ;ALB/JRP - CHECK POINTS TO CREATE ENTRIES IN HL7 FILES;29-MAY-1996
2 ;;5.3;Scheduling;**44**;AUG 13, 1993
3 ;
4HL7EVNT ;Create HL7 event Z00 - HL7 EVENT TYPE CODE file (#779.001)
5 ;
6 ;Input : None
7 ;Output : None
8 ;Note : This is a KIDS complient check point
9 ;
10 ;Declare variables
11 N DIC,X,Y,DLAYGO,DTOUT,DUOUT,NEWENTRY,MSGTXT,PTREVNT,DIE,DA,DR
12 ;Create/find entry
13 D BMES^XPDUTL(">>> Creating entry for Z00 in HL7 EVENT TYPE CODE file (#779.001)")
14 S DIC="^HL(779.001,"
15 S DIC(0)="L"
16 S DIC("DR")="2///Ambulatory Care transmission to/from NPCDB"
17 S DLAYGO=779.001
18 S X="Z00"
19 D ^DIC
20 S PTREVNT=+Y
21 S NEWENTRY=+$P(Y,"^",3)
22 S MSGTXT(1)=" Existing entry found - support of HL7 v2.2 will be added/verified"
23 S:(NEWENTRY) MSGTXT(1)=" Entry created - support of HL7 v2.2 will be added"
24 I (PTREVNT<0) D
25 .S MSGTXT(1)=" ** Unable to create entry for Z00"
26 .S MSGTXT(2)=" ** Entry must be created manually"
27 D MES^XPDUTL(.MSGTXT)
28 K MSGTXT
29 ;Don't continue if entry wasn't created
30 Q:(PTREVNT<0)
31 ;Add support for HL7 version 2.2
32 S DIC="^HL(779.001,"_PTREVNT_",1,"
33 S DIC(0)="LX"
34 S DIC("P")=$P(^DD(779.001,100,0),"^",2)
35 S DA(1)=PTREVNT
36 S DLAYGO=779.001
37 S X="2.2"
38 D ^DIC
39 S MSGTXT(1)=" Support for HL7 v2.2 "_$S($P(Y,"^",3):"added",1:"verified")
40 I (Y<0) D
41 .S MSGTXT(1)=" ** Unable to add support for HL7 v2.2"
42 .S MSGTXT(2)=" ** Support for HL7 v2.2 must be added manually"
43 D MES^XPDUTL(.MSGTXT)
44 ;Done
45 Q
46 ;
47HL7APPS ;Create required entries in HL APPLICATION file (#771)
48 ;
49 ;Input : None
50 ;Output : None
51 ;Note : This is a KIDS complient check point
52 ;
53 ;Declare variables
54 N APPNAME,FACNUM,MAILGRP,MSGTXT,PTRAPP
55 D BMES^XPDUTL(">>> Creating entries in HL APPLICATION file (#771)")
56 ;Create sending application
57 S APPNAME="AMBCARE-DHCP"
58 S FACNUM=+$P($$SITE^VASITE(),"^",3)
59 S MAILGRP=$$OPCMG^SCMSPU1(0)
60 I ('MAILGRP) D Q
61 .S MSGTXT(1)=" ** MAS PARAMETER file (#43) does not have a value for"
62 .S MSGTXT(2)=" the OPC GENERATE MAIL GROUP field (#216)"
63 .S MSGTXT(3)=" ** Entries for AMBCARE-DHCP and NPCD-AAC in the HL"
64 .S MSGTXT(4)=" APPLICATION file (#771) can not be created"
65 .S MSGTXT(5)=" ** Entries must be manually entered"
66 .D MES^XPDUTL(.MSGTXT)
67 D MES^XPDUTL(" Creating entry for sending application (AMBCARE-DHCP)")
68 S PTRAPP=$$CRTAPP^SCMSPU1(APPNAME,FACNUM,MAILGRP)
69 S MSGTXT(1)=" Entry for AMBCARE-DHCP successfully created"
70 I ('$P(PTRAPP,"^",2)) D
71 .S MSGTXT(1)=" Existing entry for AMBCARE-DHCP found - current values not overwritten"
72 I (PTRAPP<0) D
73 .S MSGTXT(1)=" ** Unable to create entry for AMBCARE-DHCP"
74 .S MSGTXT(2)=" ** "_$P(PTRAPP,"^",2)
75 .S MSGTXT(3)=" ** Sending application must be added manually"
76 D MES^XPDUTL(.MSGTXT)
77 K MSGTXT
78 ;Create receiving application
79 S APPNAME="NPCD-AAC"
80 S FACNUM=200
81 S MAILGRP=$$OPCMG^SCMSPU1(0)
82 D MES^XPDUTL(" Creating entry for receiving application (NPCD-AAC)")
83 S PTRAPP=$$CRTAPP^SCMSPU1(APPNAME,FACNUM,MAILGRP)
84 S MSGTXT(1)=" Entry for NPCD-AAC successfully created"
85 I ('$P(PTRAPP,"^",2)) D
86 .S MSGTXT(1)=" Existing entry for NPCD-AAC found - current values not overwritten"
87 I (PTRAPP<0) D
88 .S MSGTXT(1)=" ** Unable to create entry for NPCD-AAC"
89 .S MSGTXT(2)=" ** "_$P(PTRAPP,"^",2)
90 .S MSGTXT(3)=" ** Receiving application must be added manually"
91 D MES^XPDUTL(.MSGTXT)
92 ;Done
93 Q
94 ;
95MAILGRP ;Create entry in MAIL GROUP file (#3.8) that will be attached to
96 ; the lower level protocol parameter
97 ;
98 ;Input : None
99 ;Output : None
100 ;Note : This is a KIDS complient check point
101 ;
102 ;Declare variables
103 N NAME,DESC,PTR2MG,MSGTXT,DIE,DIC,DA,DR,X,Y,DTOUT
104 D BMES^XPDUTL(">>> Creating entry in MAIL GROUP file (#3.8)")
105 ;Create entry in MAIL GROUP file
106 S NAME="SCDX AMBCARE TO NPCDB"
107 S DESC(1)="Mail Group used by the Ambulatory Care Reporting Project to"
108 S DESC(2)="transmit data to the National Patient Care Database via HL7"
109 S PTR2MG=$$MG^XMBGRP(NAME,0,.5,0,.XMY,.DESC,1)
110 S MSGTXT(1)=" Entry for SCDX AMBCARE TO NPCDB successfully created"
111 I ('PTR2MG) D
112 .S MSGTXT(1)=" ** Unable to create entry for SCDX AMBCARE TO NPCDB"
113 .S MSGTXT(2)=" ** Entry must be created manually"
114 D MES^XPDUTL(.MSGTXT)
115 K MSGTXT
116 ;Don't continue if entry wasn't created
117 Q:('PTR2MG)
118 ;Add queue for National Patient Care Database as REMOTE MEMBER
119 D MES^XPDUTL(" Adding National Patient Care Database (NPCDB) to Mail Group")
120 S DIC="^XMB(3.8,"_PTR2MG_",6,"
121 S DIC(0)="LX"
122 S DIC("P")=$P(^DD(3.8,12,0),"^",2)
123 S DA(1)=PTR2MG
124 S DLAYGO=3.8
125 S X="XXX@Q-ACS.MED.VA.GOV"
126 D ^DIC
127 S MSGTXT(1)=" XXX@Q-ACS.MED.VA.GOV successfully added as REMOTE MEMBER"
128 I (Y<0) D
129 .S MSGTXT(1)=" ** Unable to add XXX@Q-ACS.MED.VA.GOV as REMOTE MEMBER"
130 .S MSGTXT(2)=" ** Remote member must be added manually"
131 D MES^XPDUTL(.MSGTXT)
132 ;Done
133 Q
134 ;
135HL7LLPP ;Create entry in HL LOWER LEVEL PROTOCOL PARAMETER file (#869.2)
136 ;
137 ;Input : None
138 ;Output : None
139 ;Note : This is a KIDS complient check point
140 ; : If an entry for AMB-CARE already exists, values currently
141 ; defined for the entry will not be overwritten
142 ;
143 ;Declare variables
144 N DIC,X,Y,DLAYGO,DTOUT,DUOUT,NEWENTRY,PTRLLPP,DIE,DA,DR,MSGTXT
145 ;Create entry
146 D BMES^XPDUTL(">>> Creating entry in HL LOWER LEVEL PROTOCOL PARAMETER file (#869.2)")
147 S DIC="^HLCS(869.2,"
148 S DIC(0)="LX"
149 S DIC("DR")=".02///MAILMAN;100.01///SCDX AMBCARE TO NPCDB"
150 S DLAYGO=869.2
151 S X="AMB-CARE"
152 D ^DIC
153 S PTRLLPP=+Y
154 S NEWENTRY=+$P(Y,"^",3)
155 S MSGTXT(1)=" Entry for AMB-CARE created"
156 I ((PTRLLPP)&('NEWENTRY)) D
157 .S MSGTXT(1)=" Entry for AMB-CARE found"
158 .S MSGTXT(2)=" Existing information will not be overwritten"
159 I (PTRLLPP<0) D
160 .S MSGTXT(1)=" ** Unable to create entry for AMB-CARE"
161 .S MSGTXT(2)=" ** Entry must be created manually"
162 D MES^XPDUTL(.MSGTXT)
163 ;Done
164 Q
165 ;
166HL7LINK ;Create entry in HL LOGICAL LINK file (#870)
167 ;
168 ;Input : None
169 ;Output : None
170 ;Note : This is a KIDS complient check point
171 ; : If an entry for AMB-CARE already exists, values currently
172 ; defined for the entry will not be overwritten
173 ;
174 ;Declare variables
175 N DIC,X,Y,DLAYGO,DTOUT,DUOUT,NEWENTRY,PTRLINK,DIE,DA,DR,MSGTXT
176 ;Create entry
177 D BMES^XPDUTL(">>> Creating entry in HL LOGICAL LINK file (#870)")
178 S DIC="^HLCS(870,"
179 S DIC(0)="LX"
180 S DIC("DR")="2///AMB-CARE"
181 S DLAYGO=870
182 S X="AMB-CARE"
183 D ^DIC
184 S PTRLINK=+Y
185 S NEWENTRY=+$P(Y,"^",3)
186 S MSGTXT(1)=" Entry for AMB-CARE created"
187 I ((PTRLINK)&('NEWENTRY)) D
188 .S MSGTXT(1)=" Entry for AMB-CARE found"
189 .S MSGTXT(2)=" Existing information will not be overwritten"
190 I (PTRLINK<0) D
191 .S MSGTXT(1)=" ** Unable to create entry for AMB-CARE"
192 .S MSGTXT(2)=" ** Entry must be created manually"
193 D MES^XPDUTL(.MSGTXT)
194 ;Done
195 Q
Note: See TracBrowser for help on using the repository browser.