source: ePrescribing/trunk/p/C0PEWD2.m@ 1743

Last change on this file since 1743 was 1595, checked in by George Lilly, 12 years ago

initial release of ePrescribing

File size: 6.4 KB
Line 
1C0PEWD2 ; CCDCCR/GPL - ePrescription utilities; 4/24/09 ; 5/8/12 10:22pm
2 ;;1.0;C0P;;Apr 25, 2012;Build 103
3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU
4 ;General Public License See attached copy of the License.
5 ;
6 ;This program is free software; you can redistribute it and/or modify
7 ;it under the terms of the GNU General Public License as published by
8 ;the Free Software Foundation; either version 2 of the License, or
9 ;(at your option) any later version.
10 ;
11 ;This program is distributed in the hope that it will be useful,
12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;GNU General Public License for more details.
15 ;
16 ;You should have received a copy of the GNU General Public License along
17 ;with this program; if not, write to the Free Software Foundation, Inc.,
18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 ;
20 Q
21 ; TEST Lines below not intended for End Users. Programmers only.
22 ; BEWARE ZWRITE SYNTAX. It may not work in other M Implementations.
23gpltest3 ; (zduz,zdfn) ; experiment with passing parameters from trigger
24 ;W "<br><b>SESSIONID:",zduz,"</b><br><hr>"
25 W "<b>eRx</b> pullback trigger processing prototype<hr>",!
26 I $D(req4) ZWRITE req4
27 w "<hr>"
28 W "XID=",$G(req4("XID",1)),"<br>"
29 W "DFN=",$G(req4("DFN",1)),"<br>"
30 w "DUZ=",$G(req4("DUZ",1)),"<hr>"
31 s DFN=$G(req4("DFN",1))
32 D PSEUDO ; FAKE LOGIN
33 D XPAT^C0CCCR(DFN,"MEDALL")
34 W "<br>"
35 ;D XPAT^C0CCCR(DFN)
36 W "<a href=""http://hollywood/dev/CCR/PAT_"_DFN_"_CCR_V1_0_0.xml"" target=""CCR"">Display CCR</a>"
37 ;D RIM2RNF^C0CRIMA("GPL",DFN,"ALERTS")
38 ;D RNF2HVN^C0CRNF("G1","GPL")
39 ;D PARY^C0CXPATH("G1",-1)
40 F ZG="ALERTS","MEDS","PROCEDURES" D ;
41 . N GPL,G2
42 . W "<hr>"
43 . W "<b>Current CCR "_ZG_"</b><br>",!
44 . D RIM2RNF^C0CRIMA("GPL",DFN,ZG)
45 . D RNF2HNV^C0CRNF("G2","GPL")
46 . D PARY^C0CXPATH("G2",-1)
47 Q
48 ;
49PSEUDO ; FAKE LOGIN SETS SOME LOCAL VARIABLE TO FOOL FILEMAN
50 S DILOCKTM=3
51 S DISYS=19
52 S DT=3100112
53 S DTIME=9999
54 S DUZ=135
55 S DUZ(0)=""
56 S DUZ(1)=""
57 S DUZ(2)=67
58 S DUZ("AG")="E"
59 S DUZ("BUF")=1
60 S DUZ("LANG")=1
61 ;S IO="/dev/pts/0"
62 ;S IO(0)="/dev/pts/0"
63 ;S IO(1,"/dev/pts/0")=""
64 ;S IO("ERROR")=""
65 ;S IO("HOME")="50^/dev/pts/0"
66 ;S IO("ZIO")="/dev/pts/0"
67 ;S IOBS="$C(8)"
68 ;S IOF="!!!!!!!!!!!!!!!!!!!!!!!!,#,$C(27,91,50,74,27,91,72)"
69 ;S IOM=80
70 ;S ION="GTM/UNIX TELNET"
71 ;S IOS=50
72 ;S IOSL=24
73 ;S IOST="C-VT100"
74 ;S IOST(0)=9
75 ;S IOT="VTRM"
76 ;S IOXY="W $C(27,91)_((DY+1))_$C(59)_((DX+1))_$C(72)"
77 S U="^"
78 S X="1;DIC(4.2,"
79 S XPARSYS="1;DIC(4.2,"
80 S XQXFLG="^^XUP"
81 S Y="DEV^VISTA^hollywood^VISTA:hollywood"
82 Q
83 ;
84gpltest2(zduz,zdfn) ; experiment with passing parameters from trigger
85 W "<br><b>SESSIONID:",zduz,"</b><br><hr>"
86 W "HELLO WORLD<hr>",!
87 I $D(req4) ZWRITE req4
88 w "<hr>"
89 W "DFN=",$G(req4("DFN",1)),"<br>"
90 w "DUZ=",$G(req4("DUZ",1)),"<hr>"
91 ;ZWR
92 Q
93 ;
94gpltest(GPLV1) ; experiment with sending a CCR to an ewd page
95 N ZI
96 S ZI=""
97 ;W "HELLO WORLD!",!
98 ;Q
99 F S ZI=$O(^GPL(ZI)) Q:ZI="" W ^GPL(ZI),!
100 Q
101 ;
102TESTSSL ;
103 s URL="https://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
104 D GET1URL(URL) ;
105 Q
106 ;
107TEST2 ;
108 ; httpPOST(url,payload,mimeType,html,headerArray,timeout,test,rawResponse,respHeaders,sslHost,sslPort)
109 ;
110 s URL="http://preproduction.newcropaccounts.com/InterfaceV7/Doctor.xml"
111 D GET1URL(URL) ;
112 s gpl4(2)="<NCScript xmlns=""http://secure.newcropaccounts.com/interfaceV7"""
113 s g1="xmlns:NCStandard="
114 s g2="""http://secure.newcropaccounts.com/interfaceV7:NCStandard"""
115 s gpl4(2)=gpl4(2)_" "_g1_g2
116 s gpl4(2)=gpl4(2)_" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"">"
117 k gpl4(0) ; array size node
118 s gpl4(3)="<Account ID=""demo"">"
119 s gpl4(40)="<Location ID=""DEMOLOC1"">"
120 s gpl4(28)="<LicensedPrescriber ID=""DEMOLP1"">"
121 s gpl4(55)="<Patient ID=""DEMOPT1"">"
122 W $$OUTPUT^C0CXPATH("gpl4(1)","NewCropV7-DOCTOR.xml","/home/dev/CCR/"),!
123 S ok=$$httpPOST^%zewdGTM("https://preproduction.newcropaccounts.com/InterfaceV7/RxEntry.aspx",.gpl4,"Content-Type: text/html",.gpl6,"","",.gpl5,.gpl7)
124 ZWRITE gpl6
125 q
126 ;
127TEST3 ;
128 ; httpPOST(url,payload,mimeType,html,headerArray,timeout,test,rawResponse,respHeaders,sslHost,sslPort)
129 ;
130 s URL="http://preproduction.newcropaccounts.com/InterfaceV7/Doctor.xml"
131 D GET1URL(URL) ;
132 N I,J
133 S J=$O(gpl(""),-1) ; count of things in gpl
134 F I=1:1:J S gpl(I)=$$CLEAN^C0PEWDU(gpl(I))
135 K gpl(0)
136 S gpl(1)="RxInput="_gpl(1)
137 S url="https://preproduction.newcropaccounts.com/InterfaceV7/RxEntry.aspx"
138 W $$OUTPUT^C0CXPATH("gpl(1)","NewCropV7-DOCTOR2.xml","/home/dev/CCR/"),!
139 ; S ok=$$httpPOST^%zewdGTM("https://preproduction.newcropaccounts.com/InterfaceV7/RxEntry.aspx",.gpl,"application/x-www-form-urlencoded",.gpl6,"","",.gpl5,.gpl7)
140 S ok=$$httpPOST^%zewdGTM("https://preproduction.newcropaccounts.com/InterfaceV7/ComposeRX.aspx",.gpl,"application/x-www-form-urlencoded",.gpl6,"","",.gpl5,.gpl7)
141 ZWRITE gpl6
142 q
143 ;
144TEST ;
145 ;s URL="https://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
146 ; D GET1URL(URL) ;
147 ;Q
148 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NCScript-RegisterLP.xml"
149 D GET1URL(URL)
150 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/GenTestRenewalFDB.xml"
151 D GET1URL(URL)
152 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
153 D GET1URL(URL)
154 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxRxNorm.xml"
155 D GET1URL(URL)
156 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxExternalDrugOpt1.xml"
157 D GET1URL(URL)
158 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxExternalDrugOpt2.xml"
159 D GET1URL(URL)
160 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/RenewalResponseAccept.xml"
161 D GET1URL(URL)
162 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/RenewalResponseDeny.xml"
163 D GET1URL(URL)
164 Q
165 ;
166GET1URL0(URL) ;
167 s ok=$$httpGET^%zewdGTM(URL,.gpl)
168 D INDEX^C0CXPATH("gpl","gpl2")
169 W !,"S URL=""",URL,"""",!
170 S G=""
171 F S G=$O(gpl2(G)) Q:G="" D ;
172 . W " S VDX(""",G,""")=""",gpl2(G),"""",!
173 W !
174 Q
175 ;
176GET1URL(URL) ;
177 s ok=$$httpGET^%zewdGTM(URL,.gpl)
178 W "XML retrieved from Web Service:",!
179 ZWRITE gpl
180 D INDEX^C0CXPATH("gpl","gpl2",-1,"gplTEMP")
181 W "VDX array displayed as a prototype Mumps routine:",!
182 W !,"S URL=""",URL,"""",!
183 S G=""
184 F S G=$O(gpl2(G)) Q:G="" D ;
185 . W " S VDX(""",G,""")=""",gpl2(G),"""",!
186 W !
187 D VDX2XPG^C0CXPATH("gpl3","gpl2")
188 W "Conversion of VDX array to XPG format:",!
189 ZWRITE gpl3
190 W "Conversion of XPG array to XML:",!
191 D XPG2XML^C0CXPATH("gpl4","gpl3")
192 ZWRITE gpl4
193 Q
194 ;
Note: See TracBrowser for help on using the repository browser.