Index: ePrescribing/trunk/p/C0PEWD2.m
===================================================================
--- ePrescribing/trunk/p/C0PEWD2.m	(revision 1594)
+++ ePrescribing/trunk/p/C0PEWD2.m	(revision 1595)
@@ -1,51 +1,194 @@
-C0PEWD2   ; CCDCCR/GPL - ePrescription utilities; 4/24/09
- ;;0.1;CCDCCR;nopatch;noreleasedate
- ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
- ;General Public License See attached copy of the License.
- ;
- ;This program is free software; you can redistribute it and/or modify
- ;it under the terms of the GNU General Public License as published by
- ;the Free Software Foundation; either version 2 of the License, or
- ;(at your option) any later version.
- ;
- ;This program is distributed in the hope that it will be useful,
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- ;GNU General Public License for more details.
- ;
- ;You should have received a copy of the GNU General Public License along
- ;with this program; if not, write to the Free Software Foundation, Inc.,
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- ;
- Q
-TEST ;
- s URL="https://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
- D GET1URL(URL) ;
- S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NCScript-RegisterLP.xml"
- D GET1URL(URL)
- S URL="http://preproduction.newcropaccounts.com/InterfaceV7/GenTestRenewalFDB.xml"
- D GET1URL(URL)
- S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
- D GET1URL(URL)
- S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxRxNorm.xml"
- D GET1URL(URL)
- S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxExternalDrugOpt1.xml"
- D GET1URL(URL)
- S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxExternalDrugOpt2.xml"
- D GET1URL(URL)
- S URL="http://preproduction.newcropaccounts.com/InterfaceV7/RenewalResponseAccept.xml"
- D GET1URL(URL)
- S URL="http://preproduction.newcropaccounts.com/InterfaceV7/RenewalResponseDeny.xml"
- D GET1URL(URL)
- Q
- ;
-GET1URL(URL) ; 
- s ok=$$httpGET^%zewdGTM(URL,.gpl)
- D INDEX^C0CXPATH("gpl","gpl2")
- W !,"S URL=""",URL,"""",!
- S G=""
- F  S G=$O(gpl2(G)) Q:G=""  D  ;
- . W " S VDX(""",G,""")=""",gpl2(G),"""",!
- W !
- Q
- ;
+C0PEWD2	  ; CCDCCR/GPL - ePrescription utilities; 4/24/09 ; 5/8/12 10:22pm
+	;;1.0;C0P;;Apr 25, 2012;Build 103
+	;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
+	;General Public License See attached copy of the License.
+	;
+	;This program is free software; you can redistribute it and/or modify
+	;it under the terms of the GNU General Public License as published by
+	;the Free Software Foundation; either version 2 of the License, or
+	;(at your option) any later version.
+	;
+	;This program is distributed in the hope that it will be useful,
+	;but WITHOUT ANY WARRANTY; without even the implied warranty of
+	;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+	;GNU General Public License for more details.
+	;
+	;You should have received a copy of the GNU General Public License along
+	;with this program; if not, write to the Free Software Foundation, Inc.,
+	;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+	;
+	Q
+	; TEST Lines below not intended for End Users. Programmers only.
+	; BEWARE ZWRITE SYNTAX. It may not work in other M Implementations.
+gpltest3	;  (zduz,zdfn) ; experiment with passing parameters from trigger
+	;W "<br><b>SESSIONID:",zduz,"</b><br><hr>"
+	W "<b>eRx</b> pullback trigger processing prototype<hr>",!
+	I $D(req4) ZWRITE req4
+	w "<hr>"
+	W "XID=",$G(req4("XID",1)),"<br>"
+	W "DFN=",$G(req4("DFN",1)),"<br>"
+	w "DUZ=",$G(req4("DUZ",1)),"<hr>"
+	s DFN=$G(req4("DFN",1))
+	D PSEUDO ; FAKE LOGIN
+	D XPAT^C0CCCR(DFN,"MEDALL")
+	W "<br>"
+	;D XPAT^C0CCCR(DFN)
+	W "<a href=""http://hollywood/dev/CCR/PAT_"_DFN_"_CCR_V1_0_0.xml"" target=""CCR"">Display CCR</a>"
+	;D RIM2RNF^C0CRIMA("GPL",DFN,"ALERTS")
+	;D RNF2HVN^C0CRNF("G1","GPL")
+	;D PARY^C0CXPATH("G1",-1)
+	F ZG="ALERTS","MEDS","PROCEDURES" D  ;
+	. N GPL,G2
+	. W "<hr>"
+	. W "<b>Current CCR "_ZG_"</b><br>",!
+	. D RIM2RNF^C0CRIMA("GPL",DFN,ZG)
+	. D RNF2HNV^C0CRNF("G2","GPL")
+	. D PARY^C0CXPATH("G2",-1)
+	Q
+	;
+PSEUDO	; FAKE LOGIN SETS SOME LOCAL VARIABLE TO FOOL FILEMAN
+	S DILOCKTM=3
+	S DISYS=19
+	S DT=3100112
+	S DTIME=9999
+	S DUZ=135
+	S DUZ(0)=""
+	S DUZ(1)=""
+	S DUZ(2)=67
+	S DUZ("AG")="E"
+	S DUZ("BUF")=1
+	S DUZ("LANG")=1
+	;S IO="/dev/pts/0"
+	;S IO(0)="/dev/pts/0"
+	;S IO(1,"/dev/pts/0")=""
+	;S IO("ERROR")=""
+	;S IO("HOME")="50^/dev/pts/0"
+	;S IO("ZIO")="/dev/pts/0"
+	;S IOBS="$C(8)"
+	;S IOF="!!!!!!!!!!!!!!!!!!!!!!!!,#,$C(27,91,50,74,27,91,72)"
+	;S IOM=80
+	;S ION="GTM/UNIX TELNET"
+	;S IOS=50
+	;S IOSL=24
+	;S IOST="C-VT100"
+	;S IOST(0)=9
+	;S IOT="VTRM"
+	;S IOXY="W $C(27,91)_((DY+1))_$C(59)_((DX+1))_$C(72)"
+	S U="^"
+	S X="1;DIC(4.2,"
+	S XPARSYS="1;DIC(4.2,"
+	S XQXFLG="^^XUP"
+	S Y="DEV^VISTA^hollywood^VISTA:hollywood"
+	Q
+	;
+gpltest2(zduz,zdfn)	; experiment with passing parameters from trigger
+	W "<br><b>SESSIONID:",zduz,"</b><br><hr>"
+	W "HELLO WORLD<hr>",!
+	I $D(req4) ZWRITE req4
+	w "<hr>"
+	W "DFN=",$G(req4("DFN",1)),"<br>"
+	w "DUZ=",$G(req4("DUZ",1)),"<hr>"
+	;ZWR
+	Q
+	;
+gpltest(GPLV1)	; experiment with sending a CCR to an ewd page
+	N ZI
+	S ZI=""
+	;W "HELLO WORLD!",!
+	;Q
+	F  S ZI=$O(^GPL(ZI)) Q:ZI=""  W ^GPL(ZI),!
+	Q
+	;
+TESTSSL	;
+	s URL="https://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
+	D GET1URL(URL) ;
+	Q
+	;
+TEST2	;
+	; httpPOST(url,payload,mimeType,html,headerArray,timeout,test,rawResponse,respHeaders,sslHost,sslPort)
+	;
+	s URL="http://preproduction.newcropaccounts.com/InterfaceV7/Doctor.xml"
+	D GET1URL(URL) ;
+	s gpl4(2)="<NCScript xmlns=""http://secure.newcropaccounts.com/interfaceV7"""
+	s g1="xmlns:NCStandard="
+	s g2="""http://secure.newcropaccounts.com/interfaceV7:NCStandard"""
+	s gpl4(2)=gpl4(2)_" "_g1_g2
+	s gpl4(2)=gpl4(2)_" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"">"
+	k gpl4(0) ; array size node
+	s gpl4(3)="<Account ID=""demo"">"
+	s gpl4(40)="<Location ID=""DEMOLOC1"">"
+	s gpl4(28)="<LicensedPrescriber ID=""DEMOLP1"">"
+	s gpl4(55)="<Patient ID=""DEMOPT1"">"
+	W $$OUTPUT^C0CXPATH("gpl4(1)","NewCropV7-DOCTOR.xml","/home/dev/CCR/"),!
+	S ok=$$httpPOST^%zewdGTM("https://preproduction.newcropaccounts.com/InterfaceV7/RxEntry.aspx",.gpl4,"Content-Type: text/html",.gpl6,"","",.gpl5,.gpl7)
+	ZWRITE gpl6
+	q
+	;
+TEST3	;
+	; httpPOST(url,payload,mimeType,html,headerArray,timeout,test,rawResponse,respHeaders,sslHost,sslPort)
+	;
+	s URL="http://preproduction.newcropaccounts.com/InterfaceV7/Doctor.xml"
+	D GET1URL(URL) ;
+	N I,J
+	S J=$O(gpl(""),-1) ; count of things in gpl
+	F I=1:1:J S gpl(I)=$$CLEAN^C0PEWDU(gpl(I))
+	K gpl(0)
+	S gpl(1)="RxInput="_gpl(1)
+	S url="https://preproduction.newcropaccounts.com/InterfaceV7/RxEntry.aspx"
+	W $$OUTPUT^C0CXPATH("gpl(1)","NewCropV7-DOCTOR2.xml","/home/dev/CCR/"),!
+	; S ok=$$httpPOST^%zewdGTM("https://preproduction.newcropaccounts.com/InterfaceV7/RxEntry.aspx",.gpl,"application/x-www-form-urlencoded",.gpl6,"","",.gpl5,.gpl7)
+	S ok=$$httpPOST^%zewdGTM("https://preproduction.newcropaccounts.com/InterfaceV7/ComposeRX.aspx",.gpl,"application/x-www-form-urlencoded",.gpl6,"","",.gpl5,.gpl7)
+	ZWRITE gpl6
+	q
+	;
+TEST	;
+	;s URL="https://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
+	  ; D GET1URL(URL) ;
+	;Q
+	S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NCScript-RegisterLP.xml"
+	D GET1URL(URL)
+	S URL="http://preproduction.newcropaccounts.com/InterfaceV7/GenTestRenewalFDB.xml"
+	D GET1URL(URL)
+	S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
+	D GET1URL(URL)
+	S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxRxNorm.xml"
+	D GET1URL(URL)
+	S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxExternalDrugOpt1.xml"
+	D GET1URL(URL)
+	S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxExternalDrugOpt2.xml"
+	D GET1URL(URL)
+	S URL="http://preproduction.newcropaccounts.com/InterfaceV7/RenewalResponseAccept.xml"
+	D GET1URL(URL)
+	S URL="http://preproduction.newcropaccounts.com/InterfaceV7/RenewalResponseDeny.xml"
+	D GET1URL(URL)
+	Q
+	;
+GET1URL0(URL)	; 
+	s ok=$$httpGET^%zewdGTM(URL,.gpl)
+	D INDEX^C0CXPATH("gpl","gpl2")
+	W !,"S URL=""",URL,"""",!
+	S G=""
+	F  S G=$O(gpl2(G)) Q:G=""  D  ;
+	. W " S VDX(""",G,""")=""",gpl2(G),"""",!
+	W !
+	Q
+	;
+GET1URL(URL)	;
+	s ok=$$httpGET^%zewdGTM(URL,.gpl)
+	W "XML retrieved from Web Service:",!
+	ZWRITE gpl
+	D INDEX^C0CXPATH("gpl","gpl2",-1,"gplTEMP")
+	W "VDX array displayed as a prototype Mumps routine:",!
+	W !,"S URL=""",URL,"""",!
+	S G=""
+	F  S G=$O(gpl2(G)) Q:G=""  D  ;
+	. W " S VDX(""",G,""")=""",gpl2(G),"""",!
+	W !
+	D VDX2XPG^C0CXPATH("gpl3","gpl2")
+	W "Conversion of VDX array to XPG format:",!
+	ZWRITE gpl3
+	W "Conversion of XPG array to XML:",!
+	D XPG2XML^C0CXPATH("gpl4","gpl3")
+	ZWRITE gpl4
+	Q
+	;
