Index: ePrescribing/trunk/p/C0PALGY1.m
===================================================================
--- ePrescribing/trunk/p/C0PALGY1.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PALGY1.m	(revision 1595)
@@ -0,0 +1,116 @@
+C0PALGY1	  ; ERX/GPL/SMH - eRx Allergy utilities ; 5/8/12 11:52pm
+	;;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
+GETRXNS(C0PDUZ,C0PDFN,ZRTN)	; Public Procedure
+	; Retrieve allergies from WebService, and store in VistA
+	; ART APIs will automatically not file an allergy if it is a duplicate
+	; Also, marking pt as NKA won't work if pt already has allergy in VistA
+	; That's why there is no check for duplicates in this code
+	; Input:
+	; - C0PDUZ: DUZ, By Value
+	; - C0PDFN: DFN, By Value
+	;
+	N C0PWSRXNS
+	D SOAP^C0PWS1("C0PWSRXNS","GETALLERGIES",C0PDUZ,C0PDFN)
+	N C0PI
+	F C0PI=1:1:C0PWSRXNS(1,"RowCount") DO
+	. N RXN M RXN=C0PWSRXNS(C0PI)
+	. ; For certain food allergies, CompositeID is not returned
+	. I '$D(RXN("CompositeID")) S RXN("CompositeID")="" ; prevent undef crash
+	. I RXN("CompositeID")=11623 QUIT  ; Code for 'No Allergy Information'
+	. I (RXN("CompositeID")=231)!(RXN("CompositeID")=232)!(RXN("CompositeID")=14278)!(RXN("CompositeID")=14279) D  QUIT
+	. . N ORDFN S ORDFN=C0PDFN  ; Apparently the 'API' uses CPRS variables
+	. . D NKA^GMRAGUI1  ; Codes for NKA
+	. D FILE(.RXN,C0PDUZ,C0PDFN)
+	QUIT  ; /GETRXNS
+	;
+FILE(RXN,C0PDUZ,C0PDFN)	; Private Proc - File Drug Reaction
+	; Input: 
+	; - RXN: Merged WS ADR, by Reference
+	; - C0PDUZ: DUZ, By Value
+	; - C0PDFN: DFN, By Value
+	; ConceptTypeIDs: 6 = Generic Name; 2 = Brand Name; 1 = Drug Class
+	N C0PRXN
+	S:RXN("ConceptTypeID")=6 C0PRXN("GMRAGNT")=$$BASE(RXN("ConceptID"))
+	S:RXN("ConceptTypeID")=2 C0PRXN("GMRAGNT")=$$NAME($$UP^XLFSTR(RXN("Name")))
+	S:RXN("ConceptTypeID")=1 C0PRXN("GMRAGNT")=$$GROUP(RXN("ConceptID"))
+	; Try a free text match on 120.82 (GMRA ALLERGIES) to see if there is a
+	; match on a food allergy (ConceptTypeID 9 [free txt] or 10 [other allergies])
+	IF $G(C0PRXN("GMRAGNT"))="" D  ; need to handle type 9 or 10 .. gpl
+	. S C0PRXN("GMRAGNT")=$$GMRA($$UP^XLFSTR(RXN("Name")))
+	IF C0PRXN("GMRAGNT")="" DO  QUIT  ; Agent not found in VistA; TODO mail msg
+	. N ZT ; TEXT TO DISPLAY AS ERROR MESSAGE
+	. S ZT="Error Mapping Allergy ConceptID: "_$G(RXN("ConceptID"))
+	. D MAPERR^C0PRECON(.ZRTN,"Allergy",ZT) ;DISPLAY ERROR
+	S C0PRXN("GMRATYPE")=$$TYPE(C0PRXN("GMRAGNT"))
+	S C0PRXN("GMRANATR")="U^Unknown"
+	S C0PRXN("GMRAORIG")=C0PDUZ
+	S C0PRXN("GMRACHT",0)=1
+	S C0PRXN("GMRACHT",1)=$$NOW^XLFDT
+	S C0PRXN("GMRAORDT")=$$NOW^XLFDT
+	S C0PRXN("GMRAOBHX")="h^HISTORICAL"
+	I $D(RXN("Notes")) D
+	. S C0PRXN("GMRACMTS",0)=1
+	. S C0PRXN("GMRACMTS",1)=RXN("Notes")
+	D UPDATE^GMRAGUI1("",C0PDFN,"C0PRXN")
+	I $G(^TMP("C0PDEBUG"))="" Q  ; ONLY SHOW ALLERGY MESSAGES IN DEBUG
+	I $P(ORY,U,1)<0 D MAPERR^C0PRECON(.ZRTN,"Allergies",ORY) ;ERROR MESSAGE
+	QUIT
+	;
+BASE(ID)	; $$ Private - Retrieve GMRAGNT for Generic Name ConceptID
+	; Input: ID, By Value
+	; Output: Ingreident Name^IEN;File Root for IEN
+	; First, match drug to VistA, Look in VA GENERIC first
+	N VAGEN S VAGEN=$$VAGEN2^C0PLKUP(ID)
+	; if no match, look in DRUG INGREDIENT
+	N DRUGING S DRUGING=""
+	I '+VAGEN S DRUGING=$$DRUGING2^C0PLKUP(ID)
+	Q:+VAGEN $P(VAGEN,U,2)_U_$P(VAGEN,U)_";PSNDF(50.6,"
+	Q:+DRUGING $P(DRUGING,U,2)_U_$P(DRUGING,U)_";PS(50.416,"
+	QUIT "" ; TODO: Notify somebody that no match found
+	;
+NAME(BRAND)	 ; $$ Private - Retrieve GMRAGNT for Brand Name
+	; Input: Brand Name, By Value
+	; Output: Ingreident Name^IEN;File Root for IEN
+	N C0POUT,C0PMATCH  ; output variable, # of matches
+	S C0PMATCH=$$TGTOG2^PSNAPIS(BRAND,.C0POUT)
+	; Output for C0POUT:
+	; C0POUT(24)="24^VANCOMYCIN"
+	; 24 is IEN of drug in VA GENERIC file
+	Q:C0PMATCH $P(@$Q(C0POUT),U,2)_U_$P(@$Q(C0POUT),U)_";PSNDF(50.6,"
+	Q "" ; otherwise quit with nothing
+	;
+GROUP(ID)	; Private Proc - Store drug class allergy
+	QUIT "" ; not implemented
+GMRA(NAME)	; $$ Private - Retrieve GMRAGNT for food allergy from 120.82
+	; Input: Brand Name, By Value
+	; Output: Entry Name^IEN;File Root for IEN
+	N C0PIEN S C0PIEN=$$FIND1^DIC(120.82,"","O",NAME,"B")
+	Q:C0PIEN $$GET1^DIQ(120.82,C0PIEN,.01)_"^"_C0PIEN_";GMRD(120.82,"
+	QUIT "" ; no match otherwise
+TYPE(GMRAGNT)	; $$ Private - Get allergy Type (Drug, food, or other)
+	; Input: Allergen, formatted as Allergen^IEN;File Root
+	; Output: Type (internal)^Type (external) e.g. D^Drug
+	N C0PIEN S C0PIEN=+$P(GMRAGNT,U,2)
+	I GMRAGNT["GMRD(120.82," Q $$GET1^DIQ(120.82,C0PIEN,"ALLERGY TYPE","I")_U_$$GET1^DIQ(120.82,C0PIEN,"ALLERGY TYPE","E")
+	Q "D^Drug" ; otherwise, it's a drug
+ACCOUNTF()	 Q 113059002  ; file number for account file
+F200C0P()	Q 200.113059 ; Subfile number of C0P Subscription Multiple
+	;
Index: ePrescribing/trunk/p/C0PALGY2.m
===================================================================
--- ePrescribing/trunk/p/C0PALGY2.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PALGY2.m	(revision 1595)
@@ -0,0 +1,299 @@
+C0PALGY2	  ; ERX/GPL/SMH - eRx Allergy utilities ; 5/8/12 11:52pm
+	;;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
+	;
+	; THESE ROUTINES ARE USED TO TEST AND VALIDATE THE USE OF THE RXNORM
+	; DATABASE FOR LOOKING UP IDS AND MATCHING FIRST DATA BANK IDS TO 
+	; RXNORM CONCEPT IDS AND THEN FROM RXNORM CONCEPT IDS TO VISTA VUIDS
+	; THE PARTICULAR INTEREST HERE IS FOR MATCHING ALLERGIES TO A MEDICATION
+	; IN ADDITION THERE ARE ROUTINES HERE TO POPULATE THE C0P FDB ALLERGIES
+	; FILE.
+	; NONE OF THESE ROUTINES ARE USED IN REGULAR ERX ACTIVITIES. THEY
+	; ARE BROUGHT FORWARD AS PART OF THE ERX PACKAGE FOR DEBUGGING AND 
+	; FUTURE DEVELOPMENT
+	; GPL JUN 2010
+TESTBASE	; TEST LOOKING UP CONCEPT IDS IN RXNORM
+	;
+	N ZI
+	S ZI=""
+	S (COUNT,FOUND)=0
+	F  S ZI=$O(^C0PALGY("TYPE","BASE",ZI)) Q:ZI=""  D  ; FOR EACH BASE CONCEPT
+	. S COUNT=COUNT+1
+	. S ZJ=$$GET1^DIQ(113059005,ZI_",",1,"E")
+	. S ZN=$$GET1^DIQ(113059005,ZI_",",.01,"E")
+	. S ZV=$$BASE^C0PALGY1(ZJ) ;LOOKUP VISTA MATCH
+	. I ZV'="" S FOUND=FOUND+1
+	. W !,ZJ," ",ZN," :: ",ZV
+	W !,"COUNT:",COUNT," FOUND:",FOUND
+	Q
+	;
+TESTNAME	; TEST LOOKING UP CONCEPT IDS IN RXNORM
+	;
+	N ZI
+	S ZI=""
+	S (COUNT,FOUND)=0
+	F  S ZI=$O(^C0PALGY("TYPE","NAME",ZI)) Q:ZI=""  D  ; FOR EACH BASE CONCEPT
+	. S COUNT=COUNT+1
+	. S ZJ=$$GET1^DIQ(113059005,ZI_",",1,"E")
+	. S ZN=$$GET1^DIQ(113059005,ZI_",",.01,"E")
+	. S ZV=$$NAME^C0PALGY1($$UP^XLFSTR(ZN)) ;LOOKUP VISTA MATCH
+	. I ZV'="" S FOUND=FOUND+1
+	. W !,ZJ," ",ZN," :: ",ZV
+	W !,"COUNT:",COUNT," FOUND:",FOUND
+	Q
+	;
+TEST3	;
+	;
+	S ZI=0
+	S (COUNT,FOUND)=0
+	F  S ZI=$O(^PSNDF(50.6,ZI)) Q:+ZI=0  D  ; FOR EVERY DRUG IN THE NDF
+	. S COUNT=COUNT+1
+	. S ZJ=$G(^PSNDF(50.6,ZI,"VUID")) ;VUID
+	. S ZJ=$P(ZJ,"^",1) ;JUST THE FIRST PIECE
+	. S ZJN=$G(^PSNDF(50.6,ZI,0)) ; VA NAME
+	. W !,ZJN," ",ZJ
+	. S ZK=$$NDDFBAS2^C0PLKUP(ZJ)
+	. I ZK'=0 D  ; FDB CONCEPT ID FOUND
+	. . S ZL=$O(^C0PALGY("C2","BASE",ZK,""))
+	. . S ZN=$$GET1^DIQ(113059005,ZL_",",.01,"E")
+	. . I ZN'="" D  ;
+	. . . S FOUND=FOUND+1
+	. . . S ZP=ZI_";PSNDF(50.6,"
+	. . . S C0PFDA(113059005,ZL_",",6)=ZP
+	. . . D UPDIE
+	. . W $C(9),ZI," ",ZJ," :: ",ZK," ",ZN
+	W !,"COUNT:",COUNT," FOUND:",FOUND
+	Q
+	;
+TEST4	;
+	;
+	S ZI=0
+	S (COUNT,FOUND)=0
+	F  S ZI=$O(^PS(50.416,ZI)) Q:+ZI=0  D  ; DRUG INGREDIENTS FILE 
+	. S COUNT=COUNT+1
+	. S ZJ=$G(^PS(50.416,ZI,"VUID")) ;VUID
+	. S ZJ=$P(ZJ,"^",1) ;JUST THE FIRST PIECE
+	. S ZJN=$G(^PS(50.416,ZI,0)) ; VA NAME
+	. W !,ZJN," ",ZJ
+	. S ZK=$$NDDFBAS2^C0PLKUP(ZJ)
+	. ;I ZI=3912 B
+	. I ZK'=0 D  ; FDB CONCEPT ID FOUND
+	. . S ZL=$O(^C0PALGY("C2","BASE",ZK,""))
+	. . S ZN=$$GET1^DIQ(113059005,ZL_",",.01,"E")
+	. . I ZN'="" D  ;
+	. . . S FOUND=FOUND+1
+	. . . W $C(9),ZI," ",ZJ," :: ",ZK," ",ZN
+	. . . S ZP=ZI_";PS(50.416,"
+	. . . S C0PFDA(113059005,ZL_",",6)=ZP
+	. . . D UPDIE
+	W !,"COUNT:",COUNT," FOUND:",FOUND
+	Q
+	;
+TEST5	; VA PRODUCT FILE
+	;
+	S ZI=0
+	S (COUNT,FOUND)=0
+	F  S ZI=$O(^PSNDF(50.68,ZI)) Q:+ZI=0  D  ; FOR EVERY DRUG IN THE NDF
+	. S COUNT=COUNT+1
+	. S ZJ=$G(^PSNDF(50.68,ZI,"VUID")) ;VUID
+	. S ZJ=$P(ZJ,"^",1) ;JUST THE FIRST PIECE
+	. S ZJN=$G(^PSNDF(50.68,ZI,0)) ; VA NAME
+	. ;W !,ZJN," ",ZJ
+	. S ZK=$$NDDFBAS2^C0PLKUP(ZJ)
+	. I ZK'=0 D  ; FDB CONCEPT ID FOUND
+	. . S ZL=$O(^C0PALGY("C2","NAME",ZK,""))
+	. . S ZN=$$GET1^DIQ(113059005,ZL_",",.01,"E")
+	. . I ZN'="" D  ;
+	. . . S FOUND=FOUND+1
+	. . . S ZP=ZI_";PSNDF(50.68,"
+	. . . S C0PFDA(113059005,ZL_",",6)=ZP
+	. . . D UPDIE
+	. . W !,ZJN," ",ZJ
+	. . W $C(9),ZI," ",ZJ," :: ",ZK," ",ZN
+	W !,"COUNT:",COUNT," FOUND:",FOUND
+	Q
+	;
+TEST6	; CHECK ALL VUIDS IN VA PRODUCT FILE AGAINST RXNORM CONCEPT FILE
+	;
+	S ZI=0
+	S (COUNT,FOUND)=0
+	F  S ZI=$O(^PSNDF(50.68,ZI)) Q:+ZI=0  D  ; FOR EVERY DRUG IN THE NDF
+	. S COUNT=COUNT+1
+	. S ZJ=$G(^PSNDF(50.68,ZI,"VUID")) ;VUID
+	. S ZJ=$P(ZJ,"^",1) ;JUST THE FIRST PIECE
+	. S ZJN=$G(^PSNDF(50.68,ZI,0)) ; VA NAME
+	. ;W !,ZJN," ",ZJ
+	. S ZRXN=$O(^C0P("RXN","VUID",ZJ,""))
+	. I ZRXN'="" S FOUND=FOUND+1
+	W !,"COUNT:",COUNT," FOUND:",FOUND
+	Q
+	;
+TEST7	; CHECK ALL CONCEPT IDS IN THE FDB ALLERGY FILE AGAINST THE 
+	;RXNORM CONCEPT FILE - THIS APPOACH DOESN'T WORK.
+	;
+	S ZI=0
+	S (COUNT,FOUND)=0
+	F  S ZI=$O(^C0PALGY("C",ZI)) Q:+ZI=0  D  ; EVERY FDB ALLERGY CONCEPT
+	. S ZIN=$$GET1^DIQ(113059005,ZI_",",.01) ;NAME OF CONCEPT
+	. S ZJ=$O(^C0P("RXN","B",ZI,"")) ; RXNORM CONCEPT FIELD IS .01
+	. S COUNT=COUNT+1
+	. I ZJ'="" D  ; FOUND
+	. . S FOUND=FOUND+1
+	. . S ZJN=$G(^C0P("RXN",ZJ,1,1,0)) ;NAME OF CONCEPT
+	. . ;S ZJNNN=$$GET1^DIQ(1130590011.101,ZJ_",",,ZJN)
+	. . I ZIN'="" W !,ZI,ZIN," :: ",ZJ," ",ZJN
+	W !,"COUNT:",COUNT," FOUND:",FOUND
+	Q
+	;
+TESTC	; PRINT OUT DUPLICATES IN THE FROM THE C INDEX OF THE ALLERGY FILE
+	;
+	S (COUNT,COUNT2)=0
+	S ZI=""
+	F  S ZI=$O(^C0PALGY("C",ZI)) Q:ZI=""  D  ;
+	. S ZJ=$O(^C0PALGY("C",ZI,"")) ;IEN
+	. I $O(^C0PALGY("C",ZI,ZJ))'="" D  ;
+	. . S ZZ=""
+	. . F  S ZZ=$O(^C0PALGY("C",ZI,ZZ)) Q:ZZ=""  D  ;
+	. . . S COUNT=COUNT+1
+	. . . S ZK=$$GET1^DIQ(113059005,ZZ_",",6)
+	. . . S ZL=$$GET1^DIQ(113059005,ZZ_",",.01)
+	. . . S ZT=$$GET1^DIQ(113059005,ZZ_",",2)
+	. . . I ZK'="" S COUNT2=COUNT2+1
+	. . . S DUPS(ZI,ZL,ZT)=ZK
+	. . . W !,ZK," ",ZI
+	Q
+	;
+COUNT	; COUNT THE NUMBER OF MAPPINGS IN VA POINTER INDEX OF FDB ALLERGIES
+	;
+	N ZI,ZJ,COUNT
+	S COUNT=0
+	S ZI="" S ZJ=""
+	F  S ZI=$O(^C0PALGY("VA",ZI)) Q:ZI=""  D  ;
+	. S ZJ=""
+	. F  S ZJ=$O(^C0PALGY("VA",ZI,ZJ)) Q:ZJ=""  D  ;
+	. . S COUNT=COUNT+1
+	W !,"COUNT: ",COUNT,!
+	Q
+	;
+CHECK	; CHECK ALL ALLERGIES IN THE PATIENT ALLERGY FILE FOR MATCHES IN
+	; THE FDB ALLERGY FILE
+	N ZI,ZJ,COUNT
+	S (ZI,ZJ)=0 S COUNT=0 S COUNT2=0
+	F  S ZI=$O(^GMR(120.8,ZI)) Q:+ZI=0  D  ; FOR EACH ENTRY
+	. S ZJ=^GMR(120.8,ZI,0) ; ZERO NODE
+	. S PAT=$P(ZJ,U,1) ;PATIENT
+	. S ZN=$P(ZJ,U,2) ;REACTANT NAME
+	. S GMR=$P(ZJ,U,3) ;POINTER
+	. S COUNT=COUNT+1
+	. S FOUND=$O(^C0PALGY("VA",GMR,"")) ; VA POINTER INDEX
+	. S ZF=""
+	. I FOUND'="" D  ;
+	. . S COUNT2=COUNT2+1
+	. . S ZF=$$GET1^DIQ(113059005,FOUND_",",.01,"E")
+	. W !,"PAT:",PAT," ",ZN," ",GMR," :: ",FOUND," ",ZF
+	W !,"COUNT:",COUNT," FOUND:",COUNT2
+	Q
+	;
+LOADRXN	; LOAD THE FDB TO RXNORM CSV FILE INTO ^TMP
+	; THE FILE NAME IS CompositeAllergyID2RxCui.csv
+	; AND IT IS STORED IN /home/dev
+	N ZG
+	S ZG=$NA(^TMP("C0PALGY","RXNCSV",1))
+	W $$FTG^%ZISH("/home/dev/","CompositeAllergyID2RxCui.csv",ZG,3) ;INCREMENT
+	; 3rd NODE
+	Q
+	;
+ADDRXN	; ADD THE CompositeAllergyID to rxcui mapping to the 
+	; C0P FDB ALLERGY file
+	; the csv file with the mapping has been loaded into
+	; ^TMP("C0PALGY","RXNCSV") - see LOADRXN routine above
+	N ZI,ZJ,ZARY,ZF,C0PFDA
+	S ZF=113059005 ; FILE NUMBER FOR C0P FDB ALLERGY FILE
+	S ZARY=$NA(^TMP("C0PALGY","RXNCSV"))
+	S ZJ=$O(@ZARY@(""),-1) ; NUMBER OF ROWS IN THE ARRAY
+	F ZI=2:1:ZJ D  ; SKIP ROW 1, WHICH HAS THE COLUMN NAMES
+	. N ZFDA,ZRXN,ZROW
+	. K C0PFDA
+	. S ZROW=@ZARY@(ZI) ; EACH ROW IS ""X"",""Y""
+	. S ZFDA=$P(ZROW,",",1) ; CompositeAllergyID
+	. S ZFDA=$TR(ZFDA,"""") ; GET RID OF EXTRA QUOTES
+	. S ZRXN=$P(ZROW,",",2) ; rxcui
+	. S ZRXN=$TR(ZRXN,"""") ; GET RID OF EXTRA QUOTES 
+	. W !,ZFDA," ",ZRXN
+	. S ZOHONE=$$GET1^DIQ(ZF,ZFDA_",",.01)
+	. S C0PFDA(ZF,ZFDA_",",.01)=ZOHONE
+	. S C0PFDA(ZF,ZFDA_",",7)=ZRXN ; SET rxcui for ien ZFDA
+	. D UPDIE
+	Q
+	;
+LOOKRXN	; LOOK UP RXCUI VALUES IN THE RXNORM CONCEPT FILE
+	;
+	S COUNT=0 S FOUND=0
+	S ZI=""
+	F  S ZI=$O(^C0PALGY("RXCUI",ZI)) Q:ZI=""  D  ;
+	. S COUNT=COUNT+1
+	. S ZJ=$O(^C0P("RXN","B",ZI,"")) ;
+	. W !,ZI," ",ZJ
+	W !,COUNT," FOUND"
+	Q
+	;
+LOOKFDB	;LOOK UP FDB NUMBERS IN THE RXNORM FILE
+	;
+	S ZI=""
+	F  S ZI=$O(^C0PALGY("C",ZI)) Q:ZI=""  D  ;
+	. S ZJ=$O(^C0PALGY("C",ZI,""))
+	. W !,ZI," ",ZJ
+	Q
+	;
+MKRNF	; CREATING AN RNF FILE FOR THE FDB ALLERGY TABLE
+	;
+	F ZI=1:1:999999 F ZJ=1:1:7 D  ;
+	. I ZJ=1 S ^GRNF("V",ZI,$O(^GRNF("F",ZJ,"")))=ZI
+	. S ZK=$P(^GPLFDB(ZI),""",""",ZJ)
+	. S ZK=$TR(ZK,"""")
+	. I ZJ=6  D  ;STATUS
+	. . I (ZK'="A")&(ZK'="I") D ERROR^C0PMAIN(",U113059009,",$ST($ST,"PLACE"),"ERX-INVALID-DATA","Invalid Data") QUIT
+	. I ZK'="" D  ;
+	. . S ^GRNF("V",ZI,$O(^GRNF("F",ZJ,"")))=ZK
+	Q
+	;
+FILEFDB	;POPULATE C0P FDB ALLERGIES FROM RNF STRUCTURE IN ^GRNF
+	;
+	F ZI=1:1:999999 D  ;
+	. K C0PFDA
+	. S C0PFDA(113059005,"?+1,",.01)=^GRNF("V",ZI,"Description")
+	. S C0PFDA(113059005,"?+1,",.05)=$G(^GRNF("V",ZI,"CompositeAllergyID"))
+	. S C0PFDA(113059005,"?+1,",1)=^GRNF("V",ZI,"ConceptID")
+	. S C0PFDA(113059005,"?+1,",2)=^GRNF("V",ZI,"ConceptType")
+	. S C0PFDA(113059005,"?+1,",3)=^GRNF("V",ZI,"Source")
+	. S C0PFDA(113059005,"?+1,",4)=^GRNF("V",ZI,"Status")
+	. S C0PFDA(113059005,"?+1,",5)=^GRNF("V",ZI,"TouchDate")
+	. ;ZWR C0PFDA
+	. ;B
+	. D UPDIE
+	Q
+	;
+UPDIE	  ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+	K ZERR
+	D CLEAN^DILF
+	D UPDATE^DIE("","C0PFDA","","ZERR")
+	I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
+	K C0PFDA
+	Q
Index: ePrescribing/trunk/p/C0PALGY3.m
===================================================================
--- ePrescribing/trunk/p/C0PALGY3.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PALGY3.m	(revision 1595)
@@ -0,0 +1,98 @@
+C0PALGY3	  ; ERX/GPL - eRx Allergy utilities ; 5/8/12 9:11pm
+	;;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
+	;
+ADDALGY(RTNXML,ZDUZ,ZDFN,ZFILE)	; ADDS PATIENT ALLERGIES TO NCSCRIPT
+	; CLICK-THROUGH HTLM FILE FOR
+	; MAPPING ALLERGIES , XML IS RETURNED IN RTN,PASSED BY NAME
+	; IF ZFILE IS 1, THE FILE IS WRITTEN TO AN XML FILE
+	;D EN^C0PMAIN("G1","G2",ZDUZ,ZDFN) ; GET THE NCSCRIPT
+	;S @RTNURL=G2
+	;D GETXML^C0PWS1("G3",14) ; GET BEGINNING OF FILE
+	;D GETXML^C0PWS1("G4",15) ; GET END OF FILE
+	N G1,G2,G3,G4,G5,G6,GBLD
+	D GETALGY("G6",ZDFN) ;GET ALLERGIES
+	;D QUEUE^C0CXPATH("GBLD","G3",1,$O(G3(""),-1)) ;BUILD LIST BEGINNING OF FILE
+	;;D QUEUE^C0CXPATH("GBLD","G1",1,$O(G1(""),-1)) ; NCSCRIPT
+	M G1=@RTNXML
+	S GEND=$O(G1(""),-1)-2
+	D QUEUE^C0CXPATH("GBLD","G1",1,GEND) ; NCSCRIPT.. UP TO </Patient>
+	D QUEUE^C0CXPATH("GBLD","G6",1,$O(G6(""),-1)) ; ADD THE ALLERGIES
+	D QUEUE^C0CXPATH("GBLD","G1",GEND+1,$O(G1(""),-1)) ;END OF NCSCRIPT
+	D QUEUE^C0CXPATH("GBLD","G4",1,$O(G4(""),-1)) ; END OF FILE
+	D BUILD^C0CXPATH("GBLD","G5") ; BUILD THE CONTENTS FROM THE BUILD LIST
+	K @RTNXML
+	M @RTNXML=G5 ;
+	I $G(ZFILE)=1 W $$OUTPUT^C0CXPATH("G5(1)","ALLERGY-"_ZDFN_".html","/home/dev/CCR/")
+	Q
+	;
+GENTEST(RTNXML,RTNURL,ZDUZ,ZDFN,ZFILE)	; GENERATE A TEST 
+	; CLICK-THROUGH HTLM FILE FOR
+	; MAPPING ALLERGIES , XML IS RETURNED IN RTN,PASSED BY NAME
+	; IF ZFILE IS 1, THE FILE IS WRITTEN TO HOST FILE
+	D EN^C0PMAIN("G1","G2",ZDUZ,ZDFN) ; GET THE NCSCRIPT
+	;S @RTNURL=G2
+	D GETXML^C0PWS1("G3",14) ; GET BEGINNING OF FILE
+	D GETXML^C0PWS1("G4",15) ; GET END OF FILE
+	D GETALGY("G6",ZDFN) ;GET ALLERGIES
+	D QUEUE^C0CXPATH("GBLD","G3",1,$O(G3(""),-1)) ;BUILD LIST BEGINNING OF FILE
+	;D QUEUE^C0CXPATH("GBLD","G1",1,$O(G1(""),-1)) ; NCSCRIPT
+	D QUEUE^C0CXPATH("GBLD","G1",1,76) ; NCSCRIPT.. UP TO </Patient>
+	D QUEUE^C0CXPATH("GBLD","G6",1,$O(G6(""),-1)) ; ADD THE ALLERGIES
+	D QUEUE^C0CXPATH("GBLD","G1",77,$O(G1(""),-1)) ;END OF NCSCRIPT
+	D QUEUE^C0CXPATH("GBLD","G4",1,$O(G4(""),-1)) ; END OF FILE
+	D BUILD^C0CXPATH("GBLD","G5") ; BUILD THE CONTENTS FROM THE BUILD LIST
+	M @RTNXML=G5 ;
+	I $G(ZFILE)=1 W $$OUTPUT^C0CXPATH("G5(1)","ALLERGY-"_ZDFN_".html","/home/dev/CCR/")
+	Q
+	;
+GETALGY(OUTARY,ZDFN)	;
+	;
+	N ZG,ZG2,ZB,ZN
+	S DEBUG=0
+	D GETTEMP^C0PWS1("ZG",16) ;GET THE ALLERGY TEMPLATE
+	D EXTRACT^C0CALERT("ZG",ZDFN,"ZG2","ALGYCBK^C0PALGY3(ALTVMAP,A1)")
+	S ZN=$O(ZG2(""),-1) ;NUMBER OF LINES IN OUTPUT
+	D QUEUE^C0CXPATH("ZB","ZG2",2,ZN-1)
+	D BUILD^C0CXPATH("ZB",OUTARY)
+	Q
+	; 
+ALGYCBK(ZRTN,ZIN)	;CALLBACK ROUTINE FOR C0CALERT USED TO SET FDB CONCEPT
+	; ID IF FOUND. ZIN IS PASSED BY NAME AND IS ONE ALLERGY
+	N ZI,ZJ
+	S ZI=$P(ZIN,"^",9) ;THIS IS THE VARIABLE POINTER OF THE GMR ALLERGY
+	I ZI="" Q
+	S ZJ=$O(^C0PALGY("VA",ZI,""))
+	I ZJ'="" D  ; CONCEPT WAS FOUND
+	. S ZK=$$GET1^DIQ(113059005,ZJ_",",.05) ;COMPOSIT ALLERGY ID (NOT CONCEPT)
+	. S @ZRTN@("ALERTFDBCONCEPTID")=ZK
+	. S @ZRTN@("ALERTFDB")="FDB"
+	E  D  ;
+	. S @ZRTN@("ALERTFDBCONCEPTID")=""
+	. S @ZRTN@("ALERTFDB")=""
+	Q
+	;
+UPDIE	  ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+	K ZERR
+	D CLEAN^DILF
+	D UPDATE^DIE("","C0PFDA","","ZERR")
+	I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
+	K C0PFDA
+	Q
Index: ePrescribing/trunk/p/C0PCPRS1.m
===================================================================
--- ePrescribing/trunk/p/C0PCPRS1.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PCPRS1.m	(revision 1595)
@@ -0,0 +1,363 @@
+C0PCPRS1	  ; CCDCCR/GPL - ePrescription utilities; 8/1/09 ; 5/8/12 10:18pm
+	;;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
+	;
+	; THESE ROUTINE CONSTITUTE ALL OF THE ENTRY POINTS IN THE ERX PACKAGE
+	; THAT ARE USED BY CPRS.
+	; ERXRPC IS USED BY CPRS TO LAUNCH THE MEDICATION COMPOSE SCREEN
+	;   IT IS ALSO USED BY CPRS TO PROCESS AN INCOMPLETE ORDER ALERT
+	; ERXPULL IS USED BY CPRS AFTER A SESSION WITH THE EPRESCRIBING PROVIDER
+	;   TO PULL BACK ANY NEW MEDICATIONS AND ALLERGIES FROM THAT SESSION
+	;   IT DOES MEDICATION AND ALLERGY RECONCILLIATION
+	; ALERTRPC IS USED BY CPRS TO LAUCH THE RENEWAL REQUEST SCREEN IN THE 
+	;   EPRECRIBING PROVIDER. AFTER THE RENEWAL SESSION ENDS, ERXPULL IS ALSO 
+	;   CALLED
+	; GPL JUNE, 2010
+	;
+	; TEST Lines below not intended for End Users. Programmers only.
+	; BEWARE ZWRITE SYNTAX. It may not work in other M Implementations.
+TEST1	; TEST ERX RPC FROM COMMAND LINE - RETURN RAW HTTPS POST ARRAY
+	;
+	N C0PG1
+	D ERXRPC(.C0PG1,"135","2")
+	W $$OUTPUT^C0CXPATH("C0PG1(1)","Test-RPC-POST1.html","/home/dev/CCR/"),!
+	ZWRITE C0PG1
+	Q
+	;
+TEST2	; TEST ERX RPC FROM COMMAND LINE - RETURN CODED HTTPS POST ARRAY
+	;
+	Q
+	;
+ERXPULL(RTN,IDUZ,IDFN)	;RPC TO PULL BACK DRUGS AND ALLERGIES
+	;
+	S ^TMP("GPL","PULLBACKDFN")=IDFN ; debugging
+	N UDFN
+	S UDFN=IDFN
+	I $D(^TMP("C0E",$J,"NEWDFN")) D  ; IF THERE IS A NEW RENEWAL PATIENT
+	. I IDFN'=0 Q  ; SHOULD BE ZERO FOR A NO MATCH RENEWAL
+	. S UDFN=^TMP("C0E",$J,"NEWDFN") ; GET THE MATCHED PATIENT DFN
+	. S ^TMP("GPL","NEWDFN")=UDFN ; debugging
+	. K ^TMP("C0E",$J,"NEWDFN") ; ERASE IT NOW THAT IT IS USED
+	D GETRXNS^C0PALGY1(IDUZ,UDFN,.RTN) ;PULL BACK ALLERGIES AND ADD TO ALLERGIES
+	D GETMEDS^C0PRECON(IDUZ,UDFN,.RTN) ;PULL BACK MEDS AND ADD TO NON-VA MEDS
+	I $G(RTN(1))="" S RTN(1)="OK"
+	I UDFN'=IDFN S RNT(1)="DFN="_UDFN ; TELL CPRS ABOUT THE NEW DFN
+	;D REFILL^C0PREFIL ; PULL BACK REFILL REQUESTS EVERY TIME 
+	Q
+	;
+TESTUC0P	
+	S ZA="OR,18,11305;135;3120305.103008"
+	D ALERTRPC(.GPL,135,18,1,ZA)
+	Q
+	;
+TESTALRT(GPL,ZDUZ,ZDFN,MODE)	; TEST THE ALERT RPC
+	;
+	;S G=$O(^XTV(8992,135,"XQA",""),-1)
+	;S G=3110102.15081201
+	;S ZA="OR,18,11305;135;"_G ;3101223.125521" ; AN ALERT RECORD ID
+	;S ZA="OR,0,11305;135;3110103.09324904"
+	I $G(MODE)'=1 S MODE=0 ; TEST MODE HERE
+	N ZI,ZJ S ZI=0
+	F  S ZI=$O(^XTV(8992,ZDUZ,"XQA",ZI)) Q:ZI=""  D  ;
+	. S ZJ=^XTV(8992,ZDUZ,"XQA",ZI,0)
+	. I ZJ["no match" S G=ZI
+	I $G(G)="" W !,"OOPS" Q  ;
+	S ZA="OR,18,11305;135;"_G
+	;S ZA="OR,18,11305;135;3110810.123002"
+	W !,ZA
+	D ALERTRPC(.GPL,ZDUZ,ZDFN,1,ZA,MODE)
+	Q
+	I ZDFN=18 D ALERTRPC(.GPL,135,18,1,ZA)
+	E  D  ;
+	. ;S ZA="OR,0,11305;1;3101223.125521"
+	. D ALERTRPC(.GPL,135,0,1,ZA)
+	Q
+ALERTRPC(RTN,IDUZ,IDFN,DEST,ISTR,MODE)	;RPC FOR ERX ALERTS
+	; MODE IS A MODE SWITCH IF MODE=1 WE ARE USING THE BROWSER REDIRECT
+	; METHOD OF CLICKING THROUGH. THIS IS DONE TO COMPLETE NOMATCH RENEWALS
+	; FROM EWD
+	; IF MODE IS NOT SPECIFIED OR IS NOT 1, WE WILL USE THE CPRS REDIRECT
+	; METHOD OF CLICKING THROUGH. 
+	; THE MAIN DIFFERENCE BETWEEN THE TWO MODES IS THE HTML PACKAGING
+	; SURROUNDING THE NCSCRIPT XML
+	;
+	I $G(MODE)'=1 S MODE=0 ; MODE IS 0 IF IT'S NOT 1
+	S C0PRMODE=1 ; RENEWAL MODE - KILL AT THE END
+	;
+	; FIRST SEE IF LOOK UP THE RENEWAL GUID 
+	N ZGUID,ZALRT,C0PMED,ZDOB,ZSEX
+	; USE THE NEW GETALRT^C0PREFIL TO GET THE GUID DIRECTLY FROM
+	; THE ALERT TRACKING FILE USING THE RECORDID PASSED IN ISTR
+	;D GETALRT^C0PREFIL("ZALRT",ISTR) ; GET THE ENTIRE ALERT
+	;S ZGUID=$G(ZALRT("DATA FOR PROCESSING")) ; PULL OUT THE GUID
+	; GET THE GUID THE QUICK WAY DIRECTLY FROM THE GLOBAL
+	S ZALRT=$P(ISTR,";",3) ;THE TIME PORTION OF THE RECORD ID
+	S ZGUID=$G(^XTV(8992,IDUZ,"XQA",ZALRT,1)) ;WHERE THE GUID SHOULD BE
+	S ZDOB=$P(ZGUID,"^",2) ; DATE OF BIRTH
+	S ZSEX=$P(ZGUID,"^",3) ; GENDER
+	S ZGUID=$P(ZGUID,"^",1) ; GUID IS PIECE ONE
+	I ZGUID'="" D  ; FOUND THE ALERT
+	. N ZNM S ZNM=$G(^XTV(8992,IDUZ,"XQA",ZALRT,0)) ; THE ALERT RECORD
+	. S C0PRNM=$P($P(ZNM,"[eRx] ",2)," Renewal",1) ; patient name
+	. S C0PMED=$P(ZNM,"request for ",2) ; name of the medication
+	;I ZGUID="" S ^G("NOGUID")=ISTR
+	;I ZGUID="" M ^G("NOGUID")=^XTV(8992,IDUZ,"XQA")
+UC0P1	I ZGUID="" D  Q  ; This is usually a missing Alert due to timing
+	. ; of the batch job and the CPRS request to process an error.
+	. W "ERROR EXTRACTING ALERT",!
+	. I $T(LOG^%ZTER)="" D ^%ZTER Q  ;
+	. N C0PERR S C0PERR="UC0P1"
+	. S C0PERR("PLACE")="UC0P1^C0PCPRS1"
+	. D LOG^%ZTER(.C0PERR)
+	;N DONE S DONE=0
+	;I ZGUID="" D  ; TRY AND FIND THE GUID ANYWAY
+	;. N ZZI S ZZI=0
+	;. F  S ZZI=$O(^XTV(8992,IDUZ,"XQA",ZZI)) Q:DONE  Q:ZZI=""  D  ; 
+	;. . N ZA S ZA=$G(^XTV(8992,IDUZ,"XQA",ZZI,0))
+	;. . ;W !,ZA B  
+	;. . I ZA="" Q  ; SHOULDN'T HAPPEN
+	;. . I $P(ZA,ZALRT,2)'="" D  ;
+	;. . . N ZNM S ZNM=$G(^XTV(8992,IDUZ,"XQA",ZZI,0)) ; THE ALERT RECORD
+	;. . . S C0PRNM=$P($P(ZNM,"[eRx] ",2)," Renewal",1) ; patient name
+	;. . . S ZGUID=$G(^XTV(8992,IDUZ,"XQA",ZZI,1)) ; THE GUID
+	;. . . S ZDOB=$P(ZGUID,"^",2) ; DATE OF BIRTH
+	;. . . S ZSEX=$P(ZGUID,"^",3) ; GENDER
+	;. . . S ZGUID=$P(ZGUID,"^",1) ; GUID IS PIECE ONE
+	;. . . S C0PMED=$P(ZNM,"request for ",2) ; name of the medication
+	;. . . S DONE=1
+	I ZGUID="" W "ERROR EXTRACTING ALERT",! Q  ;
+	;S ZGUID=$P(ZGUID,U,3) ;THE VALUE IS IN P3
+	;S ZIEN=$O(^C0PRE("E","A",IDUZ,IDFN,ISTR,"")) ;LOOK FOR AN ACTIVE ALERT 
+	;I ZIEN="" D  Q  ; OOPS NO MATCHING ALERT. THIS IS AN ERROR
+	;. W "ERROR ALERT NOT FOUND",!
+	;S ZGUID=$$GET1^DIQ(113059006,ZIEN_",",.01,"I")
+	; BUILD THE NCSRIPT XML FOR RENEWALS
+	N ZTID
+	S ZTID=$$RESTID^C0PWS1(IDUZ,"RENEWREQ") ;
+	N GVOR ; VARIABLE OVERRIDE ARRAY
+	S GVOR=""
+	S GVOR("REQUESTED-PAGE")="renewal"
+	N ZARY,ZURL
+	D EN^C0PMAIN("ZARY","ZURL",IDUZ,IDFN,,"GVOR") ; GET THE NCSCRIPT
+	I IDFN=0 D DELETE^C0CXPATH("ZARY","//NCScript/Patient") ;delete patient
+	I IDFN=0 D  ; GOING TO CALL THE EWD RENEWAL PATIENT MATCHING SCREEN
+	. S C0PNONAME=1
+	. S C0PSAV("IDUZ")=IDUZ
+	. M C0PSAV("DUZ")=DUZ
+	. S C0PSAV("DFN")=0
+	. S C0PSAV("C0PRenewalName")=C0PRNM ; THE RENEWAL NAME
+	. S C0PSAV("RenewalDOB")=ZDOB ; PHARMACY REQUEST DATE OF BIRTH
+	. S C0PSAV("RenewalSex")=ZSEX ; PHARMACY REQUEST GENDER
+	. S C0PSAV("renewalToken")=ISTR ; CPRS ALERT TOKEN IDENTIFIER
+	. S C0PMED=$P(C0PMED,"^",1) ; CLEAN UP THE MEDICATION NAME
+	. S C0PSAV("medication")=C0PMED ; MEDICATION BEING RENEWED
+	. S C0PSAV("C0PGuid")=ZGUID ; RENEWAL GUID
+	. S C0PSAV("dollarJ")=$J ; save the $J of the CPRS session
+	. ; PASSING THE SUPERVISING DOCTOR DUZ ALONG TO THE EWD RENEWAL SCREEN
+	. S C0PSAV("SUPERVISING-DUZ")=$G(C0PVARS("SUPERVISING-DOCTOR-DUZ")) ;
+	N ZTMP
+	D GETTEMP^C0PWS1("ZTMP",ZTID)
+	N ZV
+	S ZV("RENEWAL-GUID")=ZGUID
+	S ZV("RESPONSE-CODE")="Undetermined"
+	N ZRVAR,ZREXML
+	D BIND^C0PMAIN("ZRVAR","ZV",ZTID)
+	D MAP^C0CXPATH("ZTMP","ZRVAR","ZREXML")
+	K ZREXML(0) ; 
+	D INSERT^C0CXPATH("ZARY","ZREXML","//NCScript")
+	K ZARY(0)
+	D WRAP(.RTN,.ZARY,MODE)
+	K C0PRMODE ; TURN OFF THE RENEWAL MODE
+	Q
+	;
+ERXRPC(RTN,IDUZ,IDFN)	; RPC CALL TO RETURN HTTPS POST ARRAY FOR MEDS ORDERING
+	;
+	;I IDUZ=135 D TESTALRT(.RTN,IDFN) Q  ;GPLTESTING
+	N C0PXML,C0PURL
+	D EN^C0PMAIN("C0PXML","C0PURL",IDUZ,IDFN,,,1) ;INCLUDE FREEFORM ALLERGIES
+	D WRAP(.RTN,.C0PXML) ; WRAP IN HTML FOR PROCESSING IN CPRS
+	Q
+	;
+WRAP(ZRTN,ZINARY,MODE)	;WRAPS AN XML ARRAY (ZINARY) IN HTML FOR PROCESSING
+	; BY CPRS - ZINARY AND ZRTN ARE PASSED BY REFERENCE
+	; SEE COMMENT ABOVE ABOUT THE MODE SWITCH
+	I $G(MODE)'=1 S MODE=0 ; BROWSER REDIRECT MODE IS 0 IF IT IS NOT 1
+	;
+	I '$D(ZINARY(1)) D  Q  ; NOT SET UP FOR ERX 
+	. S ZRTN(1)="ERROR, PROVIDER NOT SUBSCRIBED"
+	I MODE'=1 S ZINARY(1)="RxInput="_ZINARY(1)
+	; GPL - GET THE URL FROM THE XML TEMPLATE FILE BASED ON PRODUCTION FLAG
+	;S url="https://preproduction.newcropaccounts.com/InterfaceV7/RxEntry.aspx"
+	D SETUP^C0PMAIN() ;INITALIZE C0PACCT WS ACCOUNT IEN
+	S url=$$CTURL^C0PMAIN(C0PACCT) ; PRODUCTION OR TEST URL
+	I $G(C0PNONAME)=1 D  ;
+	. I MODE Q  ; WE'VE ALREADY BEEN TO EWD. THIS IS SECOND TIME
+	. n token s token=$$STORE^C0CEWD("C0PSAV") ; STORE FOR EWD SCREENS
+	. N ZT,ZU,ZP
+	. S ZT=$O(^C0PX("B","C0P RENEWAL NOMATCH URL","")) ; IEN FOR URL
+	. ; EXAMPLE URL: https://viper/dev/eRx/index1.ewd - be sure it matches
+	. ; your system
+	. S ZU=$$GET1^DIQ(113059001,ZT_",",1) ; URL OF NOMATCH RENEWAL SCREEN
+	. I C0PVARS("SUBSCRIBER-USERTYPE")="MidlevelPrescriber" S ZP="midmatch.ewd"
+	. E  S ZP="index1.ewd" ; midlevels get their own page
+	. S url=ZU_ZP_"?token="""_token_"""" ; ewd interface
+	. S C0PNONAME=0
+	I MODE D BRSRDR Q  ; BROWSER REDIRCT PACKAGEING INSTEAD OF httpPOST2
+	S ok=$$httpPOST2(.ZRTN,url,.ZINARY,"application/x-www-form-urlencoded",.gpl6,"","",.gpl5,.gpl7)
+	Q
+	;
+BRSRDR	; GENERATE BROWSER REDIRECT PACKAGING TO RETURN TO BE SENT TO THE
+	; BROWSER
+	;
+	N ZB,ZTMP,ZTOP,ZBOT,ZTID1,ZTID2,ZVARS
+	S ZTID1=$$RESTID^C0PWS1(IDUZ,"C0P RENEWAL BRSRDR TOP") ; TOP XML IEN
+	S ZTID2=$$RESTID^C0PWS1(IDUZ,"C0P RENEWAL BRSRDR BOTTOM") ; BOTTOM XML IEN
+	D GETXML^C0PWS1("ZTMP",ZTID1) ; TOP XML
+	S ZVARS("url")=url
+	D MAP^C0CXPATH("ZTMP","ZVARS","ZTOP") ; SET THE URL PROPERLY
+	D GETXML^C0PWS1("ZBOT",ZTID2) ; BOTTOM XML
+	D QUEUE^C0CXPATH("ZB","ZTOP",1,$O(ZTOP(""),-1)) ; ADD TOP TO BUILD LIST
+	D QUEUE^C0CXPATH("ZB","ZINARY",1,$O(ZINARY(""),-1)) ; ADD NCSCRIPT
+	D QUEUE^C0CXPATH("ZB","ZBOT",1,$O(ZBOT(""),-1)) ; ADD BOTTOM
+	D BUILD^C0CXPATH("ZB","ZRTN") ; BUILD RETURN HTML
+	K ZRTN(0) ; KILL LENTGH NODE
+	Q
+	;
+GETPOST1(URL)	;
+	;RETRIEVES WSDL SAMPLE XML FROM A WEBSERVICE AT ADDRESS URL PASSED BY VALUE
+	;RETURNS THE XML IN ARRAY gpl
+	s ok=$$httpGET^%zewdGTM(URL,.gpl)
+	;W "XML retrieved from Web Service:",!
+	;ZWR gpl
+	D INDEX^C0CXPATH("gpl","gpl2",-1,"gplTEMP")
+	Q
+	;
+httpPOST2(ARY,url,payload,mimeType,html,headerArray,timeout,test,rawResponse,respHeaders,sslHost,sslPort)	
+	;ORGINALLY THIS ROUTINE WAS FROM zewdGTM.m (thanks Rob!)
+	;HACKED BY GPL TO RETURN ITS HTML IN AN ARRAY (ARY PASSED BY REF)
+	;INSTEAD OF SENDING IT OUT A TPC PORT
+	;THE ARY WILL BE SENT VIA RPC TO CPRS TO LAUNCH A BROWERS
+	;USING THIS "POST" HTML AS THE STARTING PAGE (THANKS ART)
+	;USES THE ROUTINE gw BELOW TO BUILD THE ARRAY
+	; todo: html not used, test not used, rawResponse, respHeaders
+	; sam's notes: this routine doesn't actually post anything; it just formats.
+	n contentLength,dev,host,HTTPVersion,io,port,rawURL,ssl,urllc
+	n zg ; gpl
+	;
+	k rawResponse,html
+	s HTTPVersion="1.0"
+	s rawURL=url
+	s ssl=0
+	s port=80
+	s urllc=$$zcvt^%zewdAPI(url,"l")
+	i $e(urllc,1,7)="http://" d
+	. s url=$e(url,8,$l(url))
+	. s sslHost=$p(url,"/",1)
+	. s sslPort=80
+	e  i $e(urllc,1,8)="https://" d
+	. s url=$e(url,9,$l(url))
+	. s ssl=1
+	. s sslHost=$g(sslHost)
+	. i sslHost="" s sslHost="127.0.0.1"
+	. s sslPort=$g(sslPort)
+	. i sslPort="" s sslPort=89
+	e  QUIT "Invalid URL"
+	s host=$p(url,"/",1)
+	i host[":" d
+	. s port=$p(host,":",2)
+	. s host=$p(host,":",1)
+	s url="/"_$p(url,"/",2,5000)
+	i $g(timeout)="" s timeout=20
+	;
+	;GPL s io=$io
+	i $g(test)'=1 d
+	. ;GPL s dev=$$openTCP(sslHost,sslPort,timeout)
+	;GPL . u dev
+	i ssl d
+	. ;w "POST "_rawURL_" HTTP/"_HTTPVersion_$c(13,10)
+	. s zg="POST "_rawURL_" HTTP/"_HTTPVersion_"^M"
+	. d gw(zg)
+	e  d
+	. ;w "POST "_url_" HTTP/"_HTTPVersion_$c(13,10)
+	. s zg="POST "_url_" HTTP/"_HTTPVersion_"^M"
+	. d gw(zg)
+	;w "Host: "_host
+	s zg="Host: "_host
+	d gw(zg)
+	i port'=80 s zg=":"_port d gw(zg) ;w ":"_port
+	s zg=$c(13,10) d gw(zg) ;w $c(13,10)
+	s zg="Accept: */*"_$c(13,10) d gw(zg) ;w "Accept: */*"_"^M"
+	;
+	i $d(headerArray) d
+	. n n
+	. s n=""
+	. f  s n=$o(headerArray(n)) q:n=""  d
+	. . ;w headerArray(n)_$c(13,10)
+	. . s zg=headerArray(n)_"^M"
+	. . d gw(zg)
+	;
+	s mimeType=$g(mimeType)
+	i mimeType="" s mimeType="application/x-www-form-urlencoded"
+	s contentLength=0
+	i $d(payload) d
+	. n no
+	. s no=""
+	. f  s no=$O(payload(no)) q:no=""  D
+	. . s contentLength=contentLength+$l(payload(no))
+	. s contentLength=contentLength
+	. s zg="Content-Type: "_mimeType ;w "Content-Type: ",mimeType
+	. d gw(zg)
+	. i $g(charset)'="" d  ;
+	. . ;w "; charset=""",charset,""""
+	. . s zg="; charset="""_charset_""""
+	. . d gw(zg)
+	. s zg="^M" d gw(zg) ;w $c(13,10)
+	. ;w "Content-Length: ",contentLength,$c(13,10)
+	. s zg="Content-Length: "_contentLength_"^M"
+	. d gw(zg)
+	;
+	s zg="^M" d gw(zg) ;w $c(13,10)
+	i $D(payload) d
+	. n no
+	. s no=""
+	. f  s no=$O(payload(no)) q:no=""  d
+	. . ;w payload(no)
+	. . s zg=payload(no)
+	. . d gw(zg)
+	; 
+	s zg="^M" d gw(zg) ;w $c(13,10)
+	;w $c(13,10),!  gpl- what does a bang send out????????
+	;
+	; That's the request sent !
+	;
+	;g httpResponse
+	;
+	q ""
+	;
+gw(LINE)	; Private proc; Adds line to end of array
+	;
+	I '$D(ARY(1)) S ARY(1)=LINE
+	E  D  ;
+	. N CNT
+	. S CNT=$O(ARY(""),-1)
+	. S CNT=CNT+1
+	. S ARY(CNT)=LINE
+	Q
+	;
Index: ePrescribing/trunk/p/C0PCUR.m
===================================================================
--- ePrescribing/trunk/p/C0PCUR.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PCUR.m	(revision 1595)
@@ -0,0 +1,194 @@
+C0PCUR	; VEN/SMH - Get current medications ; 5/8/12 9:24pm
+	;;1.0;C0P;;Apr 25, 2012;Build 103
+	;
+	;Copyright 2009 Sam Habiel.  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.
+	;
+GET(C0PMEDS,C0PDFN)	; Private Proc - Get Current C0PMEDS
+	; Input: 
+	; C0PMEDS by reference
+	; C0PDFN by Value
+	; Output: (modified PSOORRL output)
+	; C0PMEDS(D0,0): Order#_File;Pkg^Drug Name^Infusion Rate^Stop Date ^Refills Remaining^Total Dose^Units per Dose^Placer#^Status^Last Filldate^Days Supply^Qty^NOT TO BE GIVEN^Pending Renewal (1 or 0)
+	; C0PMEDS(D0,"DRUG"): Drug IEN
+	; C0PMEDS(D0,"A",0)      = # of lines
+	; C0PMEDS(D0,"A",D1,0)   = Additive Name^Amount^Bottle
+	; C0PMEDS(D0,"ADM",0)    = # of lines
+	; C0PMEDS(D0,"ADM",D1,0) = Administration Times
+	; C0PMEDS(D0,"B",0)      = # of lines
+	; C0PMEDS(D0,"B",D1,0)   = Solution Name^Amount
+	; C0PMEDS(D0,"MDR",0)    = # of lines
+	; C0PMEDS(D0,"MDR",D1,0) = Medication Route abbreviation
+	; C0PMEDS(D0,"P",0)      = IEN^Name of Ordering Provider (#200)
+	; C0PMEDS(D0,"SCH",0)    = # of lines
+	; C0PMEDS(D0,"SCH",D1,0) = Schedule Name
+	; C0PMEDS(D0,"SIG",0)    = # of lines
+	; C0PMEDS(D0,"SIG",D1,0) = Sig (outpatient) or Instructions (inpatient)
+	; C0PMEDS(D0,"SIO",0)    = # of lines
+	; C0PMEDS(D0,"SIO",D1,0) = Special Instructions/Other Print Info
+	; C0PMEDS(D0,"START"): Start Date (timson)
+	; added by gpl
+	; C0PMEDS(D0,"NVAIEN")   = IEN of the drug in the NVA subfile
+	; C0PMEDS(D0,"COMMENTS") = First line of the comment WP field in NVA
+	K ^TMP("PS",$J)
+	N BEG,END,CTX
+	S (BEG,END,CTX)=""
+	S CTX=$$GET^XPAR("ALL","ORCH CONTEXT C0PMEDS") ; PSOORRL defaults to 120d
+	I CTX=";" D DEL^XPAR("USR.`"_DUZ,"ORCH CONTEXT C0PMEDS")
+	S CTX=$$GET^XPAR("ALL","ORCH CONTEXT C0PMEDS")
+	S BEG=$$DT($P(CTX,";")),END=$$DT($P(CTX,";",2))
+	D OCL^PSOORRL(C0PDFN,BEG,END)  ;DBIA #2400
+	M C0PMEDS=^TMP("PS",$J)
+	N C0PI S C0PI="" ; THIS IS THE RETURNED LIST OF MEDS
+	N ZI S ZI=0 ; THIS WILL BE THE MATCHING IEN IN THE NVA MULTIPLE
+	F  S C0PI=$O(C0PMEDS(C0PI)) Q:C0PI=""  D
+	. K ^TMP("PS",$J) ; again
+	. N LSIEN S LSIEN=$P(C0PMEDS(C0PI,0),U,1) ; LIST IEN xN;O OR xR;O gpl
+	. D OEL^PSOORRL(C0PDFN,LSIEN)
+	. S C0PMEDS(C0PI,"START")=$P(^TMP("PS",$J,0),U,5) ; Start Date in fm
+	. S:+$G(^TMP("PS",$J,"DD",1,0)) C0PMEDS(C0PI,"DRUG")=+^(0) ; Drug IEN
+	. ;I '$D(GPLTEST) Q  ; let me test and others still work
+	. ; now go look for the NVAIEN in the subfile - gpl
+	. ;W !,"LSIEN "_LSIEN_"C0PI "_C0PI
+	. I $P(LSIEN,";",1)["N" D  ; only for NVA drugs
+	. . ;N ZI S ZI=0 
+	. . N FOUND S FOUND=0
+	. . ;F  Q:FOUND=1  S ZI=$O(^PS(55,C0PDFN,"NVA",ZI)) Q:+ZI=0  D  ;EACH NVA
+	. . S ZI=$O(^PS(55,C0PDFN,"NVA",ZI)) D  ; NEXT NVA IEN (MAKE SURE IT MATCHES)
+	. . . N ZN S ZN=$NA(^PS(55,C0PDFN,"NVA",ZI))
+	. . . I '$D(@ZN@(0)) Q  ; BAD NVA NODE
+	. . . I $P(@ZN@(0),U,2)=$G(C0PMEDS(C0PI,"DRUG")) S FOUND=1 ;DRUG NUMBERS MATCH
+	. . . E  D  ; CHECK FOR FREE TEXT DRUG MATCH
+	. . . . N Z1 S Z1=$P($P(@ZN@(0),U,3),"|",1) ; free txt drug from NVA
+	. . . . N Z2 S Z2=$P(C0PMEDS(C0PI,"SIG",1,0),"|",1) ; free txt from list
+	. . . . I Z1=Z2 S FOUND=1
+	. . . I FOUND=1 D  ; found the NVA subfile entry
+	. . . . S C0PMEDS(C0PI,"NVAIEN")=ZI ; NVA ien
+	. . . . ;S C0PMEDS(C0PI,"COMMENTS")=$G(@ZN@(1,1,0)) ; first line of comments
+	. . . . N ZC ; to store the comment wp field
+	. . . . N ZM S ZM=$$GET1^DIQ(55.05,ZI_","_C0PDFN,14,,"ZC")
+	. . . . M C0PMEDS(C0PI,"COMMENTS")=ZC ; the comments
+	. . . . ;N ZC S ZC=0
+	. . . . ;F  S ZC=$G(@ZN@(1,ZC)) Q:+ZC=0  D  ; pull out the comments
+	. . . . ;. S C0PMEDS(C0PI,"COMMENTS",ZC)=$G(@ZN@(1,ZC,0)) ;line of comment
+	. . . . ;M C0PMEDS(C0PI,"COMMENTS")=@ZN@(1) ; all the lines of comments
+	. . . E  D  ; ERROR .. THESE SHOULD MATCH. There is a bug.
+	. . . . D ERROR^C0PMAIN(",U113059007,",$ST($ST,"PLACE"),"ERX-NVA","Non-VA Meds Error") QUIT
+	QUIT
+DT(X)	; -- Returns FM date for X
+	N Y,%DT S %DT="T",Y="" D:X'="" ^%DT
+	Q Y
+	;
+MEDLIST(ZMLIST,ZDFN,ZPARMS,NOERX,SUMMARY)	; RETURNS THE MEDLIST FOR PATIENT DFN
+	; USES C0C PACKAGE ROUTINES TO PULL ALL MEDS FOR THE PATIENT
+	; IF NOERX=1 IT WILL FILTER OUT EPRESCRIBING MEDS FROM THE LIST
+	; SUMMARY IS PASSED BY NAME AND IS THE PLACE TO PUT A SUMMARY IF PROVIDED
+	N ZCCRT,ZCCRR
+	D INITXPF^C0PWS1("C0PF") ; SET FILE NUMBER AND PARAMATERS 
+	D GETTEMP^C0CMXP("ZCCRT","CCRMEDS","C0PF")
+	K ^TMP("C0CRIM","VARS",ZDFN) ; KILL RIM VARIABLES TO MAKE SURE THEY ARE FRESH
+	I '$D(ZPARMS) S ZPARMS="MEDALL"
+	D SET^C0CPARMS(ZPARMS) ; SET PARAMATER TO PULL ALL MEDS
+	I '$D(DEBUG) S DEBUG=0
+	D EXTRACT^C0CMED("ZCCRT",ZDFN,"ZCCRR")
+	M @ZMLIST=^TMP("C0CRIM","VARS",ZDFN,"MEDS")
+	I $G(SUMMARY)="" Q  ; NO SUMMARY NEEDED
+	S ZI=""
+	F  S ZI=$O(@ZMLIST@(ZI)) Q:ZI=""  D  ;
+	. S @SUMMARY@(ZI,"MED")=$G(@ZMLIST@(ZI,"MEDPRODUCTNAMETEXT"))
+	. ;W @SUMMARY@(ZI,"MED")
+	. S @SUMMARY@(ZI,"STATUS")=$G(@ZMLIST@(ZI,"MEDSTATUSTEXT"))
+	. S @SUMMARY@(ZI,"CODESYSTEM")=$G(@ZMLIST@(ZI,"MEDPRODUCTNAMECODINGINGSYSTEM"))
+	. S @SUMMARY@(ZI,"CODE")=$G(@ZMLIST@(ZI,"MEDPRODUCTNAMECODEVALUE"))
+	. S @SUMMARY@(ZI,"COMMENT")=$G(@ZMLIST@(ZI,"MEDFULLFILLMENTINSTRUCTIONS"))
+	Q
+	;
+ANALYZE(ZSTR,ZNUM)	; ANALYZE MED LISTS FOR ZNUM PATIENTS STARTING AT
+	; PATIENT ZSTR. IF ZSTR="" START WHERE WE LEFT OFF
+	; FIRST TIME, START WITH THE FIRST PATIENT
+	N C0PZI
+	I ZSTR="" D  ; WANT TO START WHERE WE LEFT OFF OR AT THE FIRST PATIENT
+	. S C0PZI=$G(^TMP("C0PAMED","LAST"))
+	. I C0PZI="" S C0PZI=0
+	. S C0PZI=$O(^DPT(C0PZI)) ; FIRST PATIENT TO DO
+	E  S C0PZI=ZSTR ; STARTING PATIENT IS SPECIFIED
+	N SUMM
+	N ZN S ZN=0
+	N DONE S DONE=0
+	F ZN=1:1:ZNUM Q:DONE  D  ; TRY AND DO ZNUM PATIENTS
+	. W !,"C0PZI=",C0PZI
+	. I +C0PZI=0 S DONE=1 Q  ; OUT OF PATIENTS
+	. S SUMM=$NA(^TMP("C0PAMED",C0PZI)) ; PLACE TO PUT SUMMARY
+	. W "SUMM ",SUMM
+	. K G ; MED LIST RETURN VARIABLE
+	. D MEDLIST("G",C0PZI,"MEDACTIVE",,SUMM) ; PULL THE MEDS FOR THIS PATIENT
+	. S ^TMP("C0PAMED","LAST")=C0PZI ; SAVE WHERE WE ARE
+	. S C0PZI=$O(^DPT(C0PZI)) ; NEXT PATIENT
+	Q
+	;
+RESET	; CLEAR OUT THE ANALYZE ARRAY
+	K ^TMP("C0PAMED")
+	Q
+	;
+INDEX	; INDEX THE ANALYSES
+	N ZI,ZJ
+	S (ZI,ZJ)=""
+	F  S ZI=$O(^TMP("C0PAMED",ZI)) Q:ZI=""  D  ;
+	. S ZJ=""
+	. F  S ZJ=$O(^TMP("C0PAMED",ZI,ZJ)) Q:ZJ=""  D  ;
+	. . N ZMED
+	. . S ZMED=$G(^TMP("C0PAMED",ZI,ZJ,"MED"))
+	. . I ZMED'="" S ^TMP("C0PAMED","MED",ZMED,ZI)=""
+	. . N ZCODE
+	. . S ZCODE=$G(^TMP("C0PAMED",ZI,ZJ,"CODE"))
+	. . I ZCODE'="" S ^TMP("C0PAMED","CODE",ZCODE,ZI)=""
+	D COUNT
+	Q
+	;
+COUNT	; COUNT THE MEDS AND THE CODES
+	N ZI,ZN S ZN=0
+	S ZI=""
+	F  S ZI=$O(^TMP("C0PAMED","MED",ZI)) Q:ZI=""  D  ;
+	. S ZN=ZN+1
+	W !,"MED COUNT: ",ZN
+	S ZN=0
+	S ZI=""
+	F  S ZI=$O(^TMP("C0PAMED","CODE",ZI)) Q:ZI=""  D  ;
+	. S ZN=ZN+1
+	W !,"CODE COUNT: ",ZN
+	Q
+	;
+	; NB: EP below not used in C0P 1.0 --smh 5/9/2012
+OUTSIDE(ZRTN,ZMEDS)	; WRAP THE MEDS IN THE OUTSIDEPRESRIPTION XML
+	; Here's what the xml looks like. It's stored in the Template field
+	; of the OUTSIDEPRESCRIPTION record in file C0P XML TEMPLATE file
+	;<OutsidePrescription>
+	; <externalId>@@PRESCRIPTIONID@@</externalId>
+	; <date>@@MEDDATE@@</date>
+	; <doctorName>@@DOCTORNAME@@</doctorName>
+	; <drug>@@MEDTEXT@@</drug>
+	; <dispenseNumber>@@DISPENSENUMBER@@</dispenseNumber>
+	; <sig>@@SIG@@</sig>
+	; <refillCount>@@REFILLCOUNT@@</refillCount>
+	; <prescriptionType>@@PRESCRIPTIONTYPE@@</prescriptionType>
+	;</OutsidePrescription>
+	N C0PZI,ZTEMP,C0PF
+	S C0PZI=""
+	D INITXPF^C0PWS1("C0PF") ; SET UP FILE POINTERS
+	D GETTEMP^C0CMXP("ZTEMP","OUTSIDEPRESCRIPTION","C0PF")
+	; BREAK
+	Q
Index: ePrescribing/trunk/p/C0PEREW.m
===================================================================
--- ePrescribing/trunk/p/C0PEREW.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PEREW.m	(revision 1595)
@@ -0,0 +1,164 @@
+C0PEREW	  ; eRx/GPL - ePrescription ewd utilities; 1/3/11
+	;;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
+	;
+test1(sessid)	;
+	d setSessionValue^%zewdAPI("testing","ZZ",sessid)
+	q 0
+	;
+cbTestMethod(prefix,seedValue,lastSeedValue,optionNo,options)	
+	;
+	n maxNo,noFound,dfn,dob,sex
+	;
+	s maxNo=50
+	s noFound=0
+	f  s seedValue=$o(^DPT("B",seedValue)) q:seedValue=""  q:noFound=maxNo  d
+	. s lastSeedValue=seedValue
+	. i prefix'="",$e(seedValue,1,$l(prefix))'=prefix q
+	. s optionNo=optionNo+1
+	. s noFound=noFound+1
+	. s options(optionNo)=seedValue
+	. s dfn=$o(^DPT("B",seedValue,"")) ; dfn of the patient
+	. s dob=$$GET1^DIQ(2,dfn,.03) ; date of birth
+	. s sex=$$GET1^DIQ(2,dfn,.02,"I") ; sex M or F
+	. s options(optionNo)=seedValue_"  "_dob_" "_sex ; complete patient
+	QUIT
+	;
+set1	;
+	s ^zewd("comboPlus","methodMap","test")="cbTestMethod^C0PEREW"
+	; THIS THE SHELL SCRIPT WHICH CREATED THE EWD PAGES IN THE C0P NAMESPACE
+	;cp ../w/ewdWLerxewdajaxerror.m C0PE001.m
+	;cp ../w/ewdWLerxewdajaxerrorredirect.m C0PE002.m
+	;cp ../w/ewdWLerxewderrorredirect.m C0PE003.m
+	;cp ../w/ewdWLerxindex1.m C0PE004.m
+	;cp ../w/ewdWLerxmatch.m C0PE005.m
+	;cp ../w/ewdWLerxnomatch.m C0PE006.m
+	; WE NEED TO ADD THIS CONFIGURATION ONE TIME TO ^zewd
+	;s ^zewd("routineMap","eRx","ewdajaxerror")="C0PE001"
+	;s ^zewd("routineMap","eRx","ewdajaxerrorredirect")="C0PE002"
+	;s ^zewd("routineMap","eRx","ewderrorredirect")="C0PE003"
+	;s ^zewd("routineMap","eRx","index1")="C0PE004"
+	;s ^zewd("routineMap","eRx","match")="C0PE005"
+	;s ^zewd("routineMap","eRx","nomatch")="C0PE006"
+	; unfortunately, the global map doesn't really work for now.. but
+	; we will keep trying in future releases
+	q
+	;
+INITSES(sessid)	; INITIALIZE AN EWD SESSION BY PULLING "VISTA" VARIABLES 
+	; INTO THE SESSION FROM WHERE THEY HAVE BEEN STORED. THEY ARE INDEXED
+	; BY A UNIQUE RANDOM TOKEN WHICH IS PASSED WITH THE URL
+	; FOR EXAMPLE https//example.com/ewd/myApp/index.ewd?token="12345"
+	N ZTOKEN,C0EARY
+	S ZTOKEN=$$URLTOKEN^C0CEWD(sessid) ; get the token passed on the url
+	D GET^C0CEWD("C0EARY",ZTOKEN,1) ; GET THE ARRAY OF VALUES
+	S C0EARY("TOKEN")=ZTOKEN
+	M ^TMP("GPL")=C0EARY
+	d mergeArrayToSession^%zewdAPI(.C0EARY,"VistA",sessid)
+	; ALL VISTA VARIABLES ARE IN THE "VistA" section of the session
+	Q
+	;
+INITREW(sessid)	; initialze the eRx Renewal Patient Matching screen
+	;
+	N C0PSES,ZDJ,ZDOB,ZSEX
+	D INITSES(sessid) ; add the VistA Variables to the session
+	D mergeArrayFromSession^%zewdAPI(.C0PSES,"VistA",sessid) ; get them back
+	N ZNAME,ZMED,ZSV
+	S ZNAME=$G(C0PSES("C0PRenewalName"))
+	I ZNAME="" Q "" ;OOPS
+	S ZDOB=$G(C0PSES("RenewalDOB")) ; date of birth
+	I ZDOB'="" S ZDOB=$E(ZDOB,5,6)_"/"_$E(ZDOB,7,8)_"/"_$E(ZDOB,1,4) ; REFORMAT
+	d setSessionValue^%zewdAPI("RenewalDOB",ZDOB,sessid) ; save in session
+	S ZSEX=$G(C0PSES("RenewalSex")) ; gender
+	d setSessionValue^%zewdAPI("RenewalSex",ZSEX,sessid) ; save in session
+	s ZNAME=ZNAME_"  "_ZDOB_" "_ZSEX ; ADD DOB AND SEX TO PATIENT NAME
+	d setSessionValue^%zewdAPI("C0PRenewalName",ZNAME,sessid) ;the whole name
+	d setSessionValue^%zewdAPI("pat4",$e(ZNAME,1,4),sessid) ;first part of name
+	S ZMED=$G(C0PSES("medication")) ; pull med from VistA part of session
+	d setSessionValue^%zewdAPI("medication",ZMED,sessid) ;the med
+	S ZDJ=$G(C0PSES("dollarJ")) ; job number of CPRS session
+	d setSessionValue^%zewdAPI("CPRSdollarJ",ZDJ,sessid) ; save in the session 
+	S ZSV=$G(C0PSES("SUPERVISING-DUZ")) ; supervising doctor DUZ
+	d setSessionValue^%zewdAPI("supervisor",ZSV,sessid) ; save 
+	d clearList^%zewdAPI("supervisor",sessid) ; make sure no list is there
+	M DUZ=C0PSES("DUZ") ; PASS LOG ON AUTHORITY
+	n svlist ; list of licensed prescribers
+	d SVLIST("svlist") ; generate the list
+	n zi,zn
+	s zi=""
+	f  s zi=$o(svlist(zi)) q:zi=""  d  ; for each licensed prescriber
+	. s zn=$o(svlist(zi,"")) ; DUZ of prescriber
+	. d appendToList^%zewdAPI("supervisor",zi,zn,sessid) ;add to list
+	Q ""
+	;
+MATCH(sessid)	; process submit after matching
+	S ^TMP("GPL","MATCH",sessid)=""
+	N ZRTN,ZNAME,ZDFN
+	S ZNAME=$$getSessionValue^%zewdAPI("patient",sessid) ; current match
+	S ZNAME=$P(ZNAME,"  ",1) ; GET JUST THE NAME - NOT DOB OR SEX
+	S ZDFN=$O(^DPT("B",ZNAME,""))
+	S ZRTN=""
+	I ZDFN="" S ZRTN="Please select a patient"
+	D setSessionValue^%zewdAPI("selectedDFN",ZDFN,sessid) ; record selection
+	Q ZRTN
+	;
+NOMATCH(sessid)	; process submit after matching
+	S ^TMP("GPL","NOMATCH",sessid)=""
+	Q ""
+	;
+MTCHPG(sessid)	; process the match clickthrough page
+	N GDFN,ZDJ
+	S GDFN=$$getSessionValue^%zewdAPI("selectedDFN",sessid) ; THE PATIENT SELECTED
+	S ZDJ=$$getSessionValue^%zewdAPI("CPRSdollarJ",sessid) ; CPRS job number
+	S ^TMP("C0E",ZDJ,"NEWDFN")=GDFN ; PASS THE NEW DFN TO CPRS
+	D BRSRDR(GDFN,sessid) ; GENERATE THE RENEWAL BROWSER REDIRECT PAGE
+	Q ""
+	;
+NOMTCHPG(sessid)	; process the nomatch clickthrough page
+	D BRSRDR(0,sessid) ; BOTH MATCH AND NOMATCH DO THE SAME THING FOR NOW
+	Q ""
+	;
+BRSRDR(ZDFN,sessid)	; GENERATE RENEWAL BROWSER REDIRCT HTML/XML TO CLICK THRU
+	; TO ERX RENEWAL
+	N ZISTR,ZDUZ,ZHTML,C0PSES
+	D mergeArrayFromSession^%zewdAPI(.C0PSES,"VistA",sessid) ; get SESSION VARS
+	S ZDUZ=$G(C0PSES("DUZ"))
+	M DUZ=C0PSES("DUZ") ; PASS LOG ON AUTHORITY
+	S ZISTR=$G(C0PSES("renewalToken"))
+	S C0PSPRV=$$getSessionValue^%zewdAPI("supervisor",sessid) ;supervisor selected
+	I C0PSPRV="" S C0PSVRV=$G(C0PSES("SUPERVISOR-DUZ")) ; SUPERVISING DOCTOR DUZ
+	D ALERTRPC^C0PCPRS1(.ZHTML,ZDUZ,ZDFN,1,ZISTR,1) ; CALL WITH MODE=1
+	d mergeArrayToSession^%zewdAPI(.ZHTML,"eRxRenew",sessid)
+	Q
+	;
+SVLIST(ZLIST)	; GENERATE A LIST OF LICENSED PRESCRIBERS FOR THE
+	; MIDLEVEL SUPERVISING DOCTOR PULLDOWN; ZLIST IS PASSED BY NAME
+	N ZI,ZA
+	S ZA=$NA(^VA(200,"C0P","ERX")) ; INDEX TO USE
+	S ZI=""
+	F  S ZI=$O(@ZA@(ZI)) Q:ZI=""  D  ; FOR EACH SUBSCRIBER
+	. N ZS
+	. D SETACCT^C0PSUB("ZS",ZI) ; GET SUBSCRIPTION INFO
+	. I $G(ZS("SUBSCRIBER-USERTYPE"))="LicensedPrescriber" D  ; USE IT
+	. . N ZN
+	. . S ZN=$$GET1^DIQ(200,ZI,.01,"E") ; NAME OF SUBSCRIBER
+	. . S @ZLIST@(ZN,ZI)="" ; RETURN THIS SUBSCRIBER
+	. K ZS
+	Q
+	;
Index: ePrescribing/trunk/p/C0PEWD1.m
===================================================================
--- ePrescribing/trunk/p/C0PEWD1.m	(revision 518)
+++ ePrescribing/trunk/p/C0PEWD1.m	(revision 1595)
@@ -1,90 +1,102 @@
-C0PEWD1   ; CCDCCR/GPL - ePrescription utilities; 12/6/08
- ;;0.1;CCDCCR;nopatch;noreleasedate
- ;Copyright 2008 WorldVistA.  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(filepath) ; filepath IS THE PATH/FILE TO BE READ IN
- i $g(^%ZISH)["" d  ; if the VistA Kernal routine %ZISH exists
- . n zfile,zpath,ztmp s (zfile,zpath,ztmp)=""
- . s zfile=$re($p($re(filepath),"/",1)) ;file name
- . s zpath=$p(filepath,zfile,1) ; file path
- . s ztmp=$na(^CacheTempEWD($j,0))
- . s ok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file incrementing subscr 2
- q
- ;
-TEST2 ;
- s zfilepath="/home/vademo2/CCR/PAT_780_CCR_V1_0_17.xml"
- ;s ok=$$gtmImportFile^%zewdHTMLParser(zfilepath)
- s ok=$$LOAD(zfilepath) ;load the XML file to the EWD global
- s ok=$$parseDocument^%zewdHTMLParser("DerekDOM",0)
- ;s ok=$$parseXMLFile^%zewdAPI(zfilepath,"fourthDOM")
- w ok,!
- q
- ;
-GPLTEST ;
- ;s ok=$$httpGET^%zewdGTM("http://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml",.gpl)
- s URL="https://trac.opensourcevista.net/CCD-CCR-Project/browser/ccr/tags/CCR_1_0_7/output"
- s ok=$$httpGET^%zewdGTM(URL,.gpl)
- S ZG=""
- F  S ZG=$O(gpl(ZG)) Q:ZG=""  D  ;
- . s gpl(ZG)=$$CLEAN^C0PEWDU(gpl(ZG)) ;
- . ;w gpl(ZG)
- m ^CacheTempEWD($j)=gpl
- b
- s ok=$$parseDocument^%zewdHTMLParser("gpl2",0)
- s ok=$$outputDOM^%zewdDOM("gpl2",1,1)
- Q
- ;
-GPLTEST2 ;
- s URL="https://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
- ;s URL="https://trac.opensourcevista.net/CCD-CCR-Project/browser/ccr/tags/CCR_1_0_7/output"
- s ok=$$httpGET^%zewdGTM(URL,.gpl)
- D INDEX^C0CXPATH("gpl","gpl2")
- S G=""
- F  S G=$O(gpl2(G)) Q:G=""  D  ;
- . W !,G," = ",gpl2(G)
- W !
- Q
- ;
-CLEAN(INX) ;DELETE NON-PRINTING CHARACTER IN INX, PASSED BY VALUE
- ;DON'T USE THIS -- IT DOESN'T WORK -- USE $$CLEAN^C0PEWDU
- ;N ZT,ZI
- S ZT=""
- F ZI=32:1:126 S ZT=ZT_$CHAR(ZI)
- S ZZ=$TR(INX,ZT)
- Q ZZ
- ;
-LOAD(filepath) ; load an xml file into the EWD global for DOM processing
- ; need to call s error=$$parseDocument^%zewdHTMLParser(docName,isHTML)
- ; after to process it to the DOM - isHTML=0 for XML files
- n i
- i $g(^%ZISH)["" d  QUIT i ; if VistA Kernal routine %ZISH exists - gpl 2/23/09
- . n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)=""
- . s zfile=$re($p($re(filepath),"/",1)) ;file name
- . s zpath=$p(filepath,zfile,1) ; file path
- . s ztmp=$na(^CacheTempEWD($j,0))
- . s zok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file increment subscr 2
- . s i=$o(^CacheTempEWD($j,""),-1) ; highest line number
- q i
- ;
-Q(ZQ,ZD) ; SEND QUERY ZQ TO DOM ZD AND DIPLAY NODES RETURNED
- I '$D(ZD) S ZD="DerekDOM"
- s error=$$select^%zewdXPath(ZQ,ZD,.nodes) ;
- d displayNodes^%zewdXPath(.nodes)
- q
- ;
+C0PEWD1	  ; CCDCCR/GPL - ePrescription utilities; 12/6/08 ; 5/8/12 3:57pm
+	;;1.0;C0P;;Apr 25, 2012;Build 103
+	;Copyright 2008 WorldVistA.  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
+	; THE FOLLOWING ROUTINES ARE EXPERIMENTS USED TO TEST HTTP CALLS FROM
+	; MUMPS USING EWD. NONE OF THE ROUTINES ARE USED FOR PROCESSING IN THE
+	; ERX PACKAGE. THEY ARE INCLUDED AND BROUGHT FORWARD FOR USE IN DEBUGGING
+	; AND FUTURE DEVELOPMENT
+	; GPL JUN 2010
+	;
+	;TEST(filepath) ; filepath IS THE PATH/FILE TO BE READ IN
+	i $g(^%ZISH)["" d  ; if the VistA Kernal routine %ZISH exists
+	. n zfile,zpath,ztmp s (zfile,zpath,ztmp)=""
+	. s zfile=$re($p($re(filepath),"/",1)) ;file name
+	. s zpath=$p(filepath,zfile,1) ; file path
+	. s ztmp=$na(^CacheTempEWD($j,0))
+	. s ok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file incrementing subscr 2
+	q
+	;
+TEST2	;
+	s zfilepath="/home/vademo2/CCR/PAT_780_CCR_V1_0_17.xml"
+	;s ok=$$gtmImportFile^%zewdHTMLParser(zfilepath)
+	s ok=$$LOAD(zfilepath) ;load the XML file to the EWD global
+	s ok=$$parseDocument^%zewdHTMLParser("DerekDOM",0)
+	;s ok=$$parseXMLFile^%zewdAPI(zfilepath,"fourthDOM")
+	w ok,!
+	q
+	;
+GPLTEST	;
+	;s ok=$$httpGET^%zewdGTM("http://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml",.gpl)
+	s URL="https://trac.opensourcevista.net/CCD-CCR-Project/browser/ccr/tags/CCR_1_0_7/output"
+	s ok=$$httpGET^%zewdGTM(URL,.gpl)
+	S ZG=""
+	F  S ZG=$O(gpl(ZG)) Q:ZG=""  D  ;
+	. s gpl(ZG)=$$CLEAN^C0PEWDU(gpl(ZG)) ;
+	. ;w gpl(ZG)
+	m ^CacheTempEWD($j)=gpl
+	; b
+	s ok=$$parseDocument^%zewdHTMLParser("gpl2",0)
+	s ok=$$outputDOM^%zewdDOM("gpl2",1,1)
+	Q
+	;
+GPLTEST2	;
+	s URL="https://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
+	;s URL="https://trac.opensourcevista.net/CCD-CCR-Project/browser/ccr/tags/CCR_1_0_7/output"
+	s ok=$$httpGET^%zewdGTM(URL,.gpl)
+	D INDEX^C0CXPATH("gpl","gpl2")
+	S G=""
+	F  S G=$O(gpl2(G)) Q:G=""  D  ;
+	. W !,G," = ",gpl2(G)
+	W !
+	Q
+	;
+CLEAN(INX)	;DELETE NON-PRINTING CHARACTER IN INX, PASSED BY VALUE
+	;DON'T USE THIS -- IT DOESN'T WORK -- USE $$CLEAN^C0PEWDU
+	;N ZT,ZI
+	S ZT=""
+	F ZI=32:1:126 S ZT=ZT_$CHAR(ZI)
+	S ZZ=$TR(INX,ZT)
+	Q ZZ
+	;
+LOAD(filepath)	; load an xml file into the EWD global for DOM processing
+	; need to call s error=$$parseDocument^%zewdHTMLParser(docName,isHTML)
+	; after to process it to the DOM - isHTML=0 for XML files
+	n i
+	i $g(^%ZISH)["" d  QUIT i ; if VistA Kernal routine %ZISH exists - gpl 2/23/09
+	. n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)=""
+	. s zfile=$re($p($re(filepath),"/",1)) ;file name
+	. s zpath=$p(filepath,zfile,1) ; file path
+	. s ztmp=$na(^CacheTempEWD($j,0))
+	. s zok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file increment subscr 2
+	. s i=$o(^CacheTempEWD($j,""),-1) ; highest line number
+	q i
+	;
+Q(ZQ,ZD)	; SEND QUERY ZQ TO DOM ZD AND DIPLAY NODES RETURNED
+	I '$D(ZD) S ZD="DerekDOM"
+	s error=$$select^%zewdXPath(ZQ,ZD,.nodes) ;
+	d displayNodes^%zewdXPath(.nodes)
+	q
+	;
+TEST1	
+	S url="https://ec2-75-101-247-83.compute-1.amazonaws.com:8181/ccr/CCRService?wsdl"
+	;S url="http://ec2-75-101-247-83.compute-1.amazonaws.com"
+	D GET1URL^C0PEWD2(url)
+	Q
+	;
Index: ePrescribing/trunk/p/C0PEWD2.m
===================================================================
--- ePrescribing/trunk/p/C0PEWD2.m	(revision 518)
+++ 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
+	;
Index: ePrescribing/trunk/p/C0PEWD3.m
===================================================================
--- ePrescribing/trunk/p/C0PEWD3.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PEWD3.m	(revision 1595)
@@ -0,0 +1,33 @@
+C0PEWD3   ; 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
+ ; THIS ROUTINE WAS USED TO GENERATE A TEST CASE FOR PROCESSING EMBEDDED
+ ; BASE 64 ENCODED XML MESSAGES FROM WEB SERVICE RESPONSES
+ ; THIS BASE 64 MESSAGE IS ACTUALLY A VALID XML FILE. THIS ROUTINE IS NOT
+ ; USE IN ERX PROCESSING. IT IS INCLUDED HERE FOR DEBUGGING PURPOSES AND
+ ; FOR FUTURE DEVELOPMENT
+ ; GPL JUN 2010
+ ;
+GETBIG ;TESTING BASE64 DECODING
+ ;;PD94bWwgdmVyc2lvbj0iMS4wIiBlbmNvZGluZz0iVVRGLTgiPz4KPD94bWwtc3R5bGVzaGVldCB0eXBlPSJ0ZXh0L3hzbCIgaHJlZj0iY2NyLnhzbCI/PgoKPENvbnRpbnVpdHlPZkNhcmVSZWNvcmQgeG1sbnM9InVybjphc3RtLW9yZzpDQ1IiPgogICAgPENDUkRvY3VtZW50T2JqZWN0SUQ+ODcxYmQ2MDUtZThmOC00YjgwLTk5MTgtNGIwM2Y3ODExMjllPC9DQ1JEb2N1bWVudE9iamVjdElEPgogICAgPExhbmd1YWdlPgogICAgICAgIDxUZXh0PkVuZ2xpc2g8L1RleHQ+CiAgICA8L0xhbmd1YWdlPgogICAgPFZlcnNpb24+VjEuMDwvVmVyc2lvbj4KICAgIDxEYXRlVGltZT4KICAgICAgICA8RXhhY3REYXRlVGltZT4yMDA5LTA5LTI5VDE1OjE5OjQyLTA1OjAwPC9FeGFjdERhdGVUaW1lPgogICAgPC9EYXRlVGltZT4KICAgIDxQYXRpZW50PgogICAgICAgIDxBY3RvcklEPkFDVE9SUEFUSUVOVF8yPC9BY3RvcklEPgogICAgPC9QYXRpZW50PgogICAgPEZyb20+CiAgICAgICAgPEFjdG9yTGluaz4KICAgICAgICAgICAgPEFjdG9ySUQ+QUNUT1JPUkdBTklaQVRJT05fNzY8L0FjdG9ySUQ+CiAgICAgICAgPC9BY3Rvckxpbms+CiAgICAgICAgPEFjdG9yTGluaz4KICAgICAgICAgICAgPEFjdG9ySUQ+QUNUT1JTWVNURU1fMTwvQWN0b3JJRD4KICAgICAgICA8L0FjdG9yTGluaz4KICAgIDwvRnJvbT4KICAgIDxUbz4KICAgICAgICA8QWN0b3JMaW5rPgogICAgICAgICAgICA8QWN0b3JJRD5BQ1RPUlBBVElFTlRfMjwvQWN0b3JJRD4KICAgICAgICAgICAgPEFjdG9yUm9sZT4KICAgICAgICAgICAgICAgIDxUZXh0PlBhdGllbnQ8L1RleHQ+CiAgICAgICAgICAgIDwvQWN0b3JSb2xlPgogICAgICAgIDwvQWN0b3JMaW5rPgogICAgPC9Ubz4KICAgIDxQdXJwb3NlPgogICAgICAgIDxEZXNjcmlwdGlvbj4KICAgICAgICAgICAgPFRleHQ+Q0VORCBQSFI8L1RleHQ+CiAgICAgICAgPC9EZXNjcmlwdGlvbj4KICAgIDwvUHVycG9zZT4KICAgIDxCb2R5PgogICAgICAgIDxQcm9ibGVtcz4KICAgICAgICAgICAgPFByb2JsZW0+CiAgICAgICAgICAgICAgICA8Q0NSRGF0YU9iamVjdElEPlBST0JMRU0xPC9DQ1JEYXRhT2JqZWN0SUQ+CiAgICAgICAgICAgICAgICA8VHlwZT4KICAgICAgICAgICAgICAgICAgICA8VGV4dD5Qcm9ibGVtPC9UZXh0PgogICAgICAgICAgICAgICAgPC9UeXBlPgogICAgICAgICAgICAgICAgPFN0YXR1cz4KICAgICAgICAgICAgICAgICAgICA8VGV4dD5BY3RpdmU8L1RleHQ+CiAgICAgICAgICAgICAgICA8L1N0YXR1cz4KICAgICAgICAgICAgICAgIDxEZXNjcmlwdGlvbj4KICAgICAgICAgICAgICAgICAgICA8VGV4dD5GYW1pbHkgSGlzdG9yeSBvZiBEaWFiZXRlcyBNZWxsaXR1cyAoSUNELTktQ00gVjE4LjApPC9UZXh0PgogICAgICAgICAgICAgICAgICAgIDxDb2RlPgogICAgICAgICAgICAgICAgICAgICAgICA8VmFsdWU+VjE4LjA8L1ZhbHVlPgogICAgICAgICAgICAgICAgICAgICAgICA8Q29kaW5nU3lzdGVtPklDRDlDTTwvQ29kaW5nU3lzdGVtPgogICAgICAgICAgICAgICAgICAgIDwvQ29kZT4KICAgICAgICAgICAgICAgIDwvRGVzY3JpcHRpb24+CiAgICAgICAgICAgICAgICA8RGF0ZVRpbWU+CiAgICAgICAgICAgICAgICAgICAgPEV4YWN0RGF0ZVRpbWU+MjAwNS0wNy0xOVQwMDowMDowMC0wNTowMDwvRXhhY3REYXRlVGltZT4KICAgICAgICAgICAgICAgIDwvRGF0ZVRpbWU+CiAgICAgICAgICAgICAgICA8U291cmNlPgogICAgICAgICAgICAgICAgICAgIDxBY3Rvcj4KICAgICAgICAgICAgICAgICAgICAgICAgPEFjdG9ySUQ+QUNUT1JQUk9WSURFUl8xMTwvQWN0b3JJRD4KICAgICAgICAgICAgICAgICAgICA8L0FjdG9yPgogICAgICAgICAgICAgICAgPC9Tb3VyY2U+CiAgICAgICAgICAgIDwvUHJvYmxlbT4KICAgICAgICAgICAgPFByb2JsZW0+CiAgICAgICAgICAgICAgICA8Q0NSRGF0YU9iamVjdElEPlBST0JMRU0yPC9DQ1JEYXRhT2JqZWN0SUQ+CiAgICAgICAgICAgICAgICA8VHlwZT4KICAgICAgICAgICAgICAgICAgICA8VGV4dD5Qcm9ibGVtPC9UZXh0PgogICAgICAgICAgICAgICAgPC9UeXBlPgogICAgICAgICAgICAgICAgPFN0YXR1cz4KICAgICAgICAgICAgICAgICAgICA8VGV4dD5BY3RpdmU8L1RleHQ+CiAgICAgICAgICAgICAgICA8L1N0YXR1cz4KICAgICAgICAgICAgICAgIDxEZXNjcmlwdGlvbj4KICAgICAgICAgICAgICAgICAgICA8VGV4dD5EaWFiZXRlcyBNZWxsaXR1cyB3aXRob3V0IG1lbnRpb24gb2YgQ29tcGxpY2F0aW9uLCB0eXBlIElJIG9yIHVuc3BlY2lmaWVkIHR5cGUsPC9UZXh0PgogICAgICAgICAgICAgICAgICAgIDxDb2RlPgogICAgICAgICAgICAgICAgICAgICAgICA8VmFsdWU+MjUwLjAyPC9WYWx1ZT4KICAgICAgICAgICAgICAgICAgICAgICAgPENvZGluZ1N5c3RlbT5JQ0Q5Q008L0NvZGluZ1N5c3RlbT4KICAgICAgICAgICAgICAgICAgICA8L0NvZGU+CiAgICAgICAgICAgICAgICA8L0Rlc2NyaXB0aW9uPgogICAgICAgICAgICAgICAgPERhdGVUaW1lPgogICAgICAgICAgICAgICAgICAgIDxFeGFjdERhdGVUaW1lPjIwMDUtMDctMTlUMDA6MDA6MDAtMDU6MDA8L0V4YWN0RGF0ZVRpbWU+CiAgICAgICAgICAgICAgICA8L0RhdGVUaW1lPgogICAgICAgICAgICAgICAgPFNvdXJjZT4KICAgICAgICAgICAgICAgICAgICA8QWN0b3I+CiAgICAgICAgICAgICAgICAgICAgICAgIDxBY3RvcklEPkFDVE9SUFJPVklERVJfMTE8L0FjdG9ySUQ+CiAgICAgICAgICAgICAgICAgICAgPC9BY3Rvcj4KICAgICAgICAgICAgICAgIDwvU291cmNlPgogICAgICAgICAgICA8L1Byb2JsZW0+CiAgICAgICAgICAgIDxQcm9ibGVtPgogICAgICAgICAgICAgICAgPENDUkRhdGFPYmplY3RJRD5QUk9CTEVNMzwvQ0NSRGF0YU9iamVjdElEPgogICAgICAgICAgICAgICAgPFR5cGU+CiAgICAgICAgICAgICAgICAgICAgPFRleHQ+UHJvYmxlbTwvVGV4dD4KICAgICAgICAgICAgICAgIDwvVHlwZT4KICAgICAgICAgICAgICAgIDxTdGF0dXM+CiAgICAgICAgICAgICAgICAgICAgPFRleHQ+QWN0aXZlPC9UZXh0PgogICAgICAgICAgICAgICAgPC9TdGF0dXM+CiAgICAgICAgICAgICAgICA8RGVzY3JpcHRpb24+CiAgICAgICAgICAgICAgICAgICAgPFRleHQ+TGVmdCBWZW50cmljdWxhciBIeXBlcnRyb3BoeTwvVGV4dD4KICAgICAgICAgICAgICAgICAgICA8Q29kZT4KICAgICAgICAgICAgICAgICAgICAgICAgPFZhbHVlPjc5OS45PC9WYWx1ZT4KICAgICAgICAgICAgICAgICAgICAgICAgPENvZGluZ1N5c3RlbT5JQ0Q5Q008L0NvZGluZ1N5c3RlbT4KICAgICAgICAgICAgICAgICAgICA8L0NvZGU+CiAgICAgICAgICAgICAgICA8L0Rlc2NyaXB0aW9uPgogICAgICAgICAgICAgICAgPERhdGVUaW1lPgogICAgICAgICAgICAgICAgICAgIDxFeGFjdERhdGVUaW1lPjIwMDUtMDctMjBUMDA6MDA6MDAtMDU6MDA8L0V4YWN0RGF0ZVRpbWU+CiAgICAgICAgICAgICAgICA8L0RhdGVUaW1lPgogICAgICAgICAgICAgICAgPFNvdXJjZT4KICAgICAgICAgICAgICAgICAgICA8QWN0b3I+CiAgICAgICAgICAgICAgICAgICAgICAgIDxBY3RvcklEPkFDVE9SUFJPVklERVJfNjA8L0FjdG9ySUQ+CiAgICAgICAgICAgICAgICAgICAgPC9BY3Rvcj4KICAgICAgICAgICAgICAgIDwvU291cmNlPgogICAgICAgICAgICA8L1Byb2JsZW0+CiAgICAgICAgPC9Qcm9ibGVtcz4KICAgICAgICA8QWxlcnRzPgogICAgICAgICAgICA8QWxlcnQ+CiAgICAgICAgICAgICAgICA8Q0NSRGF0YU9iamVjdElEPkFMRVJUMTwvQ0NSRGF0YU9iamVjdElEPgogICAgICAgICAgICAgICAgPFR5cGU+CiAgICAgICAgICAgICAgICAgICAgPFRleHQ+QWxsZXJneTwvVGV4dD4KICAgICAgICAgICAgICAgIDwvVHlwZT4KICAgICAgICAgICAgICAgIDxEZXNjcmlwdGlvbj4KICAgICAgICAgICAgICAgICAgICA8VGV4dD5QYXRpZW50IGhhcyBhbiBBTExFUkdJQyByZWFjdGlvbiB0byBQRUFOVVQgT0lMLjwvVGV4dD4KICAgICAgICAgICAgICAgICAgICA8Q29kZT4KICAgICAgICAgICAgICAgICAgICAgICAgPFZhbHVlPjQxODYzNDAwNTwvVmFsdWU+CiAgICAgICAgICAgICAgICAgICAgICAgIDxDb2RpbmdTeXN0ZW0+U05PTUVEIENUPC9Db2RpbmdTeXN0ZW0+CiAgICAgICAgICAgICAgICAgICAgPC9Db2RlPgogICAgICAgICAgICAgICAgPC9EZXNjcmlwdGlvbj4KICAgICAgICAgICAgICAgIDxEYXRlVGltZT4KICAgICAgICAgICAgICAgICAgICA8RXhhY3REYXRlVGltZT4yMDA1LTA3LTE5PC9FeGFjdERhdGVUaW1lPgogICAgICAgICAgICAgICAgPC9EYXRlVGltZT4KICAgICAgICAgICAgICAgIDxTb3VyY2U+CiAgICAgICAgICAgICAgICAgICAgPEFjdG9yPgogICAgICAgICAgICAgICAgICAgICAgICA8QWN0b3JJRD5BQ1RPUlBST1ZJREVSXzExPC9BY3RvcklEPgogICAgICAgICAgICAgICAgICAgIDwvQWN0b3I+CiAgICAgICAgICAgICAgICA8L1NvdXJjZT4KICAgICAgICAgICAgICAgIDxBZ2VudD4KICAgICAgICAgICAgICAgICAgICA8UHJvZHVjdHM+CiAgICAgICAgICAgICAgICAgICAgICAgIDxQcm9kdWN0PgogICAgICAgICAgICAgICAgICAgICAgICAgICAgPENDUkRhdGFPYmplY3RJRD5QUk9EVUNUXzEwNjwvQ0NSRGF0YU9iamVjdElEPgogICAgICAgICAgICAgICAgICAgICAgICAgICAgPFByb2R1Y3ROYW1lPgogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIDxUZXh0PlBFQU5VVCBPSUw8L1RleHQ+CiAgICAgICAgICAgICAgICAgICAgICAgICAgICA8L1Byb2R1Y3ROYW1lPgogICAgICAgICAgICAgICAgICAgICAgICA8L1Byb2R1Y3Q+CiAgICAgICAgICAgICAgICAgICAgPC9Qcm9kdWN0cz4KICAgICAgICAgICAgICAgIDwvQWdlbnQ+CiAgICAgICAgICAgICAgICA8UmVhY3Rpb24+CiAgICAgICAgICAgICAgICAgICAgPERlc2NyaXB0aW9uPgogICAgICAgICAgICAgICAgICAgICAgICA8VGV4dD5ISVZFUzwvVGV4dD4KICAgICAgICAgICAgICAgICAgICA8L0Rlc2NyaXB0aW9uPgogICAgICAgICAgICAgICAgPC9SZWFjdGlvbj4KICAgICAgICAgICAgPC9BbGVydD4KICAgICAgICA8L0FsZXJ0cz4KICAgIDwvQm9keT4KICAgIDxBY3RvcnM+CiAgICAgICAgPEFjdG9yPgogICAgICAgICAgICA8QWN0b3JPYmplY3RJRD5BQ1RPUk9SR0FOSVpBVElPTl83NjwvQWN0b3JPYmplY3RJRD4KICAgICAgICAgICAgPE9yZ2FuaXphdGlvbj4KICAgICAgICAgICAgICAgIDxOYW1lPlZPRSBPRkZJQ0UgSU5TVElUVVRJT04gT0xEPC9OYW1lPgogICAgICAgICAgICA8L09yZ2FuaXphdGlvbj4KICAgICAgICAgICAgPFNvdXJjZT4KICAgICAgICAgICAgICAgIDxBY3Rvcj4KICAgICAgICAgICAgICAgICAgICA8QWN0b3JJRD5BQ1RPUlNZU1RFTV8xPC9BY3RvcklEPgogICAgICAgICAgICAgICAgPC9BY3Rvcj4KICAgICAgICAgICAgPC9Tb3VyY2U+CiAgICAgICAgPC9BY3Rvcj4KICAgICAgICA8QWN0b3I+CiAgICAgICAgICAgIDxBY3Rvck9iamVjdElEPkFDVE9SUEFUSUVOVF8yPC9BY3Rvck9iamVjdElEPgogICAgICAgICAgICA8UGVyc29uPgogICAgICAgICAgICAgICAgPE5hbWU+CiAgICAgICAgICAgICAgICAgICAgPEN1cnJlbnROYW1lPgogICAgICAgICAgICAgICAgICAgICAgICA8R2l2ZW4+R0FMTE9XPC9HaXZlbj4KICAgICAgICAgICAgICAgICAgICAgICAgPEZhbWlseT5ZT1VOR0VSPC9GYW1pbHk+CiAgICAgICAgICAgICAgICAgICAgPC9DdXJyZW50TmFtZT4KICAgICAgICAgICAgICAgIDwvTmFtZT4KICAgICAgICAgICAgICAgIDxEYXRlT2ZCaXJ0aD4KICAgICAgICAgICAgICAgICAgICA8RXhhY3REYXRlVGltZT4xOTk5LTA2LTI3PC9FeGFjdERhdGVUaW1lPgogICAgICAgICAgICAgICAgPC9EYXRlT2ZCaXJ0aD4KICAgICAgICAgICAgICAgIDxHZW5kZXI+CiAgICAgICAgICAgICAgICAgICAgPFRleHQ+TUFMRTwvVGV4dD4KICAgICAgICAgICAgICAgICAgICA8Q29kZT4KICAgICAgICAgICAgICAgICAgICAgICAgPFZhbHVlPk1BTEU8L1ZhbHVlPgogICAgICAgICAgICAgICAgICAgICAgICA8Q29kaW5nU3lzdGVtPjIuMTYuODQwLjEuMTEzODgzLjUuMTwvQ29kaW5nU3lzdGVtPgogICAgICAgICAgICAgICAgICAgIDwvQ29kZT4KICAgICAgICAgICAgICAgIDwvR2VuZGVyPgogICAgICAgICAgICA8L1BlcnNvbj4KICAgICAgICAgICAgPEFkZHJlc3M+CiAgICAgICAgICAgICAgICA8VHlwZT4KICAgICAgICAgICAgICAgICAgICA8VGV4dD5Ib21lPC9UZXh0PgogICAgICAgICAgICAgICAgPC9UeXBlPgogICAgICAgICAgICAgICAgPExpbmUxPjEyMzQgU29tZXdoZXJlIExhbmU8L0xpbmUxPgogICAgICAgICAgICAgICAgPENpdHk+QUxUT048L0NpdHk+CiAgICAgICAgICAgICAgICA8U3RhdGU+S0FOU0FTPC9TdGF0ZT4KICAgICAgICAgICAgICAgIDxQb3N0YWxDb2RlPjY3NjIzPC9Qb3N0YWxDb2RlPgogICAgICAgICAgICA8L0FkZHJlc3M+CiAgICAgICAgICAgIDxUZWxlcGhvbmU+CiAgICAgICAgICAgICAgICA8VmFsdWU+ODg4LTU1NS0xMjEyPC9WYWx1ZT4KICAgICAgICAgICAgICAgIDxUeXBlPgogICAgICAgICAgICAgICAgICAgIDxUZXh0PlJlc2lkZW50aWFsIFRlbGVwaG9uZTwvVGV4dD4KICAgICAgICAgICAgICAgIDwvVHlwZT4KICAgICAgICAgICAgPC9UZWxlcGhvbmU+CiAgICAgICAgICAgIDxUZWxlcGhvbmU+CiAgICAgICAgICAgICAgICA8VmFsdWU+ODg4LTEyMS0xMjEyPC9WYWx1ZT4KICAgICAgICAgICAgICAgIDxUeXBlPgogICAgICAgICAgICAgICAgICAgIDxUZXh0PldvcmsgVGVsZXBob25lPC9UZXh0PgogICAgICAgICAgICAgICAgPC9UeXBlPgogICAgICAgICAgICA8L1RlbGVwaG9uZT4KICAgICAgICAgICAgPFNvdXJjZT4KICAgICAgICAgICAgICAgIDxBY3Rvcj4KICAgICAgICAgICAgICAgICAgICA8QWN0b3JJRD5BQ1RPUlBBVElFTlRfMjwvQWN0b3JJRD4KICAgICAgICAgICAgICAgIDwvQWN0b3I+CiAgICAgICAgICAgIDwvU291cmNlPgogICAgICAgIDwvQWN0b3I+CiAgICAgICAgPEFjdG9yPgogICAgICAgICAgICA8QWN0b3JPYmplY3RJRD5BQ1RPUlBST1ZJREVSXzExPC9BY3Rvck9iamVjdElEPgogICAgICAgICAgICA8UGVyc29uPgogICAgICAgICAgICAgICAgPE5hbWU+CiAgICAgICAgICAgICAgICAgICAgPEN1cnJlbnROYW1lPgogICAgICAgICAgICAgICAgICAgICAgICA8R2l2ZW4+T05FPC9HaXZlbj4KICAgICAgICAgICAgICAgICAgICAgICAgPEZhbWlseT5ET0NUT1I8L0ZhbWlseT4KICAgICAgICAgICAgICAgICAgICAgICAgPFRpdGxlPlBoeXNpY2lhbjwvVGl0bGU+CiAgICAgICAgICAgICAgICAgICAgPC9DdXJyZW50TmFtZT4KICAgICAgICAgICAgICAgIDwvTmFtZT4KICAgICAgICAgICAgPC9QZXJzb24+CiAgICAgICAgICAgIDxTcGVjaWFsdHk+CiAgICAgICAgICAgICAgICA8VGV4dD5BbGxvcGF0aGljIGFuZCBPc3Rlb3BhdGhpYyBQaHlzaWNpYW5zLUZhbWlseSBQcmFjdGljZTwvVGV4dD4KICAgICAgICAgICAgPC9TcGVjaWFsdHk+CiAgICAgICAgICAgIDxBZGRyZXNzPgogICAgICAgICAgICAgICAgPFR5cGU+CiAgICAgICAgICAgICAgICAgICAgPFRleHQ+V29yazwvVGV4dD4KICAgICAgICAgICAgICAgIDwvVHlwZT4KICAgICAgICAgICAgPC9BZGRyZXNzPgogICAgICAgICAgICA8U291cmNlPgogICAgICAgICAgICAgICAgPEFjdG9yPgogICAgICAgICAgICAgICAgICAgIDxBY3RvcklEPkFDVE9SU1lTVEVNXzE8L0FjdG9ySUQ+CiAgICAgICAgICAgICAgICA8L0FjdG9yPgogICAgICAgICAgICA8L1NvdXJjZT4KICAgICAgICA8L0FjdG9yPgogICAgICAgIDxBY3Rvcj4KICAgICAgICAgICAgPEFjdG9yT2JqZWN0SUQ+QUNUT1JQUk9WSURFUl82MDwvQWN0b3JPYmplY3RJRD4KICAgICAgICAgICAgPFBlcnNvbj4KICAgICAgICAgICAgICAgIDxOYW1lPgogICAgICAgICAgICAgICAgICAgIDxDdXJyZW50TmFtZT4KICAgICAgICAgICAgICAgICAgICAgICAgPEdpdmVuPlNJWDwvR2l2ZW4+CiAgICAgICAgICAgICAgICAgICAgICAgIDxGYW1pbHk+Q09PUkRJTkFUT1I8L0ZhbWlseT4KICAgICAgICAgICAgICAgICAgICAgICAgPFRpdGxlPkNMSU5JQ0FMIENPT1JESU5BVE9SPC9UaXRsZT4KICAgICAgICAgICAgICAgICAgICA8L0N1cnJlbnROYW1lPgogICAgICAgICAgICAgICAgPC9OYW1lPgogICAgICAgICAgICA8L1BlcnNvbj4KICAgICAgICAgICAgPFNwZWNpYWx0eT4KICAgICAgICAgICAgICAgIDxUZXh0PkFsbG9wYXRoaWMgYW5kIE9zdGVvcGF0aGljIFBoeXNpY2lhbnMtRmFtaWx5IFByYWN0aWNlPC9UZXh0PgogICAgICAgICAgICA8L1NwZWNpYWx0eT4KICAgICAgICAgICAgPEFkZHJlc3M+CiAgICAgICAgICAgICAgICA8VHlwZT4KICAgICAgICAgICAgICAgICAgICA8VGV4dD5Xb3JrPC9UZXh0PgogICAgICAgICAgICAgICAgPC9UeXBlPgogICAgICAgICAgICA8L0FkZHJlc3M+CiAgICAgICAgICAgIDxTb3VyY2U+CiAgICAgICAgICAgICAgICA8QWN0b3I+CiAgICAgICAgICAgICAgICAgICAgPEFjdG9ySUQ+QUNUT1JTWVNURU1fMTwvQWN0b3JJRD4KICAgICAgICAgICAgICAgIDwvQWN0b3I+CiAgICAgICAgICAgIDwvU291cmNlPgogICAgICAgIDwvQWN0b3I+CiAgICAgICAgPEFjdG9yPgogICAgICAgICAgICA8QWN0b3JPYmplY3RJRD5BQ1RPUlNZU1RFTV8xPC9BY3Rvck9iamVjdElEPgogICAgICAgICAgICA8SW5mb3JtYXRpb25TeXN0ZW0+CiAgICAgICAgICAgICAgICA8TmFtZT5Xb3JsZFZpc3RBIEVIUi9WT0U8L05hbWU+CiAgICAgICAgICAgICAgICA8VmVyc2lvbj4xLjA8L1ZlcnNpb24+CiAgICAgICAgICAgIDwvSW5mb3JtYXRpb25TeXN0ZW0+CiAgICAgICAgICAgIDxTb3VyY2U+CiAgICAgICAgICAgICAgICA8QWN0b3I+CiAgICAgICAgICAgICAgICAgICAgPEFjdG9ySUQ+QUNUT1JTWVNURU1fMTwvQWN0b3JJRD4KICAgICAgICAgICAgICAgIDwvQWN0b3I+CiAgICAgICAgICAgIDwvU291cmNlPgogICAgICAgIDwvQWN0b3I+CiAgICA8L0FjdG9ycz4KPC9Db250aW51aXR5T2ZDYXJlUmVjb3JkPgo="
+ W $L(GPLBIG)
+ Q
+ ;
+
Index: ePrescribing/trunk/p/C0PEWD4.m
===================================================================
--- ePrescribing/trunk/p/C0PEWD4.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PEWD4.m	(revision 1595)
@@ -0,0 +1,123 @@
+C0PEWD4	  ; CCDCCR/GPL - ePrescription utilities; 4/24/09 ; 5/8/12 10:23pm
+	;;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.
+gpltest	; experiment with sending a CCR to an ewd page
+	N ZI
+	S ZI=""
+	W "HELLO WORLD!",!
+	Q 1
+	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
+	;
Index: ePrescribing/trunk/p/C0PEWDU.m
===================================================================
--- ePrescribing/trunk/p/C0PEWDU.m	(revision 518)
+++ ePrescribing/trunk/p/C0PEWDU.m	(revision 1595)
@@ -1,34 +1,51 @@
-C0PEWDU	; WV/SMH - E-prescription utilities; Mar 3 2009
- ;;0.1;WV EPrescribing;;
- Q
- ;
-CLEAN(STR) ; extrinsic function; returns string
- ;; Removes all non printable characters from a string.
- ;; STR by Value
- N TR,I
- F I=0:1:31 S TR=$G(TR)_$C(I)
- S TR=TR_$C(127)
- QUIT $TR(STR,TR)
- ;
-GETSOAP(ENTRY,REQUEST,RESULT) ; XML SOAP Spec for NewCrop
- ;; Gets world processing field from Fileman for Parsing
- ;; ENTRY Input by Value
- ;; REQUEST XML Output by Reference
- ;; RESULT XML Output by Reference
- ;; Example call: D GETSOAP^C0PEWDU("DrugAllergyInteraction",.REQ,.RES)
- ;
- N OK,ERR,IEN,F  ; if call is okay, Error, IEN, File
- S F=175.101
- S IEN=$$FIND1^DIC(F,"","",ENTRY,"B")
- S OK=$$GET1^DIQ(F,IEN,2,"","REQUEST","ERR")
- I OK=""!($D(ERR)) S REQUEST=""
- ; M ^CacheTempEWD($j)=REQUEST
- ; K REQUEST
- ; S ok=$$parseDocument^%zewdHTMLParser("REQUEST",0)
- ; S ok=$$outputDOM^%zewdDOM("REQUEST",1,1)
- ; Q  ; remove later
- K OK,ERR
- S OK=$$GET1^DIQ(F,IEN,3,"","RESULT","ERR")
- I OK=""!($D(ERR)) S RESULT=""
- QUIT
- ;
+C0PEWDU	; WV/SMH - E-prescription utilities; Mar 3 2009 ; 5/4/12 4:25pm
+	;;1.0;C0P;;Apr 25, 2012;Build 103
+	;Copyright 2009 Sam Habiel.  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
+	;
+CLEAN(STR)	; extrinsic function; returns string
+	;; Removes all non printable characters from a string.
+	;; STR by Value
+	N TR,I
+	F I=0:1:31 S TR=$G(TR)_$C(I)
+	S TR=TR_$C(127)
+	QUIT $TR(STR,TR)
+	;
+GETSOAP(ENTRY,REQUEST,RESULT)	; XML SOAP Spec for NewCrop
+	;; Gets world processing field from Fileman for Parsing
+	;; ENTRY Input by Value
+	;; REQUEST XML Output by Reference
+	;; RESULT XML Output by Reference
+	;; Example call: D GETSOAP^C0PEWDU("DrugAllergyInteraction",.REQ,.RES)
+	;
+	N OK,ERR,IEN,F  ; if call is okay, Error, IEN, File
+	S F=175.101
+	S IEN=$$FIND1^DIC(F,"","",ENTRY,"B")
+	S OK=$$GET1^DIQ(F,IEN,2,"","REQUEST","ERR")
+	I OK=""!($D(ERR)) S REQUEST=""
+	; M ^CacheTempEWD($j)=REQUEST
+	; K REQUEST
+	; S ok=$$parseDocument^%zewdHTMLParser("REQUEST",0)
+	; S ok=$$outputDOM^%zewdDOM("REQUEST",1,1)
+	; Q  ; remove later
+	K OK,ERR
+	S OK=$$GET1^DIQ(F,IEN,3,"","RESULT","ERR")
+	I OK=""!($D(ERR)) S RESULT=""
+	QUIT
+	;
Index: ePrescribing/trunk/p/C0PKIDS.m
===================================================================
--- ePrescribing/trunk/p/C0PKIDS.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PKIDS.m	(revision 1595)
@@ -0,0 +1,349 @@
+C0PKIDS	; VEN/SMH - eRx KIDS Utilities ; 5/4/12 4:26pm
+	   ;;1.0;C0P;;Apr 25, 2012;Build 7
+	   ; (C) Sam Habiel 2012
+	      ; Licensed under GPL.
+	   ;
+	      ;Copyright 2012 Sam Habiel.  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.
+	      ;
+	   ; This routine contains utilities for KIDS distribution of E-Rx.
+	   ;
+	   ; PEPs:
+	   ; For RxNorm dist: RXNTRAN,RXNPOST
+	   ; For FDB files: FDBTRAN,FDBPOST
+	   ;
+	   ;
+ENV	; Environment Check
+	   ; If EWD version is less than 800, don't install
+	   I $$TRIM^XLFSTR($G(^%zewd("version")))<800 DO  QUIT
+	   . W "A recent version of EWD must be installed before installing ",!
+	   . W "e-Prescribing. Installation cannot continue.",!
+	   . S XPDQUIT=1
+	   ; Check if C0C 1.1 is installed
+	   QUIT
+POST	; Main Post Installation routine
+	   ;
+	   ; KIDS will file the modified RPs ORWPS COVER and ORWPS DETAIL
+	   ; KIDS will install the Mail Group ERX HELP DESK
+	   ;
+	   D MES^XPDUTL("Adding E-Prescribing RPCs to CPRS Broker Context")
+	   D REGNMSP("C0P","OR CPRS GUI CHART") ; Register C0P RPs to the Broker Context
+	   ;
+	   ; Add two alerts to the OE/RR Notifications file
+	   D MES^XPDUTL("Adding E-Prescribing Notifications to the OE/RR Notification File")
+	   ;
+	   N C0PFDA
+	   ; Entry 1                                                                   
+	   S C0PFDA(100.9,"?+1,",.001)=11305                       ; NUMBER            
+	   S C0PFDA(100.9,"?+1,",.01)="C0P ERX REFILL REQUEST"     ; NAME              
+	   ; .02 is not filled out, but triggered by the .01                           
+	   S C0PFDA(100.9,"?+1,",.03)="ERX REFILL REQUEST"         ; MESSAGE TEXT      
+	   S C0PFDA(100.9,"?+1,",.04)="PKG"                        ; MESSAGE TYPE      
+	   S C0PFDA(100.9,"?+1,",.05)="R"                          ; ACTION FLAG       
+	   S C0PFDA(100.9,"?+1,",.06)="RUN"                        ; ENTRY POINT       
+	   S C0PFDA(100.9,"?+1,",.07)="C0PREFIL"                   ; ROUTINE NAME      
+	   S C0PFDA(100.9,"?+1,",1.5)="OR"                         ; RELATED PACKAGE   
+	   S C0PFDA(100.9,"?+1,",4)="Used by the C0P eRx package for eRx Refill Requests"
+	   ;                                                                           
+	   ; Entry 2                                                                   
+	   S C0PFDA(100.9,"?+2,",.001)=11306                       ; NUMBER            
+	   S C0PFDA(100.9,"?+2,",.01)="C0P ERX INCOMPLETE ORDER"   ; NAME              
+	   ; .02 is not filled out, but triggered by the .01                           
+	   S C0PFDA(100.9,"?+2,",.03)="ERX INCOMPLETE ORDER"       ; MESSAGE TEXT      
+	   S C0PFDA(100.9,"?+2,",.04)="PKG"                        ; MESSAGE TYPE      
+	   S C0PFDA(100.9,"?+2,",.05)="R"                          ; ACTION FLAG       
+	   S C0PFDA(100.9,"?+2,",.06)="STATUS"                     ; ENTRY POINT       
+	   S C0PFDA(100.9,"?+2,",.07)="C0PREFIL"                   ; ROUTINE NAME      
+	   S C0PFDA(100.9,"?+2,",1.5)="OR"                         ; RELATED PACKAGE   
+	   S C0PFDA(100.9,"?+2,",4)="Used by the C0P eRx package for eRx Incomplete Order Alerts"
+	   ;                                                                           
+	   N C0PERR           ; Errors go here.                                                         
+	   D UPDATE^DIE("","C0PFDA","","C0PERR") ; no flags, FDA, ien_root, msg_root   
+	   ;
+	   ; ew ew ew I hate $Q... still don't understand it.
+	   I $D(C0PERR) D
+	   . D MES^XPDUTL("WARNING: Updating the OE/RR Notification file failed.")
+	   . S C0PERR=$Q(C0PERR)
+	   . F  S C0PERR=$Q(@C0PERR) Q:C0PERR=""  D MES^XPDUTL(C0PERR_": "_@C0PERR)
+	   ;
+	   ; Done with that; now add the x-ref to file 200 on the NPI field.
+	   ; Thank you to D ^DIKCBLD for writing this for me!
+	   ;
+	   D MES^XPDUTL("Adding NPI Cross Reference to New Person File")
+	   N C0PXR,C0PRES,C0POUT,C0PERR
+	   S C0PXR("FILE")=200
+	   S C0PXR("NAME")="C0PNPI"
+	   S C0PXR("TYPE")="R"
+	   S C0PXR("USE")="LS"
+	   S C0PXR("EXECUTION")="F"
+	   S C0PXR("ACTIVITY")="IR"
+	   S C0PXR("SHORT DESCR")="Regular index on NPI for eRx"
+	   S C0PXR("VAL",1)=41.99
+	   S C0PXR("VAL",1,"SUBSCRIPT")=1
+	   S C0PXR("VAL",1,"LENGTH")=30
+	   S C0PXR("VAL",1,"COLLATION")="F"
+	   D CREIXN^DDMOD(.C0PXR,"S",.C0PRES,"C0POUT","C0PERR")
+	   I $D(C0PERR) D MES^XPDUTL("NPI Cross-Reference Creation on File 200 failed")
+	   ;
+	   ; Ditto: Add the x-ref to file 50 on the PSNDF VA PRODUCT NAME ENTRY
+	   D MES^XPDUTL("Adding PSNDF VA PRODUCT NAME ENTRY xref to Drug File")
+	   N C0PXR,C0PRES,C0POUT,C0PERR
+	   S C0PXR("FILE")=50
+	   S C0PXR("NAME")="AC0P"
+	   S C0PXR("TYPE")="R"
+	   S C0PXR("USE")="S"
+	   S C0PXR("EXECUTION")="F"
+	   S C0PXR("ACTIVITY")="IR"
+	   S C0PXR("SHORT DESCR")="For eRx - a sort only index on the VAPRODUCT number"
+	   S C0PXR("DESCR",1)="This index is used for the VISTA e-Rx project. This index enables a "
+	   S C0PXR("DESCR",2)="programmer to search for a drug using the VA Product. This index will"
+	   S C0PXR("DESCR",3)="be used to match drugs received from the remote service to the local drug"
+	   S C0PXR("DESCR",4)="file. Drugs received using the remote service are received using RxNorm"
+	   S C0PXR("DESCR",5)="CUI or First Databank MEDID. Either one of those will be translated to a"
+	   S C0PXR("DESCR",6)="VUID, which is matched against the VA Product file, which then is matched"
+	   S C0PXR("DESCR",7)="to the local drug pointing to the VA Product. "
+	   S C0PXR("VAL",1)=22
+	   S C0PXR("VAL",1,"SUBSCRIPT")=1
+	   S C0PXR("VAL",1,"COLLATION")="F"
+	   D CREIXN^DDMOD(.C0PXR,"S",.C0PRES,"C0POUT","C0PERR")
+	   I $D(C0PERR) D MES^XPDUTL("PSNDF VA PRODUCT NAME ENTRY xref Creation failed")
+	   ;
+	   ; Add Free Txt Entry to Pharmacy Orderable Item
+	   ; Again... this time file the Free Text Drug into Pharmacy Orderablem Items
+	   ; if it isn't already there!
+	      D MES^XPDUTL("Adding Free Txt Entry to Pharmacy Orderable Item file")
+	      ;
+	   N PSEDITNM S PSEDITNM=1                      ; Fileman gatekeeper for adding entries
+	   N C0PFDA
+	   S C0PFDA(50.7,"?+1,",.01)="FREE TXT DRUG"    ; Name
+	   S C0PFDA(50.7,"?+1,",.02)=40                 ; DOSAGE FORM: MISCELANEOUS
+	   S C0PFDA(50.7,"?+1,",.04)=3110428            ; INACTIVE DATE: (any value would do!)
+	   ;
+	   N C0PERR           ; Errors go here.                                                         
+	   D UPDATE^DIE("","C0PFDA","","C0PERR") ; no flags, FDA, ien_root, msg_root   
+	   ;
+	   I $D(C0PERR) D
+	   . D MES^XPDUTL("Couldn't add FREE TXT DRUG to Pharmacy Orderable Item File")
+	   . S C0PERR=$Q(C0PERR)
+	   . F  S C0PERR=$Q(@C0PERR) Q:C0PERR=""  D MES^XPDUTL(C0PERR_": "_@C0PERR)
+	   ;
+	      D MES^XPDUTL("")
+	      D MES^XPDUTL("Remember to install the following patches: ")
+	      D MES^XPDUTL("They may be legally protected; see documentation on how to")
+	      D MES^XPDUTL("acquire them. Contact Geroge Lilly at glilly@glilly.net for questions")
+	      D MES^XPDUTL(" - C0P*1.0*1 -> New Crop WebServices Data")
+	      D MES^XPDUTL(" - C0P*1.0*2 -> RxNorm Data 2012-04 Release")
+	      D MES^XPDUTL(" - C0P*1.0*3 -> First Databank Data 2012-03 Release")
+	      D MES^XPDUTL("")
+	      D MES^XPDUTL("Make sure to set-up the following after installation: ")
+	      D MES^XPDUTL(" - Account Info in C0P WS ACCT")
+	      D MES^XPDUTL(" - Institution address fields in file 4")
+	      D MES^XPDUTL(" - Hospital Location E-Rx fields")
+	      D MES^XPDUTL(" - New Person E-Rx fields")
+	      D MES^XPDUTL(" - Mail users to mail group: ERX HELP DESK")
+	      D MES^XPDUTL(" - Schedule C0P ERX BATCH to run every 15 min using an eRx user")
+	      ;
+	   ; I think we are done!
+	   QUIT
+	   ; --> RxNorm Files
+RXNTRAN	; Transportation Routine for RxNorm Files, PEP
+	   M @XPDGREF@("C0P","RXN")=^C0P("RXN")
+	   QUIT
+RXNPOST	; Post Install Routine for RxNorm Files, PEP
+	   D MES^XPDUTL("Installing RxNorm Concepts File")
+	   K ^C0P("RXN")
+	   M ^C0P("RXN")=@XPDGREF@("C0P","RXN")
+	   QUIT
+	   ; <-- RxNorm Files
+	   ;
+	   ; --> FDB Files
+FDBTRAN	; Unified Transportation EP for FDB Files, PEP
+	   D FDBDTRAN,FDBATRAN,IMPTRAN ; Drugs, Allergies, Import Templates
+	   QUIT
+FDBPOST	; Unified Post Install Routine for FDB Files, PEP
+	   D FDBDPOST,FDBAPOST,IMPPOST ; Drugs, Allergies, Import Templates
+	   QUIT
+	   ; <-- FDB Files
+	   ; 
+	   ; Rest is private
+FDBDTRAN	   ; Transportation Routine for FDB Drug File, private
+	   M @XPDGREF@("C0P","FDBD")=^C0P("FDB")
+	   QUIT
+FDBDPOST	   ; Post Install Routine for FDB Drug File, private
+	   D MES^XPDUTL("Installing FDB Drug File")
+	   K ^C0P("FDB") ; Kill original file
+	   M ^C0P("FDB")=@XPDGREF@("C0P","FDBD") ; Merge from Global
+	   QUIT
+FDBATRAN	   ; Transportation Routine for FDB Allergies File, private
+	   M @XPDGREF@("C0P","FDBA")=^C0PALGY
+	   QUIT
+FDBAPOST	   ; Post Install Routine for FDB Allergies File, private
+	   D MES^XPDUTL("Installing FDB Allergy File")
+	   K ^C0PALGY ; Kill original file
+	   M ^C0PALGY=@XPDGREF@("C0P","FDBA") ; Merge from Global
+	   QUIT
+	   ;
+	   ; --> Import Templates
+IMPTRAN	; Transport Import Template for loading FDB files, private
+	   ;
+	   ; Get the IEN of the import templates to transport off...
+	   N FDBDIEN S FDBDIEN=$O(^DIST(.46,"B","C0P FDB TBLCOMPOSITEDRUG",""))
+	   N FDBAIEN S FDBAIEN=$O(^DIST(.46,"B","C0P FDB TBLCOMPOSITEALLERGY",""))
+	   ;
+	   ; Put in transport global, remove creator DUZ (can't guarantee in dest sys)
+	   M @XPDGREF@("C0P","IMPFDBD")=^DIST(.46,FDBDIEN) ; Get first template
+	   S $P(@XPDGREF@("C0P","IMPFDBD",0),U,5)="" ; Remove Creator
+	   M @XPDGREF@("C0P","IMPFDBA")=^DIST(.46,FDBAIEN) ; Get second template
+	   S $P(@XPDGREF@("C0P","IMPFDBA",0),U,5)="" ; Remove Creator
+	   ;
+	   QUIT
+	   ;
+IMPPOST	; Post init for Import Templates, private
+	   ; TODO: Before using as a general KIDS utility, this does not 
+	   ; check if the destination fields exist. Destination fields are 
+	   ; FREE TEXT fields in the Import Template.
+	   ;
+	   D MES^XPDUTL("Installing FDB Files' Import Templates")
+	   ; Part 1: Delete old entries if they already exist.
+	   ;
+	   ; Get IENs
+	   N FDBDIEN S FDBDIEN=$O(^DIST(.46,"B","C0P FDB TBLCOMPOSITEDRUG",""))
+	   N FDBAIEN S FDBAIEN=$O(^DIST(.46,"B","C0P FDB TBLCOMPOSITEALLERGY",""))
+	   ; 
+	   ; Kill off: Indexes first, then record. Lock before you do.
+	   N C0PNAME
+	   F C0PNAME="FDBDIEN","FDBAIEN" D  ; For each variable
+	   . I @C0PNAME D  ; If that entry is found (see $O above)
+	   . . L +^DIST(.46,@C0PNAME):0 ; Lock
+	   . . ; IX2: Fire all Kill x-refs for one record.
+	   . . N DIK,DA S DIK="^DIST(.46,",DA=@C0PNAME D IX2^DIK ; Kill Logic
+	   . . K ^DIST(.46,@C0PNAME) ; Remove record
+	   . . L -^DIST(.46,@C0PNAME) ; Unlock
+	   ;
+	   ; Part 2: Update New Entries into File
+	   ; Get next available IEN in Import Template File
+	   N LASTIEN S LASTIEN=$O(^DIST(.46," "),-1)          ; Last internal entry number in file
+	   ;
+	   N NEXTIEN S NEXTIEN=LASTIEN                        ; Use below... incrementer!
+	   ;
+	   ; Merge data into the next IEN for each of the refs in the transported global
+	   ; Block below gets next IEN available.
+	   ; Lock on ^DIST(.46,NEXTIEN) acquired below.
+	   F C0PNAME="IMPFDBD","IMPFDBA" DO
+	   . ;
+	   . ; Loop below to get an IEN for our new record number
+	   . N DONE ; control variable for mini loop below
+	   . F  D  Q:$G(DONE)  ; loop until done
+	   . . S NEXTIEN=NEXTIEN+1 ; Next IEN available, we guess
+	   . . L +^DIST(.46,NEXTIEN):0 ELSE  QUIT  ; Can we lock it? If not quit and try the next
+	   . . I $D(^DIST(.46,NEXTIEN)) L -^DIST(.46,NEXTIEN) QUIT  ; if we locked it, is it really empty? If not, unlock and try next
+	   . . S DONE=1 QUIT  ; ok. we are sure we got it. Tell the loop we are done.
+	   . ;
+	   . M ^DIST(.46,NEXTIEN)=@XPDGREF@("C0P",C0PNAME) ; Merge entry
+	   . ;
+	   . ; Fire off xrefs (IX1 fires SET for xrefs for one record)
+	   . N DIK,DA S DIK="^DIST(.46,",DA=NEXTIEN D IX1^DIK
+	   . ;
+	   . ; Update zero node
+	   . S $P(^DIST(.46,0),U,3)=NEXTIEN ; most recently assigned internal entry number
+	   . S $P(^DIST(.46,0),U,4)=NEXTIEN ; current total number of entries
+	   . ;
+	   . L -^DIST(.46,NEXTIEN) ; Unlock it
+	   QUIT
+	   ; <-- Import Templates
+	; 
+	; SMH: All Code below comes from FOIA RPMS from routine CIAURPC
+	; Written by Doug Martin.
+	;
+	; Register/unregister RPCs within a given namespace to a context
+REGNMSP(NMSP,CTX,DEL)	;EP
+	N RPC,IEN,LEN
+	S LEN=$L(NMSP),CTX=+$$GETOPT(CTX)
+	I $G(DEL) D
+	.S IEN=0
+	.F  S IEN=$O(^DIC(19,CTX,"RPC","B",IEN)) Q:'IEN  D
+	..I $E($G(^XWB(8994,IEN,0)),1,LEN)=NMSP,$$REGRPC(IEN,CTX,1)
+	E  D
+	.Q:LEN<2
+	.S RPC=NMSP
+	.F  D:$L(RPC)  S RPC=$O(^XWB(8994,"B",RPC)) Q:NMSP'=$E(RPC,1,LEN)
+	..F IEN=0:0 S IEN=$O(^XWB(8994,"B",RPC,IEN)) Q:'IEN  I $$REGRPC(IEN,.CTX)
+	Q
+	; Register/unregister an RPC to/from a context
+	; RPC = IEN or name of RPC
+	; CTX = IEN or name of context
+	; DEL = If nonzero, the RPC is unregistered (defaults to 0)
+	; Returns -1 if already registered; 0 if failed; 1 if succeeded
+REGRPC(RPC,CTX,DEL)	;EP
+	S RPC=+$$GETRPC(RPC)
+	Q $S(RPC<1:0,1:$$REGMULT(19.05,"RPC",RPC,.CTX,.DEL))
+	; Add/remove a context to/from the ITEM multiple of another context.
+REGCTX(SRC,DST,DEL)	;EP
+	S SRC=+$$GETOPT(SRC)
+	Q $S('SRC:0,1:$$REGMULT(19.01,10,SRC,.DST,.DEL))
+	; Add/delete an entry to/from a specified OPTION multiple.
+	; SFN = Subfile #
+	; NOD = Subnode for multiple
+	; ITM = Item IEN to add
+	; CTX = Option to add to
+	; DEL = Delete flag (optional)
+REGMULT(SFN,NOD,ITM,CTX,DEL)	;
+	N FDA,IEN
+	S CTX=+$$GETOPT(CTX)
+	S DEL=+$G(DEL)
+	S IEN=+$O(^DIC(19,CTX,NOD,"B",ITM,0))
+	Q:'IEN=DEL -1
+	K ^TMP("DIERR",$J)
+	I DEL S FDA(SFN,IEN_","_CTX_",",.01)="@"
+	E  S FDA(SFN,"+1,"_CTX_",",.01)=ITM
+	D UPDATE^DIE("","FDA")
+	S FDA='$D(^TMP("DIERR",$J)) K ^($J)
+	Q FDA
+	; Register a protocol to an extended action protocol
+	; Input: P-Parent protocol
+	;        C-Child protocol
+REGPROT(P,C,ERR)	;EP
+	N IENARY,PIEN,AIEN,FDA
+	D
+	.I '$L(P)!('$L(C)) S ERR="Missing input parameter" Q
+	.S IENARY(1)=$$FIND1^DIC(101,"","",P)
+	.S AIEN=$$FIND1^DIC(101,"","",C)
+	.I 'IENARY(1)!'AIEN S ERR="Unknown protocol name" Q
+	.S FDA(101.01,"?+2,"_IENARY(1)_",",.01)=AIEN
+	.D UPDATE^DIE("S","FDA","IENARY","ERR")
+	Q:$Q $G(ERR)=""
+	Q
+	; Remove nonexistent RPCs from context
+CLNRPC(CTX)	;EP
+	N IEN
+	S CTX=+$$GETOPT(CTX)
+	F IEN=0:0 S IEN=$O(^DIC(19,CTX,"RPC","B",IEN)) Q:'IEN  D:'$D(^XWB(8994,IEN)) REGRPC(IEN,CTX,1)
+	Q
+	; Return IEN of option
+GETOPT(X)	;EP
+	N Y
+	Q:X=+X X
+	S Y=$$FIND1^DIC(19,"","X",X)
+	W:'Y "Cannot find option "_X,!!
+	Q Y
+	; Return IEN of RPC
+GETRPC(X)	;EP
+	N Y
+	Q:X=+X X
+	S Y=$$FIND1^DIC(8994,"","X",X)
+	W:'Y "Cannot find RPC "_X,!!
+	Q Y
Index: ePrescribing/trunk/p/C0PLKUP.m
===================================================================
--- ePrescribing/trunk/p/C0PLKUP.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PLKUP.m	(revision 1595)
@@ -0,0 +1,191 @@
+C0PLKUP	; VEN/SMH - Extrinsics to map med numbers ; 5/8/12 4:09pm
+	;;1.0;C0P;;Apr 25, 2012;Build 103
+	;Copyright 2009 Sam Habiel.  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
+FDBFN()	Q 1130590010 ; First Databank Drugs file number
+RXNFN()	Q 1130590011.001 ; RxNorm Concepts file number
+FULLNAME(MEDID)	; $$ Public - Get FDB full name for the drug
+	; Used in Bulletin
+	; Input: MEDID By Value
+	; Output: Extrinsic
+	N C0PIEN S C0PIEN=$$FIND1^DIC($$FDBFN,"","QX",MEDID,"B")
+	Q $$GET1^DIQ($$FDBFN,C0PIEN,"MED MEDID DESC")
+GCN(MEDID)	; $$ Public - Get GCN given MEDID
+	; Input: MEDID by Value
+	; Output: Extrinsic
+	; MEDID is the .01 field in the First Databank Drug file
+	; GCN is the 1 field = Generic Code Number
+	; WS supplies MEDID in return. Need Generic Code Number to map to RxNorm.
+	N X,Y,DTOUT,DUOUT,DLAYGO,DIC
+	S DIC=$$FDBFN
+	S X=MEDID
+	S DIC(0)="OXZ" ; One entry only, Exact match, return zero node
+	D ^DIC
+	I Y<0 Q "" ; Failed match
+	Q $P(Y(0),U,2) ; GCN is 2nd piece of zero node
+	;
+RXNCUI(GCN)	; $$ Public - Get RxNorm CUI using GCN
+	; Input: GCN by Value
+	; Output: Extrinsic
+	; Seach GCN index for an exact match
+	; One match, quick lookup, Exact matching
+	N C0PIEN S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",GCN,"GCN")
+	Q $$GET1^DIQ($$RXNFN,C0PIEN,.01)
+	;
+VUID(RXNCUI)	; $$ Public - Get VUID(s) for given RXNCUI for Clinical Drug
+	; Input: RXNCUI by Value
+	; Output: Caret delimited extrinsic. Should not be more than 2 entries.
+	; @;4 means return IEN and VUID.
+	N C0POUT,C0PVUID
+	I '$D(^DIC($$RXNFN,0,"GL")) Q ""  ; RXNORM UMLS NOT INSTALLED
+	D FIND^DIC($$RXNFN,"","@;4","PXQ",RXNCUI,"","VUIDCD","","","C0POUT")
+	; Example output:
+	; SAM("DILIST",0)="2^*^0^"
+	; SAM("DILIST",0,"MAP")="IEN^4"
+	; SAM("DILIST",1,0)="112482^4010153"
+	; SAM("DILIST",2,0)="112484^4016607"
+	I +$G(C0POUT("DILIST",0))=0 Q ""  ; no matches
+	N I S I=0
+	F  S I=$O(C0POUT("DILIST",I)) Q:I=""  S C0PVUID=$G(C0PVUID)_$P(C0POUT("DILIST",I,0),U,2)_"^"
+	S C0PVUID=$E(C0PVUID,1,$L(C0PVUID)-1) ; remove trailing ^
+	Q C0PVUID
+VUID2(MEDID)	; $$ Public - Get VUID(s) for given MEDID
+	Q $$VUID($$RXNCUI($$GCN(MEDID)))
+VAPROD(VUID)	; $$ Public - Get VA Product IEN from VUID
+	; Input VUID by Value
+	; Output: Extrinsic
+	Q $$FIND1^DIC(50.68,"","QX",VUID,"AVUID")
+DRUG(VAPROD)	; $$ Public - Get Drug(s) using VA Product IEN
+	; Input: VA Product IEN By Value
+	; OUtput: Caret delimited extrinsic
+	N C0POUT,C0PDRUG
+	;D FIND^DIC(50,"","@;4","PXQ",VAPROD,"","C0PVAPROD","","","C0POUT")
+	;D FIND^DIC(50,"","@;4","PXQ",VAPROD,"","AC0P","","","C0POUT") ;GPL 7/10
+	I +VAPROD=0 Q 0 ;
+	I '$D(^PSDRUG("AC0P",VAPROD)) Q 0 ;W "AC0P cross reference error" Q 0 ;
+	;S C0PDRUG=$O(^PSDRUG("AC0P",VAPROD,"")) ;GPL ABOVE FIND DOESN'T WORK
+	N I S I=""
+	S C0PDRUG=""
+	F  S I=$O(^PSDRUG("AC0P",VAPROD,I)) Q:I=""  D  ;
+	. S C0PDRUG=C0PDRUG_I_"^"
+	S C0PDRUG=$E(C0PDRUG,1,$L(C0PDRUG)-1) ; remove trailing ^
+	Q C0PDRUG
+	; Example output:
+	; C0POUT("DILIST",0)="2^*^0^"
+	; C0POUT("DILIST",0,"MAP")="IEN^4"
+	; C0POUT("DILIST",1,0)="1512^"
+	; C0POUT("DILIST",2,0)="21632^"
+	; or
+	; C0POUT("DILIST",0)="0^*^0^"
+	; C0POUT("DILIST",0,"MAP")="IEN^4"
+	I +$G(C0POUT("DILIST",0))=0 Q ""  ; no matches
+	N I S I=0
+	F  S I=$O(C0POUT("DILIST",I)) Q:I=""  S C0PDRUG=$G(C0PDRUG)_$P(C0POUT("DILIST",I,0),U)_"^"
+	S C0PDRUG=$E(C0PDRUG,1,$L(C0PDRUG)-1) ; remove trailing ^
+	Q C0PDRUG
+DRUG2(MEDID)	; $$ Public - Get Drugs for a FDB MEDID
+	; Input: MEDID by Value
+	; Output: Caret delimited extrinsic
+	N OUT S OUT=""
+	N C0PDRUGS  ; tmp holding space for drugs
+	N C0PVUIDS S C0PVUIDS=$$VUID2(MEDID)
+	N C0PI
+	F C0PI=1:1:$L(C0PVUIDS,U) D  ; for each VUID
+	. N C0PVUID S C0PVUID=$P(C0PVUIDS,U,C0PI)
+	. N C0PVAPROD S C0PVAPROD=$$VAPROD(C0PVUID) ; get VA Product
+	. S C0PDRUGS=$$DRUG(C0PVAPROD)
+	. S:$L(C0PDRUGS) OUT=OUT_C0PDRUGS_"^"
+	S OUT=$E(OUT,1,$L(OUT)-1) ; rm trailing ^
+	Q OUT
+RXNCUI2(BASE)	; $$ Public - Get RxNorm CUI for FDB Ingredient/Base
+	; Input: BASE By Value
+	; Output: RxNorm CUI
+	N C0PIEN S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",BASE,"NDDFBASE")
+	Q $$GET1^DIQ($$RXNFN,C0PIEN,.01)
+VUIDIN(RXNCUI)	; $$ Public - Get VUID Ingredient for RxNorm CUI
+	; Input: RXNCUI By Value
+	; Output: VUID
+	N C0PIEN S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",RXNCUI,"VUIDIN")
+	Q $$GET1^DIQ($$RXNFN,C0PIEN,"CODE")
+VAGEN(VUID)	; $$ Public - Get VA Generic for VUID Ingredient
+	; Input: VUID By Value
+	; Output: IEN^VA Generic Name (i.e. .01 field value)
+	N C0PIEN S C0PIEN=$$FIND1^DIC(50.6,"","QX",VUID,"AVUID")
+	N C0P01 S C0P01=$$GET1^DIQ(50.6,C0PIEN,.01)
+	Q C0PIEN_"^"_C0P01
+VAGEN2(BASE)	; $$ Public - Get VA Generic for FDB Ingredient/Base
+	; Input: BASE By Value
+	; Output: IEN^VA Generic Name (i.e. .01 field value)
+	Q $$VAGEN($$VUIDIN($$RXNCUI2(BASE)))
+DRUGING(VUID)	; $$ Public - Get Drug Ingredient for VUID Ingredient
+	; Input: VUID By Value
+	; Output: IEN^Drug Ingredient Name (i.e. .01 field value)
+	N C0PIEN S C0PIEN=$$FIND1^DIC(50.416,"","QX",VUID,"AVUID")
+	N C0P01 S C0P01=$$GET1^DIQ(50.416,C0PIEN,.01)
+	Q C0PIEN_"^"_C0P01
+DRUGING2(BASE)	; $$ Public - Get Drug Ingredient for FDB Ingredient/Base
+	; Input: BASE By Value
+	; Output: IEN^Drug Ingredient Name (i.e. .01 field value)
+	Q $$DRUGING($$VUIDIN($$RXNCUI2(BASE)))
+RXNCUI3(VUID)	; $$ Public - Get RXNCUI for VUID (any VUID)
+	; Input: VUID By Value
+	; Output: RXNCUI
+	I $G(VUID)="" Q ""
+	N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",VUID,"VUID")
+	S C0PIEN=$O(^C0P("RXN","VUID",VUID,"")) ;GPL FIX FOR MULTIPLES
+	Q $$GET1^DIQ($$RXNFN,C0PIEN,.01)
+NDDFBASE(RXNCUI)	; $$ Public - Get NDDF Ingredient for RXNCUI
+	; Input: RXNCUI By Value
+	; Output: NDDF Base code
+	N C0PIEN S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",RXNCUI,"RNDDFBASE")
+	Q +$$GET1^DIQ($$RXNFN,C0PIEN,"CODE") ; strip leading zeros
+NDDFBAS2(VUID)	; $$ Public - Get NDDF Ingredient for VUID
+	; NB: WILL ONLY WORK IF VUID IS AN INGREDIENT VUID, NOT A CLINICAL DRUG
+	; Input: VUID By Value
+	; Output: NDDF Base code
+	Q $$NDDFBASE($$RXNCUI3(VUID))
+	;
+DRUGNAM(CURRENTMEDS,ZMED)	; EXTRINSIC WHICH RETURNS THE FULL NAME
+	; OF THE DRUG FROM CURRENTMEDS, PASSED BY REFERENCE
+	; ZMED IS THE NUMBER OF THE MED IN THE ARRAY
+	; IF THERE IS A DRUGID, IT IS USED TO LOOKUP THE NAME
+	; IF THERE IS NO DRUGID, IT IS A FREETEXT MED AND THE NAME IS
+	; PULLED FROM THE SIG, WHERE IS IT STORED WITH A "|" DELIMITER
+	N ZD
+	I $D(CURRENTMEDS(ZMED,"DRUG")) S ZD=$$FULLNAME(CURRENTMEDS(ZMED,"DRUG"))
+	E  D  ; pull the name from the first piece of the sig
+	. N ZDSIG
+	. S ZDSIG=$G(CURRENTMEDS(ZMED,"SIG",1,0))
+	.  S ZD=$P(ZDSIG,"|",1)
+	Q ZD
+	;
+CODES(MEDID)	; EXTRINSIC WHICH RETURNS A LINE OF CODES FOR THE MED
+	; FORMAT IS MEDID:XXX GCN:XXX RXNORM:XXX VUID:XXX DRUG:XXX
+	N ZL
+	S ZL="MEDID:"_MEDID_" "
+	N ZG S ZG=$$GCN(MEDID) ; GCN (GENERIC CONCEPT NUMBER)
+	S ZL=ZL_"GCN:"_ZG_" "
+	N ZR S ZR=$$RXNCUI(ZG) ; RXNORM CONCEPT ID
+	S ZL=ZL_"RXNORM:"_ZR_" "
+	N ZV S ZV=$$VUID(ZR) ; VUID (VA UNIVERSAL ID)
+	S ZL=ZL_"VUID:"_ZV_" "
+	N ZD S ZD=$$DRUG2(MEDID) ; VISTA DRUG FILE IEN
+	I ZD=0 S ZD=""
+	S ZL=ZL_"DRUG:"_ZD_" "
+	Q ZL
+	;
Index: ePrescribing/trunk/p/C0PLOAD.m
===================================================================
--- ePrescribing/trunk/p/C0PLOAD.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PLOAD.m	(revision 1595)
@@ -0,0 +1,222 @@
+C0PLOAD	; VEN/SMH - File Loading Utilties ; 5/8/12 4:53pm
+	;;1.0;C0P;;Apr 25, 2012;Build 103
+	; (C) Sam Habiel 2012
+	;
+	;Copyright 2012 Sam Habiel.  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.
+	   ; The routine contains utilities for Reading Files from 
+	   ; RxNorm and FDB into Fileman files
+	   ; 
+	   ; This is a pretty pretty alpha version. Right now it just has FDB.
+	   ;
+	   ; These files definitions will be existing already. They should
+	   ; be installed as part of the KIDS build containing this routine.
+	   ;
+	   ; The import templates will be also part of KIDS. They should
+	   ; already exist by the time you run this routine.
+	   ; 
+	   ; The drug file is produced by importing a table called 'tblCompositeDrugs' 
+	   ; provided in an access database from NewCrop accessed using parameter 
+	   ; '1' for desiredData from this webservice: 
+	   ; http://preproduction.newcropaccounts.com/V7/WebServices/Update1.asmx?op=GetMostRecentDownloadUrl 
+	   ;
+	   ; The webservice provides a URL to a zip file; when unzipped, it produces an
+	   ; access database with tables for allergies, drugs, pharamcies, healthplans, and
+	   ; diagnoses.  
+	   ; 
+	   ; The following command (from mdb-tools) was used to extract this into an RRF
+	   ; format (i.e. '|' delimited).| 
+	   ;  
+	   ;  mdb-sql -HFp -d'|' -i selecttblCompositeDrug.sql  NCFull-200910.mdb > Drug.rrf 
+	   ;
+	   ; The SQL was necessary to skip a word-processing field which I couldn't import
+	   ; into fileman using the fileman import tool (this is simply a technical
+	   ; restriction; if I hand wrote my import I could have used a word processing
+	   ; field and used WP^DIE to file it.) That's field's name is 'etc'.  
+	        
+	   ; The SQL statement is as follows: SELECT MEDID, GCN_SEQNO, MED_NAME_ID, 
+	   ; MED_NAME, MED_ROUTED_MED_ID_DESC, MED_ROUTED_DF_MED_ID_DESC, MED_MEDID_DESC, 
+	   ; MED_STATUS_CD, MED_ROUTE_ID, ROUTED_MED_ID, ROUTED_DOSAGE_FORM_MED_ID, 
+	   ; MED_STRENGTH, MED_STRENGTH_UOM, MED_ROUTE_ABBR, MED_ROUTE_DESC, 
+	   ; MED_DOSAGE_FORM_ABBR, MED_DOSAGE_FORM_DESC, GenericDrugName, 
+	   ; DosageFormOverride, MED_REF_DEA_CD, MED_REF_DEA_CD_DESC, 
+	   ; MED_REF_MULTI_SOURCE_CD, MED_REF_MULTI_SOURCE_CD_DESC, 
+	   ; MED_REF_GEN_DRUG_NAME_CD, MED_REF_GEN_DRUG_NAME_CD_DESC, 
+	   ; MED_REF_FED_LEGEND_IND, MED_REF_FED_LEGEND_IND_DESC, GENERIC_MEDID, 
+	   ; MED_NAME_TYPE_CD, GENERIC_MED_REF_GEN_DRUG_NAME_CD, MED_NAME_SOURCE_CD, 
+	   ; DrugInfo, GenericDrugNameOverride, FormularyDrugID, Manufacturer, Status, 
+	   ; TouchDate, DrugTypeID FROM tblCompositeDrug 
+	   ; 
+	   ; The allergies file is produced by importing the tblCompositeAllergy file
+	   ;
+	   ; Here's the mdb command to extract the file.
+	   ; mdb-export -HQ -d "|" NCFull-201203.mdb tblCompositeAllergy > tblCompositeAllergy.rrf
+	   ; 
+	   ; There is no SQL here.
+	   ;
+	   ; Once you have both files, you can adjust the routine to where the files are
+	   ; and then import them by calling the PEPs below.
+	   ;
+	   ; Update: I wrote a bash script to automate this: it's called:
+	   ;   drug_data_extract.sh
+	   ;
+FDBIMP	 ; FDB Drug File Import; PEP. Interactive (for now).
+	   ;
+	   ;
+	   N FILEPATH
+	   R "Enter RRF FDB Drug File with Full Path: ",FILEPATH:60,!
+	   I '$L(FILEPATH) QUIT
+	   ;
+	   ; NB: The following will only work on Unix
+	   N PATH,FILE
+	   N PIECES S PIECES=$L(FILEPATH,"/")
+	   S PATH=$P(FILEPATH,"/",1,PIECES-1)
+	   S FILE=$P(FILEPATH,"/",PIECES)
+	   ;
+	   ; Kill off the existing file
+	   N %1 S %1=^C0P("FDB",0)    ; save zero node
+	   S $P(%1,"^",3,4)=""        ; zero last record numbers
+	   K ^C0P("FDB")              ; kill file
+	   S ^C0P("FDB",0)=%1         ; restore zero node
+	   ;
+	   ; Import File from text extract (Please I want an ODBC driver!)
+	   ; 
+	   D CLEAN^DILF
+	   N CONTROL
+	   S CONTROL("FLAGS")="E"  ; External Values...
+	   S CONTROL("MSGS")=""   ; go as normal in ^TMP("DIERR",$J)
+	   S CONTROL("MAXERR")="100" ; abort if you can't file a hundred records
+	   ; S CONTROL("IOP")="HOME"    ; Send to home device ; smh - don't pass; API no like for HOME output
+	   S CONTROL("QTIME")=""  ; Don't Queue
+	   N SOURCE
+	   S SOURCE("FILE")=FILE               ; File Name
+	   S SOURCE("PATH")=PATH               ; Directory
+	   N FORMAT
+	   S FORMAT("FDELIM")="|"                 ; Delimiter
+	   S FORMAT("FIXED")=""                   ; Fixed Width?
+	   S FORMAT("QUOTED")=""                  ; Are strings quoted?
+	   ;
+	   D FILE^DDMP(1130590010,"[C0P FDB TBLCOMPOSITEDRUG]",.CONTROL,.SOURCE,.FORMAT)
+	   QUIT
+	   ;
+FDBAIMP	; FDB Allergies Import; PEP. Interactive (for now)
+	   ; 
+	   ; 
+	   N FILEPATH
+	   R "Enter RRF FDB Allergy File with Full Path: ",FILEPATH:60,!
+	   I '$L(FILEPATH) QUIT
+	   ;
+	   ; NB: The following will only work on Unix
+	   N PATH,FILE
+	   N PIECES S PIECES=$L(FILEPATH,"/")
+	   S PATH=$P(FILEPATH,"/",1,PIECES-1)
+	   S FILE=$P(FILEPATH,"/",PIECES)
+	   ; 
+	   ; Kill off the existing file
+	   N %1 S %1=^C0PALGY(0)  ; save zero node
+	   S $P(%1,"^",3,4)=""    ; zero last record numbers
+	   K ^C0PALGY             ; kill file
+	   S ^C0PALGY(0)=%1       ; restore zero node
+	   ;
+	   ; Import file from text extract
+	   D CLEAN^DILF
+	   N CONTROL
+	   S CONTROL("FLAGS")="E"  ; External Values...
+	   S CONTROL("MSGS")=""   ; go as normal in ^TMP("DIERR",$J)
+	   S CONTROL("MAXERR")="100" ; abort if you can't file a hundred records
+	   ; S CONTROL("IOP")="HOME"    ; Send to home device ; smh - don't pass; API no like for HOME output
+	   S CONTROL("QTIME")=""  ; Don't Queue
+	   N SOURCE
+	   S SOURCE("FILE")=FILE                   ; File Name
+	   S SOURCE("PATH")=PATH                   ; Directory
+	   N FORMAT
+	   S FORMAT("FDELIM")="|"                 ; Delimiter
+	   S FORMAT("FIXED")=""                   ; Fixed Width?
+	   S FORMAT("QUOTED")=""                  ; Are strings quoted?
+	   ;
+	   D FILE^DDMP(113059005,"[C0P FDB TBLCOMPOSITEALLERGY]",.CONTROL,.SOURCE,.FORMAT)
+	   QUIT
+RXNIMP	; Import RxNorm Concepts File; Modded from C0CRXNRD
+	   N FILEPATH
+	   R "Enter RRF RxNorm Conepts File with Full Path: ",FILEPATH:60,!
+	   I '$L(FILEPATH) QUIT
+	   ;
+	   ; NB: The following will only work on Unix
+	   N PATH,FILE
+	   N PIECES S PIECES=$L(FILEPATH,"/")
+	   S PATH=$P(FILEPATH,"/",1,PIECES-1)
+	   S FILE=$P(FILEPATH,"/",PIECES)
+	   ;
+	   N LINES S LINES=$$GETLINES(PATH,FILE)
+	   D OPEN^%ZISH("FILE",PATH,FILE,"R")
+	   ;
+	   IF POP D EN^DDIOL("Error reading file..., Please check...") G EX
+	   ;
+	   N %1 S %1=^C0P("RXN",0)
+	   S $P(%1,"^",3,4)=""
+	   K ^C0P("RXN")
+	   S ^C0P("RXN",0)=%1
+	   ; 
+	   N C0CCOUNT
+	   F C0CCOUNT=1:1 D  Q:$$STATUS^%ZISH
+	   . U IO
+	   . N LINE R LINE:1
+	   . IF $$STATUS^%ZISH QUIT
+	   . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
+	   . N RXCUI,RXAUI,SAB,TTY,CODE,STR  ; Fileman fields numbers below
+	   . S RXCUI=$P(LINE,"|",1)    ; .01
+	   . S RXAUI=$P(LINE,"|",8)    ; 1
+	   . S SAB=$P(LINE,"|",12) ; 2
+	   . ;
+	   . ; Following lines not applicable here:
+	   . ; If the source is a restricted source, decide what to do based on what's asked.
+	   . ; N SRCIEN S SRCIEN=$$FIND1^DIC(176.003,"","QX",SAB,"B") ; SrcIEN in RXNORM SOURCES file
+	   . ; N RESTRIC S RESTRIC=$$GET1^DIQ(176.003,SRCIEN,14,"I") ; 14 is restriction field; values 0-4
+	   . ; If RESTRIC is zero, then it's unrestricted. Everything else is restricted.
+	   . ; If user didn't ask to include restricted sources, and the source is restricted, then quit
+	   . ; I 'INCRES,RESTRIC QUIT
+	   . ;
+	   . S TTY=$P(LINE,"|",13) ; 3
+	   . S CODE=$P(LINE,"|",14)    ; 4
+	   . S STR=$P(LINE,"|",15) ; 5
+	   . ; Remove embedded "^"
+	   . S STR=$TR(STR,"^")
+	   . ; Convert STR into an array of 80 characters on each line
+	   . N STRLINE S STRLINE=$L(STR)\80+1
+	   . ; In each line, chop 80 characters off, reset STR to be the rest
+	   . N J F J=1:1:STRLINE S STR(J)=$E(STR,1,80) S STR=$E(STR,81,$L(STR))
+	   . ; Now, construct the FDA array
+	   . N RXNFDA
+	   . S RXNFDA(1130590011.001,"+1,",.01)=RXCUI
+	   . S RXNFDA(1130590011.001,"+1,",1)=RXAUI
+	   . S RXNFDA(1130590011.001,"+1,",2)=SAB
+	   . S RXNFDA(1130590011.001,"+1,",3)=TTY
+	   . S RXNFDA(1130590011.001,"+1,",4)=CODE
+	   . N RXNIEN S RXNIEN(1)=C0CCOUNT
+	   . D UPDATE^DIE("","RXNFDA","RXNIEN")
+	   . I $D(^TMP("DIERR",$J)) D EN^DDIOL("ERROR") G EX
+	   . ; Now, file WP field STR
+	   . D WP^DIE(1130590011.001,C0CCOUNT_",",5,,$NA(STR))
+EX	 D CLOSE^%ZISH("FILE")
+	   QUIT
+GETLINES(PATH,FILENAME)	; Get number of lines in a file
+	   D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
+	   U IO
+	   N I
+	   F I=1:1 R LINE:1 Q:$$STATUS^%ZISH
+	   D CLOSE^%ZISH("FILE")
+	   Q I-1
Index: ePrescribing/trunk/p/C0PMAIN.m
===================================================================
--- ePrescribing/trunk/p/C0PMAIN.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PMAIN.m	(revision 1595)
@@ -0,0 +1,211 @@
+C0PMAIN	  ; ERX/GPL - Web Service main entry points; 9/24/09 ; 5/8/12 10:28pm
+	;;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
+ACCOUNTF()	 Q 113059002  ; file number for account file
+F200C0P()	Q 200.113059 ; Subfile number of C0P Subscription Multiple
+WSFILE()	Q 113059003 ; file number for web service file
+WSROLEF()	Q 113059003.04 ; Subfile for web service role map
+	;
+EN(RTNXML,RTNURL,C0PDUZ,C0PDFN,TID,C0PVOR,WALGY)	; ERX Entry PEP ; Public
+	; IF WALGY=1, FREE FORM ALLERGIES WILL BE ADDED
+	; RETURNS THE XML PORTION OF THE RPC RESPONSE
+	; IN RTNXML, PASSED BY NAME 
+	; TODO: What's RTNURL used for? it's not referenced in the rest of the routine.
+	; C0PVOR IS A VARIABLE OVERRIDE ARRAY WITH IS APPLIED BEFORE MAPPING
+	;
+	; ERXSERVIEN is ERX Service IEN in Subfile C0P in file 200
+	D SETACCT^C0PSUB("C0PVARS",C0PDUZ) ; INITIALIZE SUBSCRIBER VARIABLES
+	I ERXSERVIEN="" Q  ; PERSON NOT SUBSCRIBED
+	;D SETUP() ; INITIALIZE SERVICE AND ACCOUNT VARIABLES
+	;S C0PROLE=$$GET1^DIQ($$F200C0P(),ERXSERVIEN_","_C0PDUZ_",",4,"I")
+	;I C0PROLE="" S C0PROLE="P" ; DEFAULT TO PRESCRIBER ROLE
+	; ROLE MAPPING TO TEMPLATE ID IS FOUND IN THE WEB SERVICE FILE
+	;N ROLEIEN S ROLEIEN=$O(^C0PW(C0PWS,5,"B",C0PROLE,"")) ; IEN OF ROLE MAP
+	;I '$D(TID) S TID=$$GET1^DIQ($$WSROLEF(),ROLEIEN_","_C0PWS_",",1,"I") ;
+	I '$D(TID) D  ; SET TEMPLATE ACCORDING TO USER TYPE
+	. I C0PROLE="D" S TID="ORDER" ; DEFAULT FOR PRESCRIBER
+	. I C0PROLE="M" S TID="STAFF" ; DEFAULT FOR MANAGER
+	. I C0PROLE="A" S TID="STAFF" ; DEFAULT FOR ADMIN
+	. I C0PROLE="N" S TID="NURSE" ; DEFAULT FOR MIDLEVEL
+	. I C0PTYPE="M" S TID="MIDLEVEL" ; DEFAULT FOR MIDLEVEL
+	. I C0PTYPE="P" S TID="ORDER" ; OVERRIDE FOR PRESCRIBERS
+	. I '$D(TID) S TID="ORDER" ; ALL OTHERS
+	I TID="STAFF" S WALGY=0 ; DON'T SEND ALLERGIES WITH STAFF TEMPLATE
+	N UTID ;TID TO USE
+	I +TID=0 D  ; IF A TEMPLATE NAME WAS PASSED INSTEAD OF AN IEN
+	. S UTID=$$RESTID^C0PWS1(C0PDUZ,TID) ;RESOLVE TEMPLATE IEN FROM NAME
+	E  S UTID=TID ;
+	D EN^C0PSUB("C0PVARS",C0PDUZ) ;INITIALIZE SUBSCRIBER VARIABLES
+	I TID="MIDLEVEL" D  ; FOR MIDLEVELS
+	. I $G(C0PRMODE)="" Q  ; NOT RENEWAL MODE 
+	. ; IN RENEWAL MODE, THE SUPERVISING DOCTOR IS FOUND IN C0PSUPERV
+	. ;N G
+	. I $G(C0PSPRV)="" S C0PSPRV=$G(C0PVARS("SUPERVISING-DOCTOR-DUZ"))
+	. I C0PSPRV="" Q  ; SUPERVISING DOCTOR IS NOT SET FOR THIS MIDLEVEL
+	. D EN^C0PSUB("G",$G(C0PSPRV)) ; GET VARS FOR SUPERVISOR
+	. S C0PVARS("SUPERVISING-NPI")=$G(G("SUBSCRIBER-NPI"))
+	. S C0PVARS("SUPERVISING-DEA")=$G(G("SUBSCRIBER-DEA"))
+	. S C0PVARS("SUPERVISING-SID")=$G(G("SUBSCRIBER-SID"))
+	. S C0PVARS("SUPERVISING-FAMILY-NAME")=$G(G("SUBCRIBER-FAMILY-NAME"))
+	. S C0PVARS("SUPERVISING-GIVEN-NAME")=$G(G("SUBCRIBER-GIVEN-NAME"))
+	. S C0PVARS("SUPERVISING-LICENSE")=$G(G("SUBSCRIBER-LICENSE"))
+	. S C0PVARS("SUPERVISING-LICENSE-STATE")=$G(G("SUBSCRIBER-LICENSE-STATE"))
+	. ;K G
+	I $D(C0PDFN) D EN^C0PPAT("C0PVARS",C0PDFN) ;INITIALIZE PATIENT VARIABLES
+	I $G(C0PVOR)'="" M C0PVARS=@C0PVOR ; VARIABLE OVERRIDES APPLIED HERE
+	N C0PXP ; NEW XPATH ARRAY
+	D BIND("C0PXP","C0PVARS",UTID) ; BIND TO VARIABLES
+	N ZZZXML S ZZZXML=RTNXML ; SYMBOL TABLE PROBLEMS
+	K @RTNXML ; MAKE SURE WE HAVE A CLEAN SLATE 
+	D MAP(ZZZXML,"C0PXP",UTID) ; MAP VARIABLE TO TEMPLATE
+	I TID="MIDLEVEL" D  ; FOR MIDLEVELS
+	. I $G(C0PRMODE)=1 Q  ; IN RENEWAL MODE 
+	. D DELETE^C0CXPATH(ZZZXML,"//NCScript/SupervisingDoctor") ;only for rew
+	. ;D REPLACE^C0CXPATH(ZZZXML,"","//NCScript/SupervisingDoctor") ;only for rew
+	I $G(WALGY)=1 D  ; ADD ALLERGIES AND SENDMEDS FOR CLICKTHROUGH
+	. D ADDALGY^C0PALGY3(ZZZXML,C0PDUZ,C0PDFN) ;ADD ALLERGIES 
+	. N ZSMEDS ; SEND MEDS
+	. D FREETXT^C0PSMEDS("ZSMEDS",C0PDUZ,C0PDFN) ; GET MEDS TO SEND
+	. I +$D(ZSMEDS)'=0 D ADD^C0PSMEDS(ZZZXML,"ZSMEDS") ; ADD TO NCSCRIPT
+	N TRIMI,J,DONE S DONE=0
+	F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
+	. S J=$$TRIM^C0CXPATH(RTNXML) ; DELETE EMPTY ELEMENTS
+	. I DEBUG W "TRIMMED",J,!
+	. I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
+	K @RTNXML@(0) ;GET RID OF LINE COUNT
+	Q
+	;
+SETUP()	;INITIALIZE SERVICE AND ACCOUNT VARIABLE
+	;I '$D(C0PDUZ) S C0PDUZ=$O(^VA(200,"B","BATCH,ERX","")) ; DUZ OF BATCH USER
+	I '$D(C0PDUZ) S C0PDUZ=DUZ ; smh per gpl on 5/3/2012
+	;N ERXSERVIEN 
+	S ERXSERVIEN=$$SUBINIT^C0PSUB(C0PDUZ)
+	I ERXSERVIEN="" D ERROR(",U113059001,",$ST($ST,"PLACE"),"ERX-NOSUB","Provider Not Subscribed") Q  ;
+	; . ;W "ERROR, PROVIDER NOT SUBSCRIBED",! ;
+	; . ;S $EC=",U C0P ERROR - PROVIDER NOT SUBSCRIBED,"
+	; . ;S $EC=",U840201001," ;  
+	; N C0PVARS ; ARRAY TO HOLD CONTEXT VARIABLES FOR BINDING
+	S C0PACCT=$$GET1^DIQ($$F200C0P(),ERXSERVIEN_","_C0PDUZ_",",1,"I")
+	S C0PLOC=$$GET1^DIQ($$F200C0P(),ERXSERVIEN_","_C0PDUZ_",",2,"I")
+	S C0PWS=$$GET1^DIQ($$ACCOUNTF(),C0PACCT_",",4,"I") ; WEB SERVICE POINTER
+	Q
+	;
+PRIMARY()	; EXTRINSIC WHICH RETURNS PRIMARY ERX SUBSCRIBER DUZ
+	D SETUP() ; SET ACCOUNT VARIABLES
+	N C0PPRI
+	S C0PPRI=$$GET1^DIQ($$ACCOUNTF(),C0PACCT_",",6,"I") ; DUZ OF PRIMARY
+	Q C0PPRI ; RETURN DUZ
+	;
+WSURL(ZACCT)	; EXTRINSIC TO RETURN THE URL TO USE FOR WEB SERVICES
+	; IT WILL DETERMINE WHETHER THE PRODUCTION SWITCH IS ON IN THE
+	; ACCOUNT FILE AND IF YES RETURN THE PRODUCTION URL
+	; IF NOT RETURN THE PREPRODUCTION TEST URL
+	N ZR,ZP,ZT
+	S ZP=$$GET1^DIQ(113059002,ZACCT_",",7,"I") ; PRODUCTION FLAG
+	I ZP="P" D  ; PRODUCTION FLAG SET
+	. S ZT=$O(^C0PX("B","PRODUCTION WS URL","")) ; PRODUCION TEMPLATE
+	. S ZR=$$GET1^DIQ(113059001,ZT_",",1) ; URL FIELD
+	E  D  ; PRODUCTION FLAG NOT SET
+	. S ZT=$O(^C0PX("B","TEST WS URL","")) ; TEST TEMPLATE
+	. S ZR=$$GET1^DIQ(113059001,ZT_",",1) ; URL FIELD
+	Q ZR
+	;
+CTURL(ZACCT)	; EXTRINSIC TO RETURN THE URL TO USE FOR CLICKTHROUGH
+	; IT WILL DETERMINE WHETHER THE PRODUCTION SWITCH IS ON IN THE
+	; ACCOUNT FILE AND IF YES RETURN THE PRODUCTION URL
+	; IF NOT RETURN THE PREPRODUCTION TEST URL
+	N ZR,ZP,ZT
+	S ZP=$$GET1^DIQ(113059002,ZACCT_",",7,"I") ; PRODUCTION FLAG
+	I ZP="P" D  ; PRODUCTION FLAG SET
+	. S ZT=$O(^C0PX("B","PRODUCTION CLICKTHROUGH URL","")) ; PRODUCION TEMPLATE
+	. S ZR=$$GET1^DIQ(113059001,ZT_",",1) ; URL FIELD
+	E  D  ; PRODUCTION FLAG NOT SET
+	. S ZT=$O(^C0PX("B","TEST CLICKTHROUGH URL","")) ; TEST TEMPLATE
+	. S ZR=$$GET1^DIQ(113059001,ZT_",",1) ; URL FIELD
+	Q ZR
+	;
+MAP(RARY,IVARS,TPTR)	;RETURNS MAPPED XML IN RARY PASSED BY NAME
+	; IVARS IS AN XPATH ARRAY PASSED BY NAME
+	; TPTR IS A POINT TO THE C0P XML TEMPLATE FILE USED TO RETRIEVE THE TEMPLATE
+	;
+	N ZT ;THE TEMPLATE
+	K ZT,@RARY
+	I $$GET1^DIQ(113059001,TPTR_",",3,,"ZT")'="ZT" D  Q  ; ERROR GETTING TEMPLATE
+	. W "ERROR RETRIEVING TEMPLATE",!
+	D MAP^C0CXPATH("ZT",IVARS,RARY) ;DO THE MAPPING
+	Q
+	;
+BIND(RARY,IVARS,TPTR)	;RETURNS AN XPATH ARRAY IN RARY FOR USE WITH MAP
+	; TO BUILD AN INSTANTIATED TEMPLATE
+	; TPTR IS THE IEN OF THE XML TEMPATE IN THE C0P XML TEMPLATE FILE
+	; LOOPS THROUGHT THE BINDING SUBFILE TO PULL OUT XPATHS AND 
+	; EITHER ASSIGNS VARIABLES OR DOES A FILEMAN CALL TO GET VALUES
+	; VARIABLES ARE IN IVARS WHICH IS PASSED BY NAME
+	S C0PBF=113059001.04 ; BINDING SUBFILE NUMBER
+	N ZI
+	S ZI=""
+	F  S ZI=$O(^C0PX(TPTR,5,"B",ZI)) Q:ZI=""  D  ; FOR EACH XPATH
+	. N ZIEN,ZFILE,ZFIELD,ZVAR,ZIDX,ZINDEX ;
+	. S ZIEN=$O(^C0PX(TPTR,5,"B",ZI,"")) ;IEN OF THE BINDING RECORD
+	. S ZFILE=$$GET1^DIQ(C0PBF,ZIEN_","_TPTR_",",1.1,"I")
+	. S ZFIELD=$$GET1^DIQ(C0PBF,ZIEN_","_TPTR_",",1.2,"I")
+	. S ZVAR=$$GET1^DIQ(C0PBF,ZIEN_","_TPTR_",",2,"E")
+	. S ZIDX=$$GET1^DIQ(C0PBF,ZIEN_","_TPTR_",",.05,"I")
+	. S ZINDEX=""
+	. I ZIDX="DUZ" S ZINDEX=C0PDUZ ; FILE IS INDEXED BY DUZ
+	. I ZIDX="DFN" S ZINDEX=C0PDFN ; BY DFN
+	. I ZIDX="ACCT" S ZINDEX=C0PACCT ; BY ACCOUNT RECORD POINT TO C0P WS ACCT
+	. I ZIDX="LOC" S ZINDEX=C0PLOC ; BY LOCATION
+	. I ZVAR'="" D  ; VARIABLES TAKE PRESCIDENCE OVER FILEMAN FIELDS
+	. . S @RARY@(ZI)=$G(@IVARS@(ZVAR)) ; 
+	. E  D  ; IF NO VARIABLE, TRY ACCESSING FROM FILEMAN
+	. . I (ZFILE="")!(ZFIELD="") Q  ;QUIT IF FILE OR FIELD NOT THERE
+	. . D CLEAN^DILF
+	. . S @RARY@(ZI)=$$GET1^DIQ(ZFILE,ZINDEX_",",ZFIELD) ;GET THE VALUE
+	. . I $D(^TMP("DIERR",$J,1)) D ERROR^C0PMAIN(",U113059006,",$ST($ST,"PLACE"),"ERX-DATA-NOTFOUND","Data Not Found.") QUIT
+	Q
+	;
+BLDXML(ARTN,AWS,TNAME)	; RETURNS AN XML ARRAY IN ARTN PASSED BY NAME ; AWS IS AN ENTRY IN THE C0P WEB SERVICE FILE, EXTERNAL FORMAT
+	; TNAME IS AN ENTRY IN THE C0P XML TEMPLATE FILE WHICH BELONG TO THE AWS
+	; IT IS ASSUMED THAT THE WS CONTEXT IS ESTABLISHED AND ALL VARIABLES
+	; NEEDED BY THE BINDINGS IN THE XML TEMPLATE ARE INITIALIZED
+	Q
+	;
+UPDIE	  ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+	K ZERR
+	D CLEAN^DILF
+	D UPDATE^DIE("","C0PFDA","","ZERR")
+	I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
+	K C0PFDA
+	Q
+	;
+ERROR(EC,PLACE,ID,MSG)	; Private Proc - Set $EC for an error condition; 
+	; Errors the process and rolls back the stack by Invoking current error trap by setting $ECODE.
+	;Params: 
+	; EC - Error Code in ,Uxxx, syntax
+	; PLACE - Place where the error happened
+	; ID - Error ID
+	; MSG - Human understandable message
+	S %ZTERR=EC
+	S %ZTERR("PLACE")=PLACE
+	S %ZTERR("ID")=ID
+	S %ZTERR("MSG")=MSG
+	S $EC=EC
+	QUIT
Index: ePrescribing/trunk/p/C0PNVA.m
===================================================================
--- ePrescribing/trunk/p/C0PNVA.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PNVA.m	(revision 1595)
@@ -0,0 +1,135 @@
+C0PNVA	; VEN/SMH - Non-VA Meds Utilities for e-Rx ; 5/8/12 4:32pm
+	;;1.0;C0P;;Apr 25, 2012;Build 103
+	;Copyright 2009 Sam Habiel.  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
+	;
+FILE(C0PDFN,OR,DRUG,DOSAGE,ROUTE,SCHEDULE,START,C0PDUZ,COMMENT)	; Private Proc - File NVA
+	; Input:
+	; - C0PDFN: Patient DFN
+	; - OR: Pharmacy Orderable Item IEN
+	; - DRUG: Drug IEN
+	; - DOSAGE: Free Text Dosage
+	; - ROUTE: Free Text Route
+	; - SCHEDULE: Free Text Schedule
+	; - START: Start date in Timson Format
+	; - C0PDUZ: Provider documenting NVA DUZ
+	; - COMMENT: Free Text Comment
+	; NOTE: Right now, does nothing to file in CPRS order file.
+	;
+	D CLEAN^DILF ; Kill DIERR etc
+	; First Create parent file entry if it already doesn't exist
+	; 
+	; We will handle the case where there are subfile entries but no
+	; zero node defined for the record. First, check to see if there is 
+	; anything there at all for this patient
+	;
+	N C0PEXIT S C0PEXIT=0 ; in case of errors
+	I '$D(^PS(55,C0PDFN)) D  Q:C0PEXIT  ; if nothing is there for this patient
+	. N C0PFDAPT
+	. N C0PPTIEN S C0PPTIEN(1)=C0PDFN ; bug? in Update-doesn't honor DINUM
+	. S C0PFDAPT(55,"+1,",.01)=C0PDFN
+	. D UPDATE^DIE("","C0PFDAPT","C0PPTIEN")
+	. I $G(DIERR) D ^%ZTER,CLEAN^DILF S C0PEXIT=1 Q  ; log error and signal q
+	E  I '$D(^PS(55,C0PDFN,0)) D  ; is there something there but not a zero node?
+	. S ^PS(55,C0PDFN,0)=C0PDFN ; set the zero node
+	. N DIK,DA
+	. S DIK="^PS(55,"
+	. S DA=C0PDFN
+	. S DIK(1)=".01"
+	. D EN^DIK ; cross reference the .01 field
+	;
+	N C0PFDA
+	N C0PIENS ; Return value of IEN in the NVA multiple in file 55
+	;
+	; gpl. first, create the NVA subfile if none exists
+	; these lines were copied from PSONVNEW, which creates non-VA meds
+	N ZIEN ; CREATING A NEW ENTRY, THE FIRST FOR THIS PATIENT
+	I '$D(^PS(55,C0PDFN,"NVA",0)) D  ; NO NVA SUBFILE
+	. S DFN=C0PDFN
+	. S DA(1)=DFN
+	. S X=OR
+	. S DR="1////"_DRUG
+	. S DIC("DR")=DR,DIC(0)="L",DIC="^PS(55,"_DFN_",""NVA"",",DLAYGO=55.05
+	. D FILE^DICN S ZIEN=+Y K DR,DIC,DD,DA,DO,DINUM
+	. ; I don't know why the following doesn't work
+	. ;S C0PFDA(55.05,"+1,"_C0PDFN_",",.01)=OR
+	. ;D UPDATE^DIE("","C0PFDA","C0PIENS")
+	. ;I $G(DIERR) D ^%ZTER QUIT  ; log error if update fails
+	. ;E  D  ; find the ien of the subfile
+	. S ZIEN=$O(^PS(55,C0PDFN,"NVA","B",OR,""))
+	. I ZIEN="" S ZIEN=1
+	. ;
+	. S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",.01)=OR
+	. S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",1)=DRUG
+	. S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",2)=$E(DOSAGE,1,80) ; 80 char max
+	. S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",3)=$E(ROUTE,1,40)
+	. S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",4)=$E(SCHEDULE,1,50)
+	. S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",8)=START ; Start Date
+	. S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",11)=$$NOW^XLFDT()  ; Documentated Date
+	. S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",12)=C0PDUZ
+	. ;
+	. D UPDATE^DIE("","C0PFDA","C0PIENS")
+	. I $G(DIERR) D ^%ZTER QUIT  ; log error if update fails
+	. ;
+	. D CLEAN^DILF ; Kill DIERR etc.
+	. ; File WP field
+	. N C0PWP ; comment is multi line
+	. M C0PWP=COMMENT
+	. ;D WP^DIE(55.05,C0PIENS(1)_","_C0PDFN_",",14,"","C0PWP")
+	. D WP^DIE(55.05,C0PIENS(ZIEN)_","_C0PDFN_",",14,"","C0PWP")
+	. I $G(DIERR) D ^%ZTER QUIT  ; log error if wp filling fails.
+	E  D  ; CREATING A NEW ENTRY, NOT THE FIRST
+	. S ZIEN=1 ; GOING TO USE +1 CONVENTION
+	. S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",.01)=OR
+	. S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",1)=DRUG
+	. S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",2)=$E(DOSAGE,1,80) ; 80 char max
+	. S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",3)=$E(ROUTE,1,40)
+	. S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",4)=$E(SCHEDULE,1,50)
+	. S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",8)=START ; Start Date
+	. S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",11)=$$NOW^XLFDT()  ; Documentated Date
+	. S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",12)=C0PDUZ
+	. ;
+	. D UPDATE^DIE("","C0PFDA","C0PIENS")
+	. ;I $D(GPLTEST) B  ;
+	. I $G(DIERR) D ^%ZTER QUIT  ; log error if update fails
+	. ;
+	. D CLEAN^DILF ; Kill DIERR etc.
+	. ; File WP field
+	. N C0PWP ;S C0PWP(1)=COMMENT
+	. M C0PWP=COMMENT ; comment is passed by reference and has multiple lines
+	. ;D WP^DIE(55.05,C0PIENS(1)_","_C0PDFN_",",14,"","C0PWP")
+	. D WP^DIE(55.05,C0PIENS(ZIEN)_","_C0PDFN_",",14,"","C0PWP")
+	. I $G(DIERR) D ^%ZTER QUIT  ; log error if wp filling fails.
+	QUIT
+	;
+DC(C0PDFN,NVAIEN)	; Private Procedure - D/C Non-VA Med
+	; Input:
+	; C0PDFN - you should know what this is by now
+	; NVAIEN - IEN of Non-VA in the non-VA subfile in file 55
+	; Output:
+	; None
+	; Notes: Does not involve order file right now...
+	I $G(^TMP("C0PNODISC")) Q  ; DO NOT DISCONTINUE DRUGS SWITCH
+	; FOR TESTING NEW CROP - MAINTAINS VISTA DRUGS
+	D CLEAN^DILF ; Kill DIERR etc
+	N C0PFDA
+	S C0PFDA(55.05,NVAIEN_","_C0PDFN_",",5)=1 ; Status = discontinued
+	S C0PFDA(55.05,NVAIEN_","_C0PDFN_",",6)=$$NOW^XLFDT() ; discontinued date
+	D UPDATE^DIE("","C0PFDA")
+	I $G(DIERR) D ^%ZTER QUIT
+	QUIT
Index: ePrescribing/trunk/p/C0PPAT.m
===================================================================
--- ePrescribing/trunk/p/C0PPAT.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PPAT.m	(revision 1595)
@@ -0,0 +1,83 @@
+C0PPAT	  ; ERX/GPL - ERX PATIENT utilities; 8/26/09 ; 12/10/09 6:46pm
+	;;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
+	;
+	; THIS ROUTINE IS CALLED AS PART OF ERX WEB SERVICES PROCESSING
+	; TO POPULATE INFORMATION ABOUT THE PATIENT TO BE MAPPED INTO XML
+	; AND SENT TO THE EPRESCRIBING PROVIDER TO DEFINE THE PATIENT ON THEIR
+	; SYSTEM. ALL WEB SERVICE CALLS REGARDING A PATIENT WILL USE THIS ROUTINE
+	; AND SEND A COMPLETE REPRESENTATION OF THE PATIENT.
+	; GPL JUN 2010
+	;
+EN(RTNVAR,C0PDFN)	; INITIALIZE PATIENT VARIABLE ARRAY FOR PATIENT C0PDFN
+	; RTNVAR IS PASSED BY NAME. VARIABLES ARE PREFIXED WITH "PATIENT-"
+	; HERE IS A LIST OF THE VARIABLES THAT ARE POPULATED FOR THE PATIENT:
+	;GPL("PATIENT-ACTORADDRESSCITY")="ALTON"
+	;GPL("PATIENT-ACTORADDRESSLINE1")="1234 Somewhere Lane"
+	;GPL("PATIENT-ACTORADDRESSLINE2")=""
+	;GPL("PATIENT-ACTORADDRESSSOURCEID")="WS_PATIENT2"
+	;GPL("PATIENT-ACTORADDRESSSTATE")="KANSAS"
+	;GPL("PATIENT-ACTORADDRESSTYPE")="Home"
+	;GPL("PATIENT-ACTORADDRESSZIPCODE")=67623
+	;GPL("PATIENT-ACTORCELLTEL")=""
+	;GPL("PATIENT-ACTORCELLTELTEXT")=""
+	;GPL("PATIENT-ACTORDATEOFBIRTH")="1957-12-25"
+	;GPL("PATIENT-ACTOREMAIL")=""
+	;GPL("PATIENT-ACTORFAMILYNAME")="ZZ PATIENT"
+	;GPL("PATIENT-ACTORGENDER")="MALE"
+	;GPL("PATIENT-ACTORGIVENNAME")="TEST"
+	;GPL("PATIENT-ACTORIEN")=2
+	;GPL("PATIENT-ACTORMIDDLENAME")="TWO"
+	;GPL("PATIENT-ACTOROBJECTID")="WS_PATIENT2"
+	;GPL("PATIENT-ACTORRESTEL")="888-555-1212"
+	;GPL("PATIENT-ACTORRESTELTEXT")="Residential Telephone"
+	;GPL("PATIENT-ACTORSOURCEID")="ACTORSYSTEM_1"
+	;GPL("PATIENT-ACTORSSN")="769122557P"
+	;GPL("PATIENT-ACTORSSNSOURCEID")="WS_PATIENT2"
+	;GPL("PATIENT-ACTORSSNTEXT")="SSN"
+	;GPL("PATIENT-ACTORSUFFIXNAME")=""
+	;GPL("PATIENT-ACTORWORKTEL")="888-121-1212"
+	;GPL("PATIENT-ACTORWORKTELTEXT")="Work Telephone"
+	;GPL("PATIENTID")="PATIENT2"
+	N C0PTMP
+	D PEXTRACT^C0CACTOR("C0PTMP",C0PDFN,"WS_PATIENT_"_C0PDFN)
+	; todo: for state, use extended syntax
+	N ZG
+	S C0PTMP("PATIENTID")="PATIENT"_C0PDFN ; PATIENT ID BASED ON DFN
+	S C0PTMP("IDTYPE")="" ; DON'T KNOW WHAT SHOULD GO HERE
+	S C0PTMP("STARTHISTORY")="2004-01-01T00:00:00" ; DEFAULT... CHANGE THIS
+	S C0PTMP("ENDHISTORY")="2010-01-01T00:00:00" ; DEFAULT... CHANGE THIS
+	S C0PTMP("PRESCRIPTIONSTATUS")="C" ; DEFAULT... CHANGE THIS
+	S C0PTMP("PRESCRIPTIONSUBSTATUS")="S" ; DEFAULT... CHANGE THIS
+	S C0PTMP("ARCHIVESTATUS")="N" ; DEFAULT... CHANGE THIS
+	S ZG=$$GET1^DIQ(2,C0PDFN,.115,"I") ;NEED ABBREVIATION
+	S C0PTMP("ACTORADDRESSSTATE")=$$GET1^DIQ(5,ZG_",",1) ;STATE ABBREVIATION
+	I C0PTMP("ACTORGENDER")="MALE" S C0PTMP("ACTORGENDER")="M"
+	I C0PTMP("ACTORGENDER")="FEMALE" S C0PTMP("ACTORGENDER")="F"
+	S C0PTMP("ACTORDATEOFBIRTH")=$TR(C0PTMP("ACTORDATEOFBIRTH"),"-") ;REMOVE DASHES FROM DOB
+	S C0PTMP("ACTORSSN")=$TR(C0PTMP("ACTORSSN"),"P","") ;REMOVE P FROM TEST SSN
+	N ZI
+	S ZI=""
+	F  S ZI=$O(C0PTMP(ZI)) Q:ZI=""  D  ; FOR EACH VARIABLE RETURNED
+	. S @RTNVAR@("PATIENT-"_ZI)=C0PTMP(ZI) ; RETURN PREFIXED VARIABLE
+	S @RTNVAR@("PATIENT-ACTORADDRESSCOUNTRY")="US" ;FIX THIS FOR INTERNATIONAL
+	S @RTNVAR@("PATIENT-ACTORMEMO")="" ; DON'T KNOW WHAT TO PUT HERE GPL
+	Q
+	;
Index: ePrescribing/trunk/p/C0PRECON.m
===================================================================
--- ePrescribing/trunk/p/C0PRECON.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PRECON.m	(revision 1595)
@@ -0,0 +1,235 @@
+C0PRECON	; VEN/SMH - Utilities for Medication Reconciliation; 5/8/12 4:34pm
+	;;1.0;C0P;;Apr 25, 2012;Build 103
+	;Copyright 2009 Sam Habiel.  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
+	;
+GETMEDS(C0PDUZ,C0PDFN,ZRTN)	; Public Proc
+	; Retreives meds from WebService, matches them against VistA, 
+	; compares them with current meds, saves into Non-Va multiple in file 55
+	; (pharmacy patient)
+	;   
+	; Input:
+	; - C0PDUZ: DUZ
+	; - C0PDFN: DFN
+	; 
+	I $G(^TMP("C0PNOPULLBACK")) Q  ; TURNS OFF PULLBACK PROCESSING
+	; FOR TESTING NEW CROP OPTIONS - KEEPS VISTA ERX DRUGS INTACT AND ADDS NO
+	; NEW DRUGS
+	N C0PWSMEDS
+	D SOAP^C0PWS1("C0PWSMEDS","GETMEDS",C0PDUZ,C0PDFN) ; soap call for WS meds
+	I C0PWSMEDS(1,"Status")'="OK" Q  ; bad return from ws call 
+	N CURRENTMEDS
+	D GET^C0PCUR(.CURRENTMEDS,C0PDFN) ; current meds in VistA
+	N ZDUPS ; ARRAY TO KEEP TRACK OF DUPLICATES SO THAT WE CAN
+	; DISCONTINUE ERX MEDS THAT ARE NOT IN THE WEB SERVICE LIST
+	N I
+	FOR I=1:1:C0PWSMEDS(1,"RowCount") DO
+	. N MEDTOADD M MEDTOADD=C0PWSMEDS(I)
+	. N DUPID S DUPID=$$DUP(MEDTOADD("DrugID"),.CURRENTMEDS) ; check for dups
+	. N MEDTXT S MEDTXT=$$FULLNAME^C0PLKUP(MEDTOADD("DrugID"))
+	. I 'DUPID S DUPID=$$FREMAT(MEDTXT,.CURRENTMEDS) ;check
+	. ; for free text drug match gpl
+	. I DUPID S ZDUPS(DUPID,I)="" ; INDEX BY CURRENT MED NUMBER
+	. I DUPID D  ; if indeed duplicate, check if WS Drug is newer drug
+	. . N RXDATENOTIME
+	. . S RXDATENOTIME=$P($$FMDATE(MEDTOADD("PrescriptionDate")),".")
+	. . I RXDATENOTIME>CURRENTMEDS(DUPID,"START") D  ; if newer
+	. . . ;D DC^C0PNVA(C0PDFN,$P(CURRENTMEDS(DUPID,0),U)) ;dc old one
+	. . . D DC^C0PNVA(C0PDFN,CURRENTMEDS(DUPID,"NVAIEN")) ; gpl
+	. . . D ADD(.MEDTOADD,C0PDFN,C0PDUZ) ; add new one
+	. . E  ; do nothing here: Current med in Vista is newer or equivalent one
+	. E  D ADD(.MEDTOADD,C0PDFN,C0PDUZ) ; not a duplicate med
+	; NOW LOOK THROUGH CURRENT MEDS TO SEE WHICH NEED TO BE DISCONTINUED
+	S I=""
+	F  S I=$O(CURRENTMEDS(I)) Q:I=""  D  ; FOR EACH CURRENT MED
+	. I $O(ZDUPS(I,""))="" D  ; DUPLICATE DRUG NOT FOUND
+	. . I $P(CURRENTMEDS(I,0),U,9)'="ACTIVE" Q  ; might be discontinued
+	. . S ZT=$$DRUGNAM^C0PLKUP(.CURRENTMEDS,I)
+	. . I ZT="" S ZT=$P(CURRENTMEDS(I,0),U,2)
+	. . N ZN S ZN=$P($G(CURRENTMEDS(I,0)),U,1)
+	. . S ZT=ZN_" "_ZT
+	. . ;S ZT=$P(CURRENTMEDS(I,0),U,1)_" "_$P(CURRENTMEDS(I,0),U,2)
+	. . I ZN["N;" D  ; DISCONTINUE THE NONVA MED
+	. . . I $G(CURRENTMEDS(I,"COMMENTS",1))["Received from E-Rx Web Service" D  ;
+	. . . . D DC^C0PNVA(C0PDFN,CURRENTMEDS(I,"NVAIEN")) ;dc the med
+	. . . . S ZT="Discontinued "_ZT
+	. . E  S ZT="Can't Discontinue "_ZT
+	. . D MAPERR(.ZRTN,"DRUGS",ZT)
+	QUIT
+ADD(MEDTOADD,C0PDFN,C0PDUZ)	; Private Proc - Add med to VistA
+	; Input:
+	; - MEDTOADD: WebService Drug information, by Reference
+	; - C0PDFN: DFN, by Value
+	; - C0PDUZ: DUZ, By Value
+	; Output:
+	; - None
+	N DRUGS S DRUGS=$$DRUG2^C0PLKUP(MEDTOADD("DrugID"))
+	N ZR,ZII ; GPL NEED TO FIND A NON-ZERO MATCH 
+	F ZII=1:1:10 S ZR=$P(DRUGS,U,ZII) Q:ZR>0  ; $$DRUG2 RETURNS a^b^c FOR MATCHES
+	S DRUGS=ZR ; WE WANT THE FIRST NON-ZERO MATCH
+	I +DRUGS=0 DO  QUIT
+	. D SENDMSG(.MEDTOADD,C0PDFN)
+	. D NFADD(.MEDTOADD,C0PDFN,C0PDUZ)
+	. N ZT
+	. S ZT="Error Mapping Drug: "_MEDTOADD("DrugName")_" ID: "_MEDTOADD("DrugID")
+	. D MAPERR(.ZRTN,"DRUGS",ZT) ; CALL ERROR ROUTINE TO RECORD NO MATCH FOR DRUG
+	N DRUG S DRUG=+DRUGS ; grab the first entry; as good as any for now
+	N ORDIEN S ORDIEN=$$GET1^DIQ(50,DRUG,"PHARMACY ORDERABLE ITEM","I")
+	N DOSAGE S DOSAGE=MEDTOADD("DosageNumberDescription")_" "_MEDTOADD("DosageForm")
+	; ****** ADDED BY GPL 10/5/10 TO ALWAYS CAPTURE FDB NAME IN SIG
+	N MEDTXT S MEDTXT=$$FULLNAME^C0PLKUP(MEDTOADD("DrugID"))
+	I MEDTXT="" S MEDTXT=MEDTOADD("DrugName") ; drug not found condition gpl
+	S DOSAGE=MEDTXT_"| "_MEDTOADD("DosageNumberDescription")_"  "_MEDTOADD("DosageForm") ; | delimiter added by gpl 2/5/2010
+	; ****** END MOD
+	N ROUTE S ROUTE=MEDTOADD("Route")
+	N SCHEDULE S SCHEDULE=MEDTOADD("DosageFrequencyDescription")
+	I MEDTOADD("TakeAsNeeded")="Y" S SCHEDULE=SCHEDULE_" PRN" ; Vista stores PRN in schedule
+	N START S START=$$FMDATE(MEDTOADD("PrescriptionDate"))
+	N COMMENT
+	S COMMENT(1)="Received from E-Rx Web Service" ;todo: move to dialog file
+	S COMMENT(2)="Order Guid: "_$G(MEDTOADD("OrderGuid"))
+	S COMMENT(3)="Physician Name: "_$G(MEDTOADD("PhysicianName"))
+	S COMMENT(4)="Prescription Date: "_$G(MEDTOADD("PrescriptionDate"))
+	S COMMENT(5)="Prescription Guid: "_$G(MEDTOADD("PrescriptionGuid"))
+	S COMMENT(6)="Notes: "_$G(MEDTOADD("PrescriptionNotes"))
+	; add codes for Certification and Free Txt repair processing - gpl
+	S COMMENT(7)=$$CODES^C0PLKUP(MEDTOADD("DrugID")) ;
+	D FILE^C0PNVA(C0PDFN,ORDIEN,DRUG,DOSAGE,ROUTE,SCHEDULE,START,C0PDUZ,.COMMENT)
+	QUIT
+MAPERR(ZRTN,ZTYP,ZTXT)	; ZTYP IS THE TYPE OF MAPPING ERROR 
+	; (IE DRUGS OR ALLERGY)
+	; ZRTN IS PASSED BY REFERENCE AND IS THE ARRAY OF ERROR MESSAGES
+	; THIS ROUTINE ADDS THE ERROR MESSAGE TO THE END OF THE ARRAY
+	; ZTXT IS THE ERROR MESSAGE
+	; 
+	N ZI
+	I $G(^TMP("C0PDEBUG"))="" Q  ; ONLY SHOW MAPPING ERRORS ON DEBUG
+	I '$D(ZRTN) S ZI=1
+	E  S ZI=$O(ZRTN(""),-1)+1 ;ONE PASSED THE END OF ZRTN
+	S ZRTN(ZI)=ZTXT
+	Q
+	;
+FMDATE(C0PD)	; Public $$ - Get fileman date from dates formatted like 11/7/09 10:22:34 PM
+	; Input: Date like 11/7/09 10:22:34 PM
+	; Output: Timson date precise up to seconds
+	S $E(C0PD,$F(C0PD," ")-1)="@" ; put @ b/n date and time for fm
+	N %DT S %DT="TS" ; seconds are required
+	N X,Y
+	S X=C0PD D ^%DT
+	I Y<0 D ^%ZTER ; Problem converting date... wake up programmer
+	QUIT Y
+	;
+DUP(FDBDRUGID,CURRENTMEDS)	; Private $$ - Is Drug already documented for patient?
+	; Input: 
+	; FDBDRUGID By Value
+	; CURRENTMEDS By Reference
+	; Output:
+	; "" if no duplicate
+	; CURRENTMEDS ien if duplicate
+	N DRUGS S DRUGS=$$DRUG2^C0PLKUP(FDBDRUGID)
+	; add a check for the CODES in Comment(6) - to update if not there
+	N C0PCODES S C0PCODES=$$CODES^C0PLKUP(FDBDRUGID)
+	N I S I=""
+	N FOUND S FOUND=0
+	F  Q:FOUND=1  S I=$O(CURRENTMEDS(I)) Q:I=""   D  ; loop through current meds
+	. I '$D(CURRENTMEDS(I,"DRUG")) QUIT  ; continue if no drug id
+	. I $G(CURRENTMEDS(I,"COMMENTS",1))'["Received from E-Rx Web Service" Q  ;
+	. ; DON'T MATCH ON DRUGS THAT ARE NOT ERX
+	. ; check for CODES in COMMENTS(6)
+	. I $G(CURRENTMEDS(I,"COMMENTS",6))'=C0PCODES D  ; add codes
+	. . ;S ^PS(55,C0PDFN,"NVA",I,1,7,0)=C0PCODES ; right into the global
+	. I $P(CURRENTMEDS(I,0),U,9)'["ACTIVE" QUIT  ; quit if not active
+	. I ("^"_DRUGS_"^")[("^"_CURRENTMEDS(I,"DRUG")_"^") S FOUND=1
+	QUIT I  ; entry if Found, "" if not found
+	;
+FREMAT(FDBDNAME,CURRENTMEDS,ZMED)	;MATCH A FREE TEXT DRUG EXTRINSIC
+	; THE DRUG ID HAS BEEN STORED IN THE COMMENT OF EACH ERX NONVA DRUG
+	; ZMED IS WHICH DRUG IN CURRENTMEDS WHICH IS PASSED BY REF
+	; FDBDNAME IS THE DRUG NAME AND IS PASSED BY VALUE ; GPL
+	N I S I=""
+	; add a check for the CODES in Comment(6) - to update if not there
+	N C0PCODES S C0PCODES=$$CODES^C0PLKUP(MEDTOADD("DrugID"))
+	N FOUND S FOUND=0
+	F  Q:FOUND=1  S I=$O(CURRENTMEDS(I)) Q:I=""   D  ; loop through current meds
+	. I $D(CURRENTMEDS(I,"DRUG")) QUIT  ; SKIP OVER MAPPED DRUGS
+	. I $P(CURRENTMEDS(I,0),U,9)'["ACTIVE" QUIT  ; quit if not active
+	. I FDBDNAME=$$DRUGNAM^C0PLKUP(.CURRENTMEDS,I) S FOUND=1
+	I FOUND=1 D  ;
+	. S ZT="Drug Dup Found: "_MEDTOADD("DrugName")_" ID: "_MEDTOADD("DrugID")
+	. ; check for CODES in COMMENTS(6)
+	. I $G(CURRENTMEDS(I,"COMMENTS",6))'=C0PCODES D  ; add codes
+	. . ;S ^PS(55,C0PDFN,"NVA",I,1,7,0)=C0PCODES ; right into the global
+	. D MAPERR(.ZRTN,"DRUGS",ZT) ; CALL ERROR ROUTINE TO RECORD NO MATCH FOR DRUG
+	Q I  ; entry if Found, "" if not found
+	;
+SENDMSG(MEDTOADD,C0PDFN)	; Private EP - Send Bulletin saying drug not found
+	; Input:
+	; - MEDTOADD: WS Med entry By Reference
+	; - C0PDFN: DFN by Value
+	; Output:
+	; - None
+	; info: tested 12/14/09
+	; todo: move this to a background call - it takes too long!
+	N DUZ ; remove old value to make the postmaster the sender
+	N XMDUZ S XMDUZ="E-Rx WebService" ; supposed sender
+	N XMTEXT ; unused
+	N XMY ; unused
+	N XMBTMP ; unused
+	N XMDF ; unused
+	N XMDT ; unused - will send message now
+	N XMYBLOB ; unused
+	N XMB
+	S XMB="C0P EXTERNAL DRUG NOT FOUND" ; bulletin name
+	S (XMB(1),XMB(5))=$$GET1^DIQ(2,C0PDFN,"PRIMARY LONG ID") ; chart #
+	S (XMB(2),XMB(3))=$$FULLNAME^C0PLKUP(MEDTOADD("DrugID")) ; drug not matched
+	S XMB(4)=$$GET1^DIQ(2,C0PDFN,.01) ; patient name
+	D ^XMB
+	QUIT
+	;
+NFADD(MEDTOADD,C0PDFN,C0PDUZ)	; Private Proc - Add free text med to VistA
+	; Input:
+	; - MEDTOADD: WebService Drug information, by Reference
+	; - C0PDFN: DFN, by Value
+	; - C0PDUZ: DUZ, By Value
+	; Output:
+	; - None
+	; info: tested 12/16/09
+	; Stores med along side dosage in dosage field as free text
+	N ORDIEN S ORDIEN=$$FIND1^DIC(50.7,"","QX","FREE TXT DRUG","B") ; todo: change to a parameter
+	N DOSAGE
+	N MEDTXT S MEDTXT=$$FULLNAME^C0PLKUP(MEDTOADD("DrugID"))
+	I MEDTXT="" S MEDTXT=MEDTOADD("DrugName") ; drug not found condition gpl
+	S DOSAGE=MEDTXT_"| "_MEDTOADD("DosageNumberDescription")_"  "_MEDTOADD("DosageForm") ; | delimiter added by gpl 2/5/2010
+	N ROUTE S ROUTE=MEDTOADD("Route")
+	N SCHEDULE S SCHEDULE=MEDTOADD("DosageFrequencyDescription")
+	I MEDTOADD("TakeAsNeeded")="Y" S SCHEDULE=SCHEDULE_" PRN" ;
+	N START S START=$$FMDATE(MEDTOADD("PrescriptionDate"))
+	N COMMENT
+	S COMMENT(1)="Received from E-Rx Web Service" ;todo: move to dialog file
+	S COMMENT(2)="Order Guid: "_$G(MEDTOADD("OrderGuid"))
+	S COMMENT(3)="Physician Name: "_$G(MEDTOADD("PhysicianName"))
+	S COMMENT(4)="Prescription Date: "_$G(MEDTOADD("PrescriptionDate"))
+	S COMMENT(5)="Prescription Guid: "_$G(MEDTOADD("PrescriptionGuid"))
+	S COMMENT(6)="Notes: "_$G(MEDTOADD("PrescriptionNotes"))
+	; add codes for Certification and Free Txt repair processing - gpl
+	S COMMENT(7)=$$CODES^C0PLKUP(MEDTOADD("DrugID")) ;
+	D FILE^C0PNVA(C0PDFN,ORDIEN,"",DOSAGE,ROUTE,SCHEDULE,START,C0PDUZ,.COMMENT)
+	;N COMMENT ;added DrugID to comment 1/27/2010 gpl
+	;S COMMENT="Received from E-Rx Web Service (DrugID:"_MEDTOADD("DrugID")_")"
+	;D FILE^C0PNVA(C0PDFN,ORDIEN,"",DOSAGE,ROUTE,SCHEDULE,START,C0PDUZ,COMMENT)
+	QUIT
Index: ePrescribing/trunk/p/C0PREFIL.m
===================================================================
--- ePrescribing/trunk/p/C0PREFIL.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PREFIL.m	(revision 1595)
@@ -0,0 +1,385 @@
+C0PREFIL	  ; ERX/GPL - eRx Refill utilities ; 5/9/12 12:03am
+	;;1.0;C0P;;Apr 25, 2012;Build 103
+	;Copyright 2009,2010 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.
+TESTREQ(ZDUZ,ZDFN)	; TEST REFILL REQUEST
+	I '$D(ZDFN) S ZDFN=""
+	D REFREQ("ZG",ZDUZ,ZDFN)
+	W !
+	ZWRITE C0PRXML
+	Q
+	;
+REFREQ(GRTN,IDUZ,IDFN)	; MAKE A WEB SERVICE CALL TO GENERATE A REFIL REQUEST
+	; 
+	N GPL,C0PFARY,GVOR
+	D ENCREQ("GPL",IDUZ,IDFN)
+	S GVOR("XMLIN")=GPL
+	S GVOR("ORIG-FILL-DATE")=""
+	S GVOR("CREATE-MED-YN")="0"
+	;D EN^C0PMAIN("GG","GURL",IDUZ,IDFN,"GENREFILL","GVOR")
+	D INITXPF^C0PWS2("C0PFARY")
+	D SOAP^C0PWS2("GRTN","GENREFILL",IDUZ,IDFN,"GVOR")
+	;D SOAP^C0CSOAP("GRTN","GENREFILL",,,"GG","C0PFARY") ;
+	Q
+	;
+ENCREQ(ZRTN,ZDUZ,ZDFN)	; ENCODE AN NCSCRIPT RENEWAL REQUEST
+	;
+	D GENTEST("GPL","GURL",ZDUZ,ZDFN,1)
+	;S ZI=""
+	;S GPL(1)="RxInput="_GPL(1)
+	S ZI=0 ; 
+	;F  S ZI=$O(GPL(ZI)) Q:ZI=""  D  ; MAKE IT XML SAFE
+	;. S GPL(ZI)=$$SYMENC^MXMLUTL(GPL(ZI))
+	;. W !,GPL(ZI)
+	S ZI=0
+	S G=""
+	K GPL(0) ; GET RID OF LINE COUNT
+	F  S ZI=$O(GPL(ZI)) Q:ZI=""  D  ;
+	. S G=G_GPL(ZI)
+	S @ZRTN=$$ENCODE^RGUTUU(G)
+	;S @ZRTN=G
+	Q
+	;
+CERTTEST	; GENERATE XML FILES FOR NEWCROP CERTIFICATION
+	;
+	N ZII
+	S ZDFN=18 ; TEST PATIENT TO USE
+	F ZII=154,155,156,157 D  ; IENS OF SUBSCRIBER PROFILES
+	. D CERTONE(ZII,ZDFN)
+	Q
+	;
+CERTONE(ZI,ZDFN)	; GENERATE ONE XML FILE 
+	N ZN
+	D EN^C0PMAIN("C0PG1","G2",ZI,ZDFN) ; GET THE NCSCRIPT
+	S ZN=$P($P(^VA(200,ZI,0),U,1),",",2) ; GIVEN NAME OF USER
+	; ON OUR SYSTEM THESE ARE ERX,DOCTOR ERX,MID-LEVEL ERX,NURSE AND ERX,MANAGER
+	S ZN=ZN_".xml" ; APPEND .xml extension
+	K C0PG1(0)
+	S ZDIR=^TMP("C0CCCR","ODIR")
+	W !,$$OUTPUT^C0CXPATH("C0PG1(1)",ZN,ZDIR)
+	Q
+	;
+GENTEST(RTNXML,RTNURL,ZDUZ,ZDFN,ZFILE)	; GENERATE A TEST 
+	; CLICK-THROUGH HTLM FILE FOR
+	; GENERATING REFILL REQUESTS , XML IS RETURNED IN RTN,PASSED BY NAME
+	; IF ZFILE IS 1, THE FILE IS WRITTEN TO HOST FILE
+	D EN^C0PMAIN("C0PG1","G2",ZDUZ,ZDFN) ; GET THE NCSCRIPT
+	;D GETMEDS("G6",ZDFN) ;GET MEDICATIONS
+	;D QUERY^C0CXPATH("G6","//NewPrescription[1]","G7") ;JUST THE FIRST ONE
+	;D INSERT^C0CXPATH("C0PG1","G7","//NCScript")
+	K C0PG1(0)
+	M @RTNXML=C0PG1 ;
+	S ZDIR=^TMP("C0CCCR","ODIR")
+	I $G(ZFILE)=1 W $$OUTPUT^C0CXPATH("C0PG1(1)","REFILL-"_ZDFN_".xml",ZDIR)
+	Q
+	;
+GETMEDS(OUTARY,ZDFN)	; GET THE PATIENT'S MEDS AND PUT INTO XML
+	;
+	N ZG,ZG2,ZB,ZN
+	S DEBUG=0
+	D GETTEMP^C0PWS2("ZG","OUTMEDS") ;GET THE MEDICATIONS TEMPLATE
+	D SOAP^C0PWS2("ZG2","GETMEDS",$$PRIMARY^C0PMAIN(),ZDFN) ; GET MEDS 
+	I '$D(ZG2) Q  ; SHOULDN'T HAPPEN
+	I ZG2(1,"Status")'="OK" D  Q  ; BAD RETURN FROM WEB SERVER
+	. W $G(ZG2(1,"Message")),!
+	N ZI S ZI=""
+	S ZN=$NA(^TMP("C0PREFIL",$J))
+	K @ZN
+	F  S ZI=$O(ZG2(ZI)) Q:ZI=""  D  ; FOR EACH MED
+	. N ZV
+	. S ZV=$NA(@ZN@("DATA",ZI))
+	. S ZX=$NA(@ZN@("XML",ZI))
+	. S @ZV@("dispenseNumber")=$G(ZG2(ZI,"Dispense"))
+	. S @ZV@("dosage")="Take "_$G(ZG2(ZI,"DosageNumberDescription"))_" "_$G(ZG2(ZI,"Route"))_" "_$G(ZG2(ZI,"DosageFrequencyDescription"))
+	. S @ZV@("drugIdentifier")=ZG2(ZI,"DrugID")
+	. S @ZV@("drugIdentifierType")="FDB"
+	. S @ZV@("pharmacistMessage")="No childproof caps please"
+	. S @ZV@("pharmacyIdentifier")=1231212
+	. S @ZV@("refillCount")=ZG2(ZI,"Refills")
+	. S @ZV@("substitution")="SubstitutionAllowed"
+	. D MAP^C0CXPATH("ZG",ZV,ZX)
+	. D QUEUE^C0CXPATH("ZB",ZX,2,$O(@ZX@(""),-1))
+	D BUILD^C0CXPATH("ZB",OUTARY)
+	K @ZN ;CLEAN UP
+	Q
+	;
+	;B
+	;
+	;D GET^C0PCUR(.ZG2,ZDFN) ; GET THE MEDS FOR THIS PATIENT
+	;D EXTRACT^C0CALERT("ZG",ZDFN,"ZG2","ALGYCBK^C0PALGY3(ALTVMAP,A1)")
+	S ZN=$O(ZR(""),-1) ;NUMBER OF LINES IN OUTPUT
+	D QUEUE^C0CXPATH("ZB","ZG2",2,ZN-1)
+	D BUILD^C0CXPATH("ZB",OUTARY)
+	Q
+	; 
+RGUIDS(ZARY,ZDUZ)	; RETURNS AN ARRAY OF ALL REFILL REQUEST GUIDS FOR 
+	; DUZ ZDUZ. ZARY IS PASSED BY NAME
+	; FORMAT IS @ZARY@("GUID")=IEN
+	; THIS ROUTINE IS REUSED FOR THE STATUS ROUTINE - INCOMPLETE ORDERS
+	N ZI,ZJ,ZK,ZL,ZM,ZN
+	S ZI=0
+	;F  S ZI=$O(^XTV(8992.1,"R",ZDUZ,ZI)) Q:ZI=""  D  ; ALL ALERT FOR DUZ
+	F  S ZI=$O(^XTV(8992,ZDUZ,"XQA",ZI)) Q:ZI=""  D  ; USE XQA MULTIPLE
+	. S ZL=^XTV(8992,ZDUZ,"XQA",ZI,0) ; 
+	. S ZM=$P(ZL,U,2) ; RECORD ID
+	. S ZN=$O(^XTV(8992.1,"B",ZM,"")) ;IEN OF ALERT TRACKING RECORD
+	. S ZK=$$GET1^DIQ(8992.1,ZN_",",.03)
+	. I ZK'["OR,1130" Q  ; NOT OUR PACKAGE - ALL ERX ALERTS START WITH 1130
+	. ; 11305 IS FOR REFILLS
+	. ; 11306 IS FOR INCOMPLETE ORDERS
+	. S ZJ=""
+	. S ZJ=$$GET1^DIQ(8992.1,ZN_",",2)
+	. I ZJ="" Q
+	. ; FOR RENEWALS (11305) NEED TO PULL THE GUID OUT - IT IS THE FIRST PIECE
+	. ; OTHERWISE USE THE ENTIRE STRING. FOR INCOMPLETE ORDERS THIS WILL
+	. ; INCLUDE THE MED AND PRESCRIPTION DATE
+	. I ZK["OR,11305" S ZJ=$P(ZJ,"^",1) ; FIRST PIECE IS THE GUILD GUID^DOB^SEX
+	. S @ZARY@(ZJ)=ZN
+	Q
+	;
+EN	; BATCH ENTRY POINT FOR REFILL (RENEWAL) STATUS AND FAILEDFAX CHECKING
+	D REFILL
+	K ZRSLT
+	;D STATUS ; ALSO RUN CHECK FOR INCOMPLETE ORDERS
+	D FAILFAX ; ALSO RUN CHECK FOR FAILED FAXES
+	; smh - C0PTRAK depends on code that's not available... won't use.
+	; D RUNAWAY^C0PTRAK ; kill runaway jobs gpl 4/19/2012; smh comment out 5/9/2012
+	Q
+	;
+	; TEST Lines below not intended for End Users. Programmers only.
+	; BEWARE ZWRITE SYNTAX. It may not work in other M Implementations.
+SHOW	; SHOW THE CURRENT REFILL ALERTS ON THE SYSTEM
+	ZWRITE ^XTV(8992,"AXQAN","OR,0,11305",*)
+	Q
+	;
+REFILL	; PULL REFILL REQUESTS AND POST ALERTS
+	;
+	N ZDUZ ; USER NUMBER UNDER WHICH WE BUILD THE WEB SERVICE CALL
+	N ZDFN ; PATIENT NUMBER USED TO BUILD THE WEB SERVICE CALL
+	S ZDUZ=$$PRIMARY^C0PMAIN() ; PRIMARY ERX USER FOR BATCH CALLS
+	;S ZDUZ=DUZ ; SHOULD CHANGE THIS FOR PRODUCTION TO A "BATCH" USER
+	S ZDFN="" ; NO PATIENT NEEDED FOR THESE CALLS
+	; S ZDFN=18 ; SHOULD NOT NEED THIS BE MAKE THE CALL - FIX IN EN^C0PMAIN
+	N ZRSLT
+	D SOAP^C0PWS2("ZRSLT","REFILLS",ZDUZ,ZDFN) ; WS CALL TO RETURN REFILS
+	;S XXX=YYY  ;
+	I $G(ZRSLT(1,"Status"))'="OK" Q  ; NO ROWS WERE RETURNED
+	I $G(ZRSLT(1,"RowCount"))=0 Q  ; NO ROWS WERE RETURNED
+	D NOTIPURG^XQALBUTL(11305) ; DELETE ALL CURRENT REFILL ALERTS
+	S C0PNPIF=$$GET1^DIQ(C0PAF,C0PACCT_",",8,"I") ; LEGACY FLAG TO USE NPI FOR SID
+	N ZI S ZI=0
+	N ZAPACK S ZAPACK="OR" ; ALERT PACKAGE CODE
+	N ZADFN S ZADFN=0 ; DFN TO ASSOCIATE ALERT WITH - WE DON'T KNOW THIS
+	N ZACODE S ZACODE=11305 ; IEN TO OE/RR NOTIFICATIONS file for eRx Refills
+	F  S ZI=$O(ZRSLT(ZI)) Q:+ZI=0  D  ; FOR EACH RETURNED REFILL REQUEST
+	. N ZSID S ZSID=ZRSLT(ZI,"ExternalDoctorId") ; NPI FOR SUBSCRIBER
+	. I C0PNPIF'=1 S ZDUZ=$O(^VA(200,"AC0PSID",ZSID,"")) ; GUID SID
+	. E  S ZDUZ=$O(^VA(200,"C0PNPI",ZSID,"")) ; DUZ FOR SUBSCRIBER
+	. S ZRSLT("DUZ",ZDUZ,ZI)=""
+	N ZJ S ZJ=""
+	F  S ZJ=$O(ZRSLT("DUZ",ZJ)) Q:ZJ=""  D  ; FOR EACH PROVIDER
+	. N ZGUIDS
+	. D RGUIDS("ZGUIDS",ZJ) ; GET ARRAY OF CURRENT ACTIVE GUIDS
+	. S ZI=""
+	. F  S ZI=$O(ZRSLT("DUZ",ZJ,ZI)) Q:ZI=""  D  ; FOR EACH REQUEST
+	. . N ZRRG S ZRRG=ZRSLT(ZI,"RenewalRequestGuid") ;renewal request number
+	. . I $D(ZGUIDS(ZRRG)) D  Q  ; THIS REQUEST IS A DUPLICATE, SKIP IT 
+	. . . W ZRRG_" IS A DUP",!
+	. . N ZDATE S ZDATE=$P(ZRSLT(ZI,"ReceivedTimestamp")," ",1) ;DATE RECEIVED
+	. . I $G(^TMP("C0P","TestNoMatch"))=1 D  ;
+	. . . S ZRSLT(ZI,"PatientMiddleName")="XXX" ;TESTING NO MATCH  REMOVE ME
+	. . ;I DUZ=135 S ZRSLT(ZI,"PatientMiddleName")="Uta" ;TESTING NO MATCH REMOVE
+	. . N ZPAT S ZPAT=$G(ZRSLT(ZI,"PatientLastName"))_","_$G(ZRSLT(ZI,"PatientFirstName")) ; PATIENT NAME LAST,FIRST
+	. . I $G(ZRSLT(ZI,"PatientMiddleName"))'="" S ZPAT=ZPAT_" "_$G(ZRSLT(ZI,"PatientMiddleName"))
+	. . S ZDOB=$G(ZRSLT(ZI,"PatientDOB")) ;patient date of birth
+	. . S ZSEX=$G(ZRSLT(ZI,"PatientGender")) ;patient gender
+	. . S ZADFN=$$PATMAT(ZPAT,ZDOB,ZSEX) ; TRY AND MATCH THE PATIENT
+	. . ;W "DFN="_ZADFN," ",ZI,!
+	. . N ZXQAID S ZXQAID=ZAPACK_","_ZADFN_","_ZACODE ; FORMAT FOR P1 OF XQAID
+	. . N ZMED S ZMED=ZRSLT(ZI,"DrugInfo")
+	. . ;S XQA(ZDUZ)="" ; WHO TO SEND THE ALERT TO
+	. . I '$D(^TMP("C0P","AlertVerify")) S XQA(ZJ)="" ; WHO TO SEND THE ALERT TO
+	. . E  D  ; AlertVerify sends alerts only to testers, not recipients
+	. . . ; use this when installing eRx to verify ewd installation
+	. . . N ZZZ S ZZZ=""
+	. . . F  S ZZZ=$O(^TMP("C0P","AlertVerify",ZZZ)) Q:ZZZ=""  D  ; WHICH DUZ 
+	. . . . S XQA(ZZZ)="" ; MARK THIS USER TO RECIEVE ALERTS
+	. . ;S XQA(135)="" ; ALWAYS SEND TO GPL
+	. . ;S XQA(148)="" ; ALWAYS SEND TO RICH
+	. . N ZP6 ; STRING THAT CPRS WILL RETURN FOR MATCHING 
+	. . I ZADFN=0 D  ; NO MATCH
+	. . . S XQAMSG="no match: ): [eRx] "_ZPAT_" Renewal request for "_ZMED
+	. . . S ZP6=ZPAT_" Renewal request for "_ZMED
+	. . E  D  ;
+	. . . S XQAMSG=ZPAT_": ): [eRx] Renewal request for "_ZMED
+	. . . S ZP6="Renewal request for "_ZMED
+	. . ;S XQAMSG=$E(XQAMSG,1,70) ; TRUNCATE TO 70 CHARS
+	. . S XQAID=ZXQAID ; PACKAGE IDENTIFIER 
+	. . ;S XQADATA=ZRRG ; THE GUID OF THE REQUEST. NEEDED TO PROCESS THE ALERT
+	. . S XQADATA=ZRRG_"^"_ZDOB_"^"_ZSEX ; SAVE DOB AND SEX WITH GUID
+	. . W "SENDING",XQAID_" "_XQADATA,!
+	. . D SETUP^XQALERT ; MAKE THE CALL TO SET THE ALERT
+	. . HANG 1 ; NEED TO MAKE SURE TIME STAMP IS UNIQUE
+	K ZRSLT
+	;D STATUS ; ALSO RUN CHECK FOR INCOMPLETE ORDERS
+	;D FAILFAX ; ALSO RUN CHECK FOR FAILED FAXES
+	Q
+	;
+PATMAT(ZNAME,INDOB,INSEX)	;EXTRINSIC TO TRY AND MATCH THE PATIENT 
+	; RETURNS ZERO IF NO EXACT MATCH IS FOUND
+	N ZP
+	S ZP=$O(^DPT("B",ZNAME,""))
+	I ZP="" Q 0 ; EXACT MATCH NOT FOUND ON NAME
+	; CHECK DATE OF BIRTH
+	;W "CHECKING DATE OF BIRTH",!
+	N DOB
+	S DOB=$$GET1^DIQ(2,ZP_",",.03,"I") ; PATIENT'S DATE OF BIRTH IN VISTA
+	N ZD ;INCOMING DATE OF BIRTH IS IN YYYYMMDD FORMAT
+	S ZD=($E(INDOB,1,4)-1700)_$E(INDOB,5,8) ; DATE OF BIRTH CONVERTED TO FM FORMAT
+	;W ZD_" "_DOB,!
+	I +ZD'=+DOB Q 0 ; DATE OF BIRTH DOES NOT MATCH
+	;
+	; CHECK GENDER
+	;W "CHECKING GENDER",!
+	N GENDER
+	S GENDER=$$GET1^DIQ(2,ZP_",",.02,"I") ; PATIENT'S GENDER IN VISTA
+	;W GENDER_INSEX,!
+	I GENDER'=INSEX Q 0 ;GENDER DOESN'T MATCH
+	Q ZP
+	;
+STATUS	; BATCH CALL TO RETRIEVE ERX ACCOUNT STATUS
+	; RETURNS UNFINISHED ORDERS FOR ALL PROVIDERS
+	; AND SENDS STATUS ALERTS
+	N VOR
+	S VOR("STATUS-SECTION-TYPE")="AllDoctorReview"
+	S VOR("SORT-ORDER")="A"
+	S VOR("INCLUDE-SCHEMA")="N"
+	S ZDUZ=$$PRIMARY^C0PMAIN() ; PRIMARY ERX USER FOR BATCH CALLS
+	K ZRSLT
+	; D SOAP^C0PWS1("ZRSLT","STATUS",ZDUZ,"","VOR")
+	D SOAP^C0PWS2("ZRSLT","STATUS",ZDUZ,"","VOR")
+	I '$D(ZRSLT) Q  ; SHOULDN'T HAPPEN
+	I $G(ZRSLT(1,"DrugInfo"))="" Q  ; NO ROWS
+	S C0PNPIF=$$GET1^DIQ(C0PAF,C0PACCT_",",8,"I") ; LEGACY FLAG TO USE NPI FOR SID
+	N ZI S ZI=0
+	N ZAPACK S ZAPACK="OR" ; ALERT PACKAGE CODE
+	N ZADFN S ZADFN=0 ; DFN TO ASSOCIATE ALERT WITH - WE DON'T KNOW THIS
+	N ZACODE S ZACODE=11306 ; IEN TO OE/RR NOTIFICATIONS file for eRx incomplete
+	; orders
+	F  S ZI=$O(ZRSLT(ZI)) Q:+ZI=0  D  ; FOR EACH RETURNED REFILL REQUEST
+	. N ZSID S ZSID=$G(ZRSLT(ZI,"ExternalDoctorId")) ; NPI FOR SUBSCRIBER
+	. I ZSID="" Q  ; NO EXTERNAL ID FOR THIS STATUS
+	. I C0PNPIF'=1 S ZDUZ=$O(^VA(200,"AC0PSID",ZSID,"")) ; GUID SID
+	. E  S ZDUZ=$O(^VA(200,"C0PNPI",ZSID,"")) ; DUZ FOR SUBSCRIBER
+	. S ZRSLT("DUZ",ZDUZ,ZI)=""
+	N ZJ S ZJ=""
+	D RMSTATUS ; REMOVE ALL STATUS ALERTS
+	F  S ZJ=$O(ZRSLT("DUZ",ZJ)) Q:ZJ=""  D  ; FOR EACH PROVIDER
+	. N ZGUIDS
+	. D RGUIDS("ZGUIDS",ZJ) ; GET ARRAY OF CURRENT ACTIVE ALERTS
+	. S ZI=""
+	. F  S ZI=$O(ZRSLT("DUZ",ZJ,ZI)) Q:ZI=""  D  ; FOR EACH REQUEST
+	. . N ZRRG S ZRRG=$G(ZRSLT(ZI,"DrugInfo")) ; first piece of XQDATA
+	. . S $P(ZRRG,"^",2)=$G(ZRSLT(ZI,"PrescriptionDate")) ; second piece
+	. . I $D(ZGUIDS(ZRRG)) D  Q  ; THIS REQUEST IS A DUPLICATE, SKIP IT 
+	. . . ;W ZRRG_" IS A DUP",!
+	. . I ZRRG="^" D ERROR^C0PMAIN(",U113059004,",$ST($ST,"PLACE"),"ERX-NOT","Notification Error") QUIT
+	. . N ZDATE S ZDATE=$P($G(ZRSLT(ZI,"PrescriptionDate"))," ",1) ;
+	. . N ZPAT S ZPAT=$G(ZRSLT(ZI,"ExternalPatientId")) ; format PATIENTDFN
+	. . I ZPAT="" Q  ;THIS IS AN ERROR
+	. . S ZADFN=$P(ZPAT,"PATIENT",2) ; EXTRACT THE DFN
+	. . S ZPAT=$$GET1^DIQ(2,ZADFN_",",.01) ;PATIENT'S NAME
+	. . ;W "DFN="_ZADFN," ",ZI,!
+	. . N ZXQAID S ZXQAID=ZAPACK_","_ZADFN_","_ZACODE ; FORMAT FOR P1 OF XQAID
+	. . N ZMED S ZMED=ZRSLT(ZI,"DrugInfo")
+	. . ;S XQA(ZDUZ)="" ; WHO TO SEND THE ALERT TO
+	. . S XQA(ZJ)="" ; WHO TO SEND THE ALERT TO
+	. . ;S XQA(135)="" ; ALWAYS SEND TO GPL
+	. . ;S XQA(148)="" ; ALWAYS SEND TO RICH
+	. . N ZP6 ; STRING THAT CPRS WILL RETURN FOR MATCHING 
+	. . I ZADFN=0 D  ; NO MATCH
+	. . . S XQAMSG="no match: ): [eRx] "_ZPAT_" Incomplete Order for "_ZMED
+	. . . S ZP6=ZPAT_" Incomplete Order for "_ZMED
+	. . E  D  ;
+	. . . S XQAMSG=ZPAT_": ): [eRx] Incomplete Order for "_ZMED
+	. . . S ZP6="Incomplete Order for "_ZMED
+	. . ;S XQAMSG=$E(XQAMSG,1,70) ; TRUNCATE TO 70 CHARS
+	. . S XQAID=ZXQAID ; PACKAGE IDENTIFIER
+	. . S XQADATA=ZRRG ; THE GUID OF THE REQUEST. NEEDED TO PROCESS THE ALERT
+	. . D SETUP^XQALERT ; MAKE THE CALL TO SET THE ALERT
+	Q
+	;
+RMSTATUS	; DELETES ALL STATUS ALERTS FOR ALL USERS (THEY WILL BE
+	; RESTORED NEXT TIME STATUS^C0PREFIL IS RUN - IN ERX BATCH
+	D NOTIPURG^XQALBUTL(11306) ;
+	W !,"ALL ERX STATUS ALERTS HAVE BEEN DELETED"
+	Q
+	;
+FAILFAX	; BATCH CALL TO RETRIEVE ERX FAILED FAX STATUS
+	; RETURNS A COUNT OF FAILED FAXES AND AN ARRAY OF PATIENTS
+	N VOR,ZRSLT
+	S VOR("STATUS-SECTION-TYPE")="FailedFax"
+	;S VOR("ACCOUNT-PARTNERNAME")="demo"
+	S VOR("SORT-ORDER")="A"
+	S VOR("INCLUDE-SCHEMA")="N"
+	S ZDUZ=$$PRIMARY^C0PMAIN() ; PRIMARY ERX USER FOR BATCH CALLS
+	D SOAP^C0PWS1("ZRSLT","STATUS",ZDUZ,"","VOR")
+	N ZCOUNT
+	S ZCOUNT=$O(ZRSLT(""),-1) ; HOW MANY FAILED FAXES
+	I +ZCOUNT=0 Q  ; NO FAILED FAXES
+	;I $G(ZRSLT(1,"RowCount"))=0 Q  ; NO FAILED FAXES
+	;I $G(ZRSLT(1,"RowCount"))="" Q  ; SHOULD NOT HAPPEN
+	N XQA,XQAMSG,XQAID,XQAKILL
+	S XQAID="C0P" ; GOING TO FIRST KILL ALL FAILED FAX ALERTS
+	D DELETEA^XQALERT ; KILL ALL FAILED FAX ALERTS
+	S XQA("G.ERX HELP DESK")=""
+	;S XQA(135)=""
+	S XQAID="C0P"
+	S XQAMSG="eRx: "_ZCOUNT_" Failed Faxes on ePrescribing"
+	D SETUP^XQALERT ; CREATE NEW FAILED FAX ALERTS TO THE MAILGROUP
+	Q
+	;
+RUN	; USED TO PROCESS AN ALERT. THIS ROUTINE IS LISTED IN
+	; 0E/RR CPRS NOTIFICATIONS AS THE ROUTINE TO RUN TO PROCESS
+	; A C0P ERX ALERT
+	W "MADE IT TO RUN C0PREFIL",!
+	W XQADATA
+	; B
+	Q
+	;
+GETALRT(ZARY,ZID)	; LOOKS UP AN ALERT BY USING THE "RECORDID" FROM CPRS,
+	; PASSED BY VALUE IN ZID. RESULTS ARE RETURNED IN ZARY, PASSED BY NAME
+	;N ZIEN
+	;S ZIEN=$O(^XTV(8992.1,"B",ZID,"")) ;IEN IN THE ALERT TRACKING FILE
+	;I ZIEN="" W "ERROR RETRIEVING ALERT",! Q  ;
+	D GETN^C0CRNF(ZARY,8992.1,ZID,"B") ; GET ALL THE ALERT FIELDS
+	; THE FORMAT IS @ZARY@("DATA FOR PROCESSING")="FILE^FIELD^VALUE"
+	; ALL POPULATED FIELDS (BUT NOT SUBFILES) ARE RETURNED
+	Q
+	; 
+UPDIE	  ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+	K ZERR
+	D CLEAN^DILF
+	D UPDATE^DIE("","C0PFDA","","ZERR")
+	I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
+	K C0PFDA
+	Q
Index: ePrescribing/trunk/p/C0PRXNRD.m
===================================================================
--- ePrescribing/trunk/p/C0PRXNRD.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PRXNRD.m	(revision 1595)
@@ -0,0 +1,121 @@
+C0PRXNRD	; VEN/SMH - eRx: Routine to Read RxNorm files; 12/06/09 12:25am
+	;;0.1;C0P;nopatch;noreleasedate;Build 1
+	W "No entry from top" Q
+	;
+CONFN()	Q 1130590011.001
+SRCFN()	Q 1130590012.003
+	;
+IMPORT(PATH)	
+	I PATH="" QUIT
+	D READSRC(PATH),READCON(PATH,1)
+	QUIT
+	;
+DELFILED(FN)	; Delete file data; PEP procedure; only for RxNorm files
+	; FN is Filenumber passed by Value
+	D CLEAN^DILF ; Clean FM variables
+	N ROOT S ROOT=$$ROOT^DILFD(FN,"",1) ; global root
+	N ZERO S ZERO=@ROOT@(0) ; Save zero node
+	S $P(ZERO,U,3,9999)="" ; Remove entry # and last edited
+	K @ROOT ; Kill the file -- so sad!
+	S @ROOT@(0)=ZERO ; It riseth again!
+	QUIT
+GETLINES(PATH,FILENAME)	; Get number of lines in a file
+	D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
+	U IO
+	N I
+	F I=1:1 R LINE Q:$$STATUS^%ZISH
+	D CLOSE^%ZISH("FILE")
+	Q I-1
+READCON(PATH,INCRES)	; Open and read concepts file: RXNCONSO.RRF; EP
+	; PATH ByVal, path of RxNorm files
+	; INCRES ByVal, include restricted sources. 1 for yes, 0 for no
+	I PATH="" QUIT
+	S INCRES=+$G(INCRES) ; if not passed, becomes zero.
+	N FILENAME S FILENAME="RXNCONSO.RRF"
+	D DELFILED($$CONFN) ; delete data
+	N LINES S LINES=$$GETLINES(PATH,FILENAME)
+	D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
+	IF POP D EN^DDIOL("Error reading file..., Please check...") G EX
+	N C0CCOUNT
+	F C0CCOUNT=1:1 D  Q:$$STATUS^%ZISH
+	. U IO
+	. N LINE R LINE
+	. IF $$STATUS^%ZISH QUIT
+	. I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
+	. N RXCUI,RXAUI,SAB,TTY,CODE,STR  ; Fileman fields numbers below
+	. S RXCUI=$P(LINE,"|",1)	; .01
+	. S RXAUI=$P(LINE,"|",8)	; 1
+	. S SAB=$P(LINE,"|",12)	; 2
+	. ; If the source is a restricted source, decide what to do based on what's asked.
+	. N SRCIEN S SRCIEN=$$FIND1^DIC($$SRCFN,"","QX",SAB,"B") ; SrcIEN in RXNORM SOURCES file
+	. N RESTRIC S RESTRIC=$$GET1^DIQ($$SRCFN,SRCIEN,14,"I") ; 14 is restriction field; values 0-4
+	. ; If RESTRIC is zero, then it's unrestricted. Everything else is restricted.
+	. ; If user didn't ask to include restricted sources, and the source is restricted, then quit
+	. I 'INCRES,RESTRIC QUIT
+	. S TTY=$P(LINE,"|",13)	; 3
+	. S CODE=$P(LINE,"|",14)	; 4
+	. S STR=$P(LINE,"|",15)	; 5
+	. ; Remove embedded "^"
+	. S STR=$TR(STR,"^")
+	. ; Convert STR into an array of 80 characters on each line
+	. N STRLINE S STRLINE=$L(STR)\80+1
+	. ; In each line, chop 80 characters off, reset STR to be the rest
+	. N J F J=1:1:STRLINE S STR(J)=$E(STR,1,80) S STR=$E(STR,81,$L(STR))
+	. ; Now, construct the FDA array
+	. N RXNFDA
+	. S RXNFDA($$CONFN,"+1,",.01)=RXCUI
+	. S RXNFDA($$CONFN,"+1,",1)=RXAUI
+	. S RXNFDA($$CONFN,"+1,",2)=SAB
+	. S RXNFDA($$CONFN,"+1,",3)=TTY
+	. S RXNFDA($$CONFN,"+1,",4)=CODE
+	. N RXNIEN S RXNIEN(1)=C0CCOUNT
+	. D UPDATE^DIE("","RXNFDA","RXNIEN")
+	. I $D(^TMP("DIERR",$J)) D EN^DDIOL("ERROR") G EX
+	. ; Now, file WP field STR
+	. D WP^DIE($$CONFN,C0CCOUNT_",",5,,$NA(STR))
+EX	D CLOSE^%ZISH("FILE")
+	QUIT
+READSRC(PATH)	; Open the read RxNorm Sources file: RXNSAB.RRF
+	I PATH="" QUIT
+	N FILENAME S FILENAME="RXNSAB.RRF"
+	D DELFILED($$SRCFN) ; delete data
+	D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
+	IF POP W "Error reading file..., Please check...",! G EX3
+	F I=1:1 Q:$$STATUS^%ZISH  D
+	. U IO
+	. N LINE R LINE
+	. IF $$STATUS^%ZISH QUIT
+	. U $P W I,! U IO  ; Write I to the screen, then go back to reading the file
+	. N VCUI,RCUI,VSAB,RSAB,SON,SF,SVER,SRL,SCIT ; Fileman fields numbers below
+	. S VCUI=$P(LINE,"|",1)        ; .01
+	. S RCUI=$P(LINE,"|",2)        ; 2
+	. S VSAB=$P(LINE,"|",3)        ; 3
+	. S RSAB=$P(LINE,"|",4)        ; 4
+	. S SON=$P(LINE,"|",5)         ; 5
+	. S SF=$P(LINE,"|",6)          ; 6
+	. S SVER=$P(LINE,"|",7)        ; 7
+	. S SRL=$P(LINE,"|",14)		; 14
+	. S SCIT=$P(LINE,"|",25)       ; 25
+	. ; Remove embedded "^"
+	. S SCIT=$TR(SCIT,"^")
+	. ; Convert SCIT into an array of 80 characters on each line
+	. ; In each line, chop 80 characters off, reset SCIT to be the rest
+	. N SCITLINE S SCITLINE=$L(SCIT)\80+1
+	. F J=1:1:SCITLINE S SCIT(J)=$E(SCIT,1,80) S SCIT=$E(SCIT,81,$L(SCIT))
+	. ; Now, construct the FDA array
+	. N RXNFDA
+	. S RXNFDA($$SRCFN,"+"_I_",",.01)=VCUI
+	. S RXNFDA($$SRCFN,"+"_I_",",2)=RCUI
+	. S RXNFDA($$SRCFN,"+"_I_",",3)=VSAB
+	. S RXNFDA($$SRCFN,"+"_I_",",4)=RSAB
+	. S RXNFDA($$SRCFN,"+"_I_",",5)=SON
+	. S RXNFDA($$SRCFN,"+"_I_",",6)=SF
+	. S RXNFDA($$SRCFN,"+"_I_",",7)=SVER
+	. S RXNFDA($$SRCFN,"+"_I_",",14)=SRL
+	. D UPDATE^DIE("","RXNFDA")
+	. I $D(^TMP("DIERR",$J)) U $P W "ERR" G EX
+	. ; Now, file WP field SCIT
+	. D WP^DIE($$SRCFN,I_",",25,,$NA(SCIT))
+EX3	D CLOSE^%ZISH("FILE")
+	Q
+	
Index: ePrescribing/trunk/p/C0PSMEDS.m
===================================================================
--- ePrescribing/trunk/p/C0PSMEDS.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PSMEDS.m	(revision 1595)
@@ -0,0 +1,76 @@
+C0PSMEDS	  ; ERX/GPL - Utilities for eRx SendMeds; 3/1/11
+	;;1.0;C0P;;Apr 25, 2012;Build 103
+	;Copyright 2011 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
+	;
+ADD(RTNXML,G6)	; ADD SENDMEDS TO THE NCSCRIPT XML
+	N GEND,ZG1,G5,GBLD
+	M ZG1=@RTNXML
+	S GEND=$O(ZG1(""),-1)-1
+	D QUEUE^C0CXPATH("GBLD","ZG1",1,GEND) ; NCSCRIPT.. UP TO </NCScript>
+	D QUEUE^C0CXPATH("GBLD",G6,1,$O(@G6@(""),-1)) ; ADD THE MEDS
+	D QUEUE^C0CXPATH("GBLD","ZG1",GEND+1,GEND+1) ;END OF NCSCRIPT
+	D BUILD^C0CXPATH("GBLD","G5") ; BUILD THE CONTENTS FROM THE BUILD LIST
+	K @RTNXML
+	M @RTNXML=G5 ;
+	Q
+	;
+FREETXT(RXML,ZDUZ,ZDFN)	; ADD FREE TEXT MEDS FOR PATIENT ZDFN TO RXML, 
+	; PASSED BY NAME; ZDUZ IS PASSED TO RESOLVE THE TEMPLATE
+	N ZTID,ZMEDS,ZI,ZN,ZTMP,ZVARS,ZBLD,ZNM
+	S ZTID=$$RESTID^C0PWS1(ZDUZ,"FREE TEXT MEDS") ;GET TEMPLATE ID
+	D GET^C0PCUR(.ZMEDS,ZDFN) ; GET THE PATIENT'S CURRENT MEDS
+	S ZN=$O(ZMEDS(""),-1) ; COUNT OF MEDS
+	I +ZN=0 Q  ; NO MEDS, QUIT
+	F ZI=1:1:ZN D  ; FOR EACH MED
+	. N ZCMT
+	. S ZCMT=$G(ZMEDS(ZI,"COMMENTS",1))
+	. I ZCMT["E-Rx" Q  ; SKIP eRx MEDS
+	. I ZCMT["Received by" Q  ; SKIP eRx Meds
+	. I $P(ZMEDS(ZI,0),"^",9)'="ACTIVE" Q  ; ONLY WANT ACTIVE DRUGS
+	. ; GET TYPE OF DRUG
+	. N ZTYP
+	. S ZTYP=$P($P(ZMEDS(ZI,0),"^",1),";",2) ; SHOULD BE AN I OR O
+	. I ZTYP="I" Q  ; DON'T WANT INPATIENT MEDS
+	. S ZNM=$NA(ZTMP(ZI)) ; PLACE TO PUT THIS MED XML
+	. N ZDATE
+	. S ZDATE=$G(ZMEDS(ZI,"START"))
+	. I ZDATE'="" D  ; TRANSLATE FM DATE TO YYYYMMDD
+	. . S ZDATE=$$FMDTOUTC^C0CUTIL(ZDATE,"D")
+	. . S ZDATE=$TR(ZDATE,"-") ;REMOVE DASHES FROM DOB
+	. I ZDATE="" S ZDATE=""
+	. S ZVARS("date")=ZDATE
+	. S ZVARS("dispenseNumber")=0
+	. S ZVARS("doctorName")=$P($G(ZMEDS(ZI,"P",0)),"^",2)
+	. S ZVARS("drug")=$P(ZMEDS(ZI,0),"^",2) ; NAME OF THE MED
+	. N ZEXID
+	. S ZEXID=$G(ZMEDS(ZI,"NVAIEN"))
+	. I ZEXID="" S ZEXID="MED_"_$G(ZMEDS(ZI,"DRUG")) ; THE MED NUMBER
+	. S ZVARS("externalId")=ZEXID
+	. S ZVARS("prescriptionType")="reconcile"
+	. S ZVARS("refillCount")=0
+	. S ZVARS("sig")=$G(ZMEDS(ZI,"SIG",1,0))
+	. S ZVARS("sig")=$TR(ZVARS("sig"),"'")
+	. D MAP^C0PMAIN(ZNM,"ZVARS",ZTID) ; GENERATE XML FOR 1 MED
+	. ;B
+	. D QUEUE^C0CXPATH("ZBLD",ZNM,1,@ZNM@(0)) ; ADD TO BUILD LIST
+	I +$D(ZBLD)=0 Q  ; NO NON-ERX MEDS
+	D BUILD^C0CXPATH("ZBLD",RXML) ; BUILD ALL THE MEDS
+	Q
+	;
Index: ePrescribing/trunk/p/C0PSUB.m
===================================================================
--- ePrescribing/trunk/p/C0PSUB.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PSUB.m	(revision 1595)
@@ -0,0 +1,351 @@
+C0PSUB	  ; ERX/GPL - ERX SUBSCRIBER utilities; 5/8/12 9:51pm
+	;;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.
+	;
+	QUIT
+EN(INARY,C0PDUZ)	; creates the array inary passed by name for subscriber
+	; variables, mostly from the new person file
+	; SUBSCRIBER-FAMILY-NAME
+	; SUBSCRIBER-GIVEN-NAME
+	; SUBSCRIBER-MIDDLE-NAME
+	; LOCATION-PHONE
+	; LOCATION-FAX
+	; ACCOUNT-PHONE
+	; ACCOUNT-FAX
+	; LOCATION-ADDRESS1
+	; LOCATION-ADDRESS2
+	; LOCATION-CITY
+	; LOCATION-ZIP
+	; LOCATION-ZIP4
+	; LOCATION-STATE
+	; SUBSCRIBER-LICENSE
+	; SUBSCRIBER-LICENSE-STATE
+	; SUBSCRIBER-USERROLE
+	; SUBSCRIBER-USER
+	; ACCOUNT-COUNTRY
+	; ACCOUNT-ADDRESS-ZIP4
+	; LOCATION-COUNTRY
+	; REQUESTED-PAGE
+	D FAMILY(INARY,"SUBCRIBER-FAMILY-NAME",C0PDUZ)
+	D GIVEN(INARY,"SUBCRIBER-GIVEN-NAME",C0PDUZ)
+	D MIDDLE(INARY,"SUBCRIBER-MIDDLE-NAME",C0PDUZ)
+	D PHONEFAX(INARY,C0PLOC) ; SETS "LOCATION-PHONE" AND "LOCATION-FAX"
+	D ACTPHFAX(INARY,C0PACCT) ;SETS "ACCOUNT-PHONE" AND "ACCOUNT-FAX" 
+	D GETLOC(INARY,C0PLOC) ;SETS "LOCATION-" VARIABLES (SEE ROUTINE FOR LIST)
+	D STLIC(INARY,C0PDUZ,C0PACCT) ;LICENSE AND LICENSE STATE
+	S C0PAF=113059002 ; FILE NUMBER FOR ACCOUNT FILE
+	S @INARY@("ACCOUNT-PARTNERNAME")=$$GET1^DIQ(C0PAF,C0PACCT_",",3.1) ;
+	I @INARY@("ACCOUNT-PARTNERNAME")="" S @INARY@("ACCOUNT-PARTNERNAME")="demo"
+	; todo: NPs, PAs, assistants need different roles
+	D SETACCT(INARY,C0PDUZ) ; SET SUBSCRIBER VARIABLES
+	;S @INARY@("SUBSCRIBER-USERROLE")="doctor" ; BASE CASE ACCESS
+	;S @INARY@("SUBSCRIBER-USER")="LicensedPrescriber" ; BASE CASE ACCESS
+	S @INARY@("ACCOUNT-COUNTRY")="US" ;BASE CASE ACCESS
+	S @INARY@("ACCOUNT-ADDRESS-ZIP4")="" ;DON'T HAVE THIS
+	S @INARY@("LOCATION-COUNTRY")="US" ; NOT IN FILE
+	S @INARY@("REQUESTED-PAGE")="compose" ; DEFAULT PAG
+	S @INARY@("ACCOUNT-ACCOUNTID")=$$GET1^DIQ(C0PAF,C0PACCT_",",2.4)
+	I @INARY@("ACCOUNT-ACCOUNTID")="" S @INARY@("ACCOUNT-ACCOUNTID")="demo"
+	S @INARY@("ACCOUNT-NAME")=$$GET1^DIQ(C0PAF,C0PACCT_",",3)
+	I @INARY@("ACCOUNT-NAME")="" S @INARY@("ACCOUNT-NAME")="demo"
+	S @INARY@("ACCOUNT-PASSWORD")=$$GET1^DIQ(C0PAF,C0PACCT_",",3.2)
+	I @INARY@("ACCOUNT-PASSWORD")="" S @INARY@("ACCOUNT-PASSWORD")="demo"
+	;S @INARY@("SUBSCRIBER-USERTYPE")="Doctor" ; IS RESET LATER
+	;S @INARY@("SUBSCRIBER-USERID")="demo" ; IS RESET LATER
+	;N NPI S NPI=$$NPI^XUSNPI("Individual_ID",C0PDUZ)
+	;S @INARY@("SUBSCRIBER-SID")=+NPI ; FOR NOW
+	;
+	Q
+	;
+ACTPHFAX(RARY,ZACCT)	;SET ACCOUNT PHONE AND FAX FROM ACCOUNT FILE
+	; ZACCT IS A POINTER TO THE ACCOUNT FILE
+	S C0PAF=113059002 ; FILE NUMBER FOR ACCOUNT FILE
+	S @RARY@("ACCOUNT-PHONE")=$$GET1^DIQ(C0PAF,ZACCT_",",2.2) ;PHONE NUMBER
+	S @RARY@("ACCOUNT-FAX")=$$GET1^DIQ(C0PAF,ZACCT_",",2.1) ; FAX NUMBER
+	Q
+	;
+PHONEFAX(RARY,C0PLOC)	; SET LOCATION PHONE AND FAX INTO THE RETURN ARRAY
+	N PRIORITY,LOCIEN
+	S PRIORITY=$O(^SC(C0PLOC,"C0P","PRIORITY",""))
+	I PRIORITY="" W "NO LOCATION PHONE SET",! Q
+	S LOCIEN=$O(^SC(C0PLOC,"C0P","PRIORITY",PRIORITY,""))
+	S C0PLOCF=44.113059
+	S @RARY@("LOCATION-PHONE")=$$GET1^DIQ(C0PLOCF,LOCIEN_","_C0PLOC_",",1)
+	S @RARY@("LOCATION-FAX")=$$GET1^DIQ(C0PLOCF,LOCIEN_","_C0PLOC_",",2)
+	Q
+	;
+GETLOC(RARY,ZLOC)	; GETS LOCATIONS VARIABLE FROM POINTER ZLOC
+	; TO THE HOSPITAL LOCATION FILE
+	; THE LOCATION ADDRESS IS FOUND IN NEW FIELDS IN THE HOSPITAL LOCATION FILE 44
+	; IF THESE ARE NULL, THE ADDRESS WILL BE TAKEN FROM THE INSTITUTION FILE,
+	; WHICH IS POINTED TO BY THE FILE 44
+	; 
+	S @RARY@("LOCATION-SITEID")="LOCATION_"_ZLOC ; SITE ID
+	S @RARY@("LOCATION-ADDRESS1")=$$GET1^DIQ(44,ZLOC_",",113059111) ;ADDR1
+	I @RARY@("LOCATION-ADDRESS1")'="" D  ; ADDRESS PRESENT IN 44
+	. S @RARY@("LOCATION-ADDRESS2")=$$GET1^DIQ(44,ZLOC_",",113059112) ;ADDR2
+	. S @RARY@("LOCATION-CITY")=$$GET1^DIQ(44,ZLOC_",",113059114) ;CITY
+	. S @RARY@("LOCATION-ZIP")=$$GET1^DIQ(44,ZLOC_",",113059116) ;ZIP
+	. S @RARY@("LOCATION-ZIP4")="" ;NO ZIP4
+	. N ZJ
+	. S ZJ=$$GET1^DIQ(44,ZLOC_",",113059115,"I") ;STATE
+	. S @RARY@("LOCATION-STATE")=$$GET1^DIQ(5,ZJ_",",1) ;STATE ABBREVIATION
+	E  D  ; TAKE THE ADDRESS FROM THE INSTITUTION FILE
+	. N ZI
+	. S ZI=$$GET1^DIQ(44,ZLOC_",",3,"I") ; POINTER TO INSTITUTION FILE
+	. S @RARY@("LOCATION-ADDRESS1")=$$GET1^DIQ(4,ZI_",",1.01) ;ADDR1
+	. S @RARY@("LOCATION-ADDRESS2")=$$GET1^DIQ(4,ZI_",",1.02) ;ADDR2
+	. S @RARY@("LOCATION-CITY")=$$GET1^DIQ(4,ZI_",",1.03) ;CITY
+	. S @RARY@("LOCATION-ZIP")=$$GET1^DIQ(4,ZI_",",1.04) ;ZIP
+	. S @RARY@("LOCATION-ZIP4")="" ;NO ZIP4
+	. N ZJ
+	. S ZJ=$$GET1^DIQ(4,ZI_",",.02,"I") ;STATE
+	. S @RARY@("LOCATION-STATE")=$$GET1^DIQ(5,ZJ_",",1) ;STATE ABBREVIATION
+	Q
+	;
+SUBINIT(C0PDUZ)	; 
+	; SUBSCRIPTIONS MULTIPLE IN NEW PERSON
+	S C0PAF=113059002 ; FILE NUMBER FOR ACCOUNT FILE
+	S C0PSUBF=200.113059 ; SUBFILE NUMBER OF C0P SUBSCRIPTION MULTIPLE
+	S C0PSIEN=$O(^VA(200,C0PDUZ,"C0P","B","ERX","")) ; ERX SUBFILE IEN
+	Q C0PSIEN
+	;
+HASLIC(ZDUZ)	;EXTRINSIC TO CHECK IF PERSON HAS ANY STATE LICENSES
+	;
+	Q ''$O(^VA(200,ZDUZ,"PS1","B",""))
+	;
+GLICST(ZACCT)	;EXTRINSIC WHICH RETURNS THE POINTER TO THE STATE
+	;WHICH IS THE PREFERED LICENSE STATE IN THE ACCOUNT PASSED IN ZACCT
+	S C0PAF=113059002 ; FILE NUMBER FOR ACCOUNT FILE
+	Q $$GET1^DIQ(C0PAF,ZACCT_",",5,"I")
+	;
+STLIC(ZARY,ZDUZ,ZACCT)	;ADDS SUBSCRIBER-LICENSE AND SUBSCRIBER-LICENSE-STATE
+	; TO ZARY, PASSED BY NAME BY LOOKING IN THE STATE LICENSE MULTIPLE
+	; OF THE NEW PERSON FILE FOR THE PREFERED STATE AS FOUND BY GLICST ABOVE
+	; FROM THE ACCOUNT NUMBER ZACCT
+	; IF THE PREFERED STATE IS NOT FOUND, THE FIRST STATE LISTED IS USED
+	I '$$HASLIC(ZDUZ) D  ; NEW PERSON ZDUZ HAS NO STATE LICENSES DEFINED
+	. S @ZARY@("SUBSCRIBER-LICENSE")="" ; NULL LICENSE
+	. S @ZARY@("SUBSCRIBER-LICENSE-STATE")="" ;NULL LICENSE STATE
+	E  D  ; THERE IS A LICENSE
+	. N ZST,ZIEN
+	. S ZST=$$GLICST(ZACCT) ; GET PREFERED LICENSE STATE FROM ACCOUNT FILE
+	. S ZIEN=$O(^VA(200,ZDUZ,"PS1","B",ZST,"")) ;IEN OF PREFERED STATE
+	. I ZIEN="" D  ; PREFERED STATE NOT FOUND
+	. . ; todo: use get1^diq here instead of looping through global
+	. . S ZST=$O(^VA(200,ZDUZ,"PS1","B","")) ; FIRST STATE IN MULTIPLE
+	. . S ZIEN=$O(^VA(200,ZDUZ,"PS1","B",ZST,"")) ; IEN OF FIRST STATE
+	. S @ZARY@("SUBSCRIBER-LICENSE")=$$GET1^DIQ(200.541,ZIEN_","_ZDUZ_",",1) ;LIC
+	. ; Try this...
+	. ; N ZG S ZG=$$GET1^DIQ(200.541,ZIEN_","_ZDUZ_",","LICENSING STATE:ABBREVIATION")
+	. N ZG S ZG=$$GET1^DIQ(200.541,ZIEN_","_ZDUZ_",",.01,"I") ;STATE POINTER
+	. S ZG=$$GET1^DIQ(5,ZG_",",1) ; STATE ABBREVIATION
+	. S @ZARY@("SUBSCRIBER-LICENSE-STATE")=ZG
+	Q
+FAMILY(RARY,TAG,C0PDUZ)	; SETS @RARY@(TAG) TO FAMILY NAME OF DUZ
+	;USING KERNAL ROUTINE IN CCR PACKAGE. RARY IS PASSED BY NAME.
+	S @RARY@(TAG)=$$FAMILY^C0CVA200(C0PDUZ)
+	Q
+	;
+GIVEN(RARY,TAG,C0PDUZ)	; SETS @RARY@(TAG) TO GIVEN NAME OF SUBSCRIBER
+	; USING KERNAL ROUTINE IN CCR PACKAGE. RARY IS PASSED BY NAME
+	S @RARY@(TAG)=$$GIVEN^C0CVA200(C0PDUZ)
+	Q
+	;
+MIDDLE(RARY,TAG,C0PDUZ)	; SETS @RARY@(TAG) TO MIDDLE NAME OF SUBSCRIBER
+	; USING KERNAL ROUTINE IN CCR PACKAGE. RARY IS PASSED BY NAME
+	S @RARY@(TAG)=$$MIDDLE^C0CVA200(C0PDUZ)
+	Q
+	;
+STATUS(C0PDUZ,SERVICE)	; $$ Private EP - Check Prescriber's ability to use Service
+	; FILEMAN USES THIS CALL. Field Status in C0P Subscription Multiple is
+	; + a computed field.
+	; gpl - changed the order of this Algorithm to do NPI and DEA last
+	; because they are not required for all user type and roles
+	; Algorithm as follows:
+	; 1. Check existence of DEA# or Institutional DEA + VA#
+	; 2. Check existence of NPI
+	; 3. Check for at least one license in the licensure subfile in 200
+	; 4. Check if a C0P Subscription for SERVICE in subfile C0P in 200 exists
+	; 5. Check if a C0P Subscription for points to a valid account
+	; 6. Check if a C0P Location is defined
+	; 7. Make sure that the service is not disabled for the user.
+	; 8. Check if the pointed to location has a phone and fax number filled in.
+	; -- Output --
+	; 1^ACTIVE --> Everything is fine
+	; 0^NO DEA^NO NPI^NO LICENSE^NO SUBSCRIPTION^NO SUBSCRIPTION ACCOUNT^
+	; + NO SUBSCSRIPTION LOCATION^SUBSCSRIBER IS DISABLED^LOCATION NOT SETUP
+	N RETURN
+	S RETURN="0" ; default case
+	; --> step 4, see if there's an entry for the service IEN
+	N C0PVARS
+	N SERVIEN S SERVIEN=$O(^VA(200,C0PDUZ,"C0P","B",SERVICE,""))
+	I $L(SERVIEN)=0 S RETURN=RETURN_"^NO SUBSCRIPTION"
+	D:SERVIEN
+	. ; --> step 5, see if the service points to a valid account
+	. N ACCOUNT S ACCOUNT=$$GET1^DIQ(200.113059,SERVIEN_","_C0PDUZ_",",1)
+	. I $L(ACCOUNT)=0 S RETURN=RETURN_"^NO SUBSCSRIPTION ACCOUNT"
+	. ; --> step 6, see if the service points to a valid location
+	. ; internal will return the IEN for use in a call below.
+	. N LOCATION S LOCATION=$$GET1^DIQ(200.113059,SERVIEN_","_C0PDUZ_",",2,"I")
+	. I $L(LOCATION)=0 S RETURN=RETURN_"^NO SUBSCSRIPTION LOCATION"
+	. ; --> step 7, see if the user is disabled from service
+	. ; Internal will return 1 or 0, 1 for yes
+	. N DISABLED S DISABLED=$$GET1^DIQ(200.113059,SERVIEN_","_C0PDUZ_",",3,"I")
+	. I +DISABLED S RETURN=RETURN_"^SUBSCSRIBER IS DISABLED"
+	. ; --> step 8, see if at least one set of location 
+	. ; + phone and fax numbers have been set-up
+	. D:LOCATION
+	. . N PHONE,FAX,ARY
+	. . D PHONEFAX("ARY",LOCATION) ; GET THE LOCATION PHONE AND FAX
+	. . ;S PHONE=$$GET1^DIQ(44.113059,"1,"_LOCATION_",",1) ;this doesn't work
+	. . ;S FAX=$$GET1^DIQ(44.113059,"1,"_LOCATION_",",2) ; because of the 1
+	. . S PHONE=$G(ARY("LOCATION-PHONE")) ; PHONE IF ANY
+	. . S FAX=$G(ARY("LOCATION-FAX")) ; FAX IF ANY
+	. . I ($L(PHONE)=0)!($L(FAX)=0) S RETURN=RETURN_"^LOCATION NOT SETUP"
+	. D SETACCT("C0PVARS",C0PDUZ) ; INITIALIZE ARRAY
+	. ; --> step 1: DEA
+	. ;N DEA S DEA=$$DEA^XUSER("",C0PDUZ)
+	. ;I $L(DEA)=0 S RETURN=RETURN_"^NO DEA"
+	. I C0PVARS("SUBSCRIBER-DEA")="NONE" D  ;
+	. . I C0PTYPE="P" S RETURN=RETURN_"^NO DEA" ; ONLY PRESCRIBERS NEED DEA
+	. ; --> step 2: NPI
+	. ;N NPI S NPI=$$NPI^XUSNPI("Individual_ID",C0PDUZ)
+	. ;I +NPI<0 S RETURN=RETURN_"^NO NPI"
+	. I C0PVARS("SUBSCRIBER-NPI")="NONE" D  ;
+	. . I C0PTYPE="P" S RETURN=RETURN_"^NO NPI" ; ONLY PRESCRIBERS NEED DEA
+	. ; --> step 3, get first license # in license multiple
+	. N LIC S LIC=$$HASLIC(C0PDUZ)
+	. I 'LIC D  ;
+	. . I (C0PTYPE="P")!(C0PROLE="N") S RETURN=RETURN_"^NO LICENSE" ; 
+	. . ; PRESCRIBERS AND NURSES NEED LICENSE
+	; If Retrun is still 0 and nothing else, then we are good.
+	I RETURN="0" S RETURN="1^ACTIVE"
+	QUIT RETURN  ; <-- END $$STATUS
+	; 
+STATUS2	; Private Procedure for interactive check of status
+	N DIC,X,Y,DLAYGO,DTOUT,DUOUT
+	S DIC=200,DIC(0)="AEMQ",DIC("A")="Select New Person: "
+	D ^DIC
+	I Y<0 QUIT
+	N C0PDUZ S C0PDUZ=+Y
+	; Then which service are we checking for
+	; Grab this from the DD
+	N DIR,X,Y,DA,DTOUT,DUOUT,DIRUT,DIROUT
+	S DIR(0)="200.113059,.01"
+	S DIR("A")="Select Subcription Service"
+	D ^DIR
+	I $G(DIRUT) QUIT
+	N C0PSERV S C0PSERV=Y
+	N STATUS S STATUS=$$STATUS^C0PSUB(C0PDUZ,C0PSERV)
+	D EN^DDIOL("Status: "_$TR($P(STATUS,U,2,99),U,", "))
+	QUIT
+	;
+SETACCT(C0PRTN,C0PDUZ)	; RETURN ALL SUBSCRIBER SETTINGS FOR
+	; GENERATING XML AND VERIFYING A COMPLETE SETUP
+	; ALSO, INITIALIZE NULL FIELDS WITH DEFAULTS
+	; C0PRTN IS PASSED BY NAME
+	; C0PSERV IS USUALLY "ERX" FOR EPRESCRIBING
+	;
+	;USER TYPE
+	;
+	;P LicensedPrescriber
+	;S Staff
+	;M MidlevelPrescriber
+	;V SupervisingDoctor 
+	;
+	;USER ROLE
+	;
+	;D doctor
+	;N nurse
+	;A admin
+	;M manager
+	;SD supervisingDoctor
+	;MP midlevelPrescriber      
+	;
+	;Requested Page
+	;
+	;C compose
+	;A admin
+	;M manager
+	;S status
+	;ME medentry
+	;P patientDetail
+	;H maintainHealthplans
+	;R reports-rx-daily    
+	;
+	N ZI,ZJ
+	D SETUP^C0PMAIN() ; INITIALIZE VARIABLES
+	I ERXSERVIEN="" Q  ; PERSON NOT SUBSCRIBED
+	S C0PTYPE=$$GET1^DIQ($$F200C0P^C0PMAIN(),ERXSERVIEN_","_C0PDUZ_",",4,"I")
+	S C0PROLE=$$GET1^DIQ($$F200C0P^C0PMAIN(),ERXSERVIEN_","_C0PDUZ_",",4.1,"I")
+	S C0PPAGE=$$GET1^DIQ($$F200C0P^C0PMAIN(),ERXSERVIEN_","_C0PDUZ_",",4.2,"I")
+	N C0PSV ; SUPERVISING DOCTOR DUZ
+	S C0PSV=$$GET1^DIQ($$F200C0P^C0PMAIN(),ERXSERVIEN_","_C0PDUZ_",",6,"I")
+	; FIELD 6 IS SUPERVISING DOCTOR. USED FOR MIDLEVEL RENEWAL PROCESSING
+	I $G(C0PSV)'="" D  ; IF THERE IS A SUPERVISING DOCTOR
+	. S @C0PRTN@("SUPERVISING-DOCTOR-DUZ")=C0PSV ; RECORD FOR LATER USE
+	I C0PTYPE="" D  ; SUBSCRIBER TYPE NOT SET
+	. I C0PROLE="N" S C0PTYPE="S" ; DEFAULT FOR NURSE IS STAFF
+	. E  S C0PTYPE="P" ; ELSE DEFAULT TYPE IS LICENSEDPRESCRIBER
+	. K C0PFDA
+	. S C0PFDA($$F200C0P^C0PMAIN,ERXSERVIEN_","_C0PDUZ_",",4)=C0PTYPE ;SET TYPE
+	. D UPDIE ; SET THE SUBSCRIBER TYPE
+	I C0PROLE="" D  ; SUBSCRIBER ROLE NOT SET
+	. I C0PTYPE="P" S C0PROLE="D" ; DOCTOR IS DEFAULT FOR LICENSED PRESCRIBER
+	. E  S C0PROLE="N" ; ALL OTHERS SET TO NURSE
+	. K C0PFDA
+	. S C0PFDA($$F200C0P^C0PMAIN,ERXSERVIEN_","_C0PDUZ_",",4.1)=C0PROLE ;SET ROLE
+	. D UPDIE ; SET THE SUBSCRIBER ROLE
+	I C0PPAGE="" D  ;
+	. I C0PTYPE="P" S C0PPAGE="C" ; PRESCRIBERS TO COMPOSE PAGE
+	. E  S C0PPAGE="P" ; ALL OTHERS DEFAULT TO PATIENT DETAIL PAGE
+	. K C0PFDA
+	. S C0PFDA($$F200C0P^C0PMAIN,ERXSERVIEN_","_C0PDUZ_",",4.2)=C0PPAGE ;SET PAGE
+	. D UPDIE ; SET THE REQUESTED PAGE
+	N ZF S ZF=$$F200C0P^C0PMAIN()
+	S @C0PRTN@("REQUESTED-PAGE")=$$GET1^DIQ(ZF,ERXSERVIEN_","_C0PDUZ_",",4.2)
+	S @C0PRTN@("SUBSCRIBER-USERROLE")=$$GET1^DIQ(ZF,ERXSERVIEN_","_C0PDUZ_",",4.1)
+	S @C0PRTN@("SUBSCRIBER-USERTYPE")=$$GET1^DIQ(ZF,ERXSERVIEN_","_C0PDUZ_",",4)
+	S C0PSID=$$GET1^DIQ(ZF,ERXSERVIEN_","_C0PDUZ_",",5)
+	I C0PSID="" D  ; SUBSCRIBER ID NOT SET
+	. S C0PSID=$$UUID^C0CUTIL ; SET TO RANDOM UUID
+	. K C0PFDA
+	. S C0PFDA($$F200C0P^C0PMAIN,ERXSERVIEN_","_C0PDUZ_",",5)=C0PSID ;SET SID
+	. D UPDIE ; SET SUBSCRIBER ID
+	N NPI S NPI=+$$NPI^XUSNPI("Individual_ID",C0PDUZ)
+	I NPI=-1 S NPI="NONE"
+	S @C0PRTN@("SUBSCRIBER-NPI")=NPI
+	N DEA S DEA=$$DEA^XUSER("",C0PDUZ)
+	I $L(DEA)=0 S DEA="NONE"
+	S @C0PRTN@("SUBSCRIBER-DEA")=DEA
+	;N C0PNPIF ; NPI FOR SID LEGACY FLAG - DON'T NEW THIS, IT'S NEEDED LATER
+	S C0PNPIF=$$GET1^DIQ(C0PAF,C0PACCT_",",8,"I") ; LEGACY FLAG TO USE NPI FOR SID
+	I C0PNPIF'=1 S @C0PRTN@("SUBSCRIBER-SID")=C0PSID ; IF NO FLAG, USE GUID
+	E  D  ; IF LEGACY FLAG IS ON, USE NPI FOR SID
+	. S @C0PRTN@("SUBSCRIBER-SID")=NPI
+	. I NPI="NONE" S @C0PRTN@("SUBSCRIBER-SID")="USER"_C0PDUZ ; IF NO NPI
+	Q
+	; 
+UPDIE	  ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+	K ZERR
+	D CLEAN^DILF
+	D UPDATE^DIE("","C0PFDA","","ZERR")
+	I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
+	K C0PFDA
+	Q
Index: ePrescribing/trunk/p/C0PTEST1.m
===================================================================
--- ePrescribing/trunk/p/C0PTEST1.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PTEST1.m	(revision 1595)
@@ -0,0 +1,15 @@
+C0PTEST1 ; VEN/SMH - Scratch routine for testing ; 12/6/09 9:54pm
+ ;;0.1;C0P;nopatch;noreleasedate
+ Q
+ ; The stuff below is to walk through all entries and test test test
+T0
+ D WALK^DICW(1130590010,"W DICWIENS,!")
+ Q
+T1
+ ; dicwiens
+ ; DICWHEAD
+ D WALK^DICW(1130590010,"W $$GCN^C0PLKUP($P(^(0),U)),!")
+ Q
+T2
+ D WALK^DICW(1130590010,"W:+DICWIENS<1000 $$RXNCUI^C0PLKUP($P(^(0),U,2)),!")
+ Q
Index: ePrescribing/trunk/p/C0PTRAK.m
===================================================================
--- ePrescribing/trunk/p/C0PTRAK.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PTRAK.m	(revision 1595)
@@ -0,0 +1,128 @@
+C0PTRAK	  ;KBAZ/ZAG/GPL - eRx debugging utilities; 4/1/2012 ; 5/8/12 5:12pm
+	;;1.0;C0P;;Apr 25, 2012;Build 84
+	;Copyright 2012 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.
+	;
+	QUIT  ;do not call from the top
+	;
+	;INTRP(JOB) ;send interrupt to an interactive job.
+	;
+LOG(JOB,TAG)	;send interrupt and log results
+	;copied from ZJOB to here for silently interrupting one job.
+	N $ET,$ES S $ET="D IRTERR^ZJOB"
+	; shouldn't interrupt ourself, but commented out to test
+	;I JOB=$JOB Q 0
+	;We need a LOCK to guarantee commands from two processes don't conflict
+	N X,OLDINTRPT,TMP,ZSYSCMD,ZPATH,%J
+	L +^XUTL("XUSYS","COMMAND"):10 Q:'$T 0
+	;
+	S ^XUTL("XUSYS","COMMAND")="EXAM",^("COMMAND",0)=$J_":"_$H
+	K ^XUTL("XUSYS",JOB,"JE")
+	S OLDINTRP=$ZINTERRUPT,%J=$J
+	S TMP=0,$ZINTERRUPT="S TMP=1"
+	;
+	;convert PID for VMS systems
+	I $ZV["VMS" D
+	. S JOB=$$FUNC^%DH(JOB,8)
+	. S %J=$$FUNC^%DH(%J,8)
+	;
+	S ZSYSCMD="mupip intrpt "_JOB_" > /dev/null 2>&1" ; interrupt other job
+	I $ZV["VMS" S ZPATH="@gtm$dist:"  ; VMS path
+	E  S ZPATH="$gtm_dist/" ;Unix path
+	ZSYSTEM ZPATH_ZSYSCMD ; System Request
+	;Now send to self
+	; wait is too long 60>>30
+	H 1 S TMP=1 ; wait for interrupt, will set TMP=1
+	;
+	; Restore old $ZINTERRPT
+	S $ZINTERRUPT=OLDINTRP
+	K ^XUTL("XUSYS","COMMAND") ;Cleanup
+	L -^XUTL("XUSYS","COMMAND")
+	;get values to report back on
+	K ^TMP("C0PERXLOG",JOB)
+	M ^TMP("C0PERXLOG",JOB)=^XUTL("XUSYS",JOB) ;merge off array for reporting
+	S ^TMP("C0PERXLOG",JOB,"LOGPOINT")=$G(TAG)
+	;
+	;D LOG(JOB) ;create the C0PLOG
+	;K ^C0PTRAK(JOB) ;clean up temp log
+	;
+	QUIT  ;end of INTRP
+	;
+NEWLOG(JOB,TAG)	;report on JOB interrupted
+	; TAG identifies the location creating the log. it is text
+	K ^C0PLOG(JOB)
+	N VARLOG ;build variable log array for further inspection
+	N VARTYP S VARTYP=""
+	F  D  Q:VARTYP=""
+	. S VARTYP=$O(^KBAZ(JOB,VARTYP)) ;type of variable
+	. Q:VARTYP=""  ;exit if no more variable are types found
+	. N VARCNT S VARCNT=""
+	. F  D  Q:'VARCNT
+	. . S VARCNT=$O(^KBAZ(JOB,VARTYP,VARCNT)) ;variable count
+	. . Q:'VARCNT  ;exit if no more variables are found
+	. . N VAR S VAR=$G(^KBAZ(JOB,VARTYP,VARCNT)) ;get the variable
+	. . N VARNM S VARNM=$P(VAR,"=") ;variable name
+	. . N VARIABLE S VARIABLE=$P(VAR,"=",2)
+	. . S VARIABLE=$TR(VARIABLE,"""") ;remove the extra quotes
+	. . S VARLOG(VARNM)=VARIABLE ;variable
+	. . N %H S %H=$G(VARLOG("$HOROLOG")) ;current $H
+	. . N PC S PC=$G(VARLOG("IO(""CLNM"")")) ;pc/client name
+	. . N IP S IP=$G(VARLOG("IO(""GTM-IP"")")) ;pc/client IP address
+	. . N USER S USER=$G(VARLOG("DUZ")) ;current user
+	. . N CURPAT S CURPAT=$G(VARLOG("VALUE(2)")) ;current patient
+	. . ;
+	. . ;build the final log
+	. . S ^TMP("C0PERXLOG",JOB,"LOGPOINT")=$G(TAG)
+	. . S ^TMP("C0PERXLOG",JOB,"TIME")=$$HTE^XLFDT(%H)
+	. . S ^TMP("C0PERXLOG",JOB,"CLNM")=PC
+	. . S ^TMP("C0PERXLOG",JOB,"IP")=IP
+	. . S ^TMP("C0PERXLOG",JOB,"DUZ")=USER
+	. . S ^TMP("C0PERXLOG",JOB,"PT")=CURPAT
+	;
+	QUIT  ;end of LOG
+	;
+	;
+UNLOG(JOB)	; clean up a log entry
+	K ^TMP("C0PERXLOG",JOB)
+	Q
+	;
+RUNAWAY	; called from Batch to kill runaway eRx jobs
+	; looks at every entry in the table looking for marked jobs to kill
+	; if a job is not marked, it will mark it so that next time it 
+	; will be killed. 
+	; This insures that jobs logged to the table have at least 15 minutes
+	; to unlog or they will be killed. 
+	; this is implemented to catch and kill runaway eRX webservice calls
+	; uses STOP^XVJK($JOB) written by Zach Gonzales to kill jobs in GT.M linux
+	; gpl 4/18/2012
+	;
+	N GN,ZI
+	S GN=$NA(^TMP("C0PERXLOG"))
+	S GNOLD=$NA(^TMP("C0POLDLOG"))
+	S ZI=""
+	F  S ZI=$O(@GN@(ZI)) Q:+ZI=0  D  ; for every entry in the table
+	. I $D(@GN@(ZI,"KILLED")) Q  ; job already killed
+	. I $D(@GN@(ZI,"MARKED")) D  Q  ; found a job to kill then quit
+	. . D STOP^XVJK(ZI) ; kill the job
+	. . S @GN@(ZI,"KILLED")=$$NOW^XLFDT ; record the kill
+	. . S @GN@(ZI,"KILLEDBY")=DUZ
+	. . M @GNOLD@(ZI,$H)=@GN@(ZI)
+	. . K @GN@(ZI)
+	. S @GN@(ZI,"MARKED")=$$NOW^XLFDT ; mark for a kill next time
+	Q
+	;
+EOR	;end of C0PTRAK
Index: ePrescribing/trunk/p/C0PTRXN.m
===================================================================
--- ePrescribing/trunk/p/C0PTRXN.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PTRXN.m	(revision 1595)
@@ -0,0 +1,384 @@
+C0PTRXN	  ; ERX/GPL - Med file eRx analysis routines ; 7/10/10 ; 5/9/12 12:13am
+	;;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
+	;
+	; gpl 7/2010 - these routines are to test the Drug file mappings 
+	; to see how well they will work for eRx. None of this code is needed
+	; for operation of the eRx Package. It is for analysis, debugging and future
+	; development
+	;
+FDBFN()	Q 1130590010 ; First Databank Drugs file number
+RXNFN()	Q 1130590011.001 ; RxNorm Concepts file number
+T1	; TEST1
+	N ZI
+	S ZI=""
+	F  S ZI=$O(^C0P("FDB","B",ZI)) Q:ZI=""  D  ;
+	. N ZGCN,ZRXNCUI,ZNAME,ZVAIEN,ZDRUGIEN
+	. S (ZGCN,ZRXNCUI,ZNAME,ZVAIEN,ZDRUGIEN)=""
+	. S ZGCN=$$GCN^C0PLKUP(ZI)
+	. S ZRXNCUI=$$RXNCUI^C0PLKUP(ZGCN)
+	. I ZRXNCUI'="" S ZVUID=$$VUID^C0PLKUP(ZRXNCUI)
+	. E  S ZRXNCUI="NONE"
+	. S ZNAME=$$FULLNAME^C0PLKUP(ZI)
+	. I ZVUID'="" S ZVAIEN=$$VAPROD^C0PLKUP(ZVUID)
+	. I ZVAIEN'="" S ZDRUGIEN=$$DRUG^C0PLKUP(ZVAIEN)
+	. E  S ZDRUGIEN="N/A"
+	. W !,ZI," ",ZGCN," ",ZRXNCUI," ",ZVUID," ",ZVAIEN," ",ZDRUGIEN," ",ZNAME
+	Q
+	; OK, T1 IS JUST SOME EXPLORITORY WORK. TIME TO GET ORGANIZED
+	;
+TEST	;
+	;
+	S GARY=$NA(^TMP("C0PRXN","TYPE2"))
+	S GOUT=$NA(^TMP("C0POUT"))
+	K @GOUT
+	D RNF2CSV^C0CRNF(GOUT,GARY,"VN") ; TURN TYPE 2 INTO A CSV 
+	D FILEOUT^C0CRNF(GOUT,"TYPE2_TEST.csv")
+	Q
+	;
+INDEX2	; ADD AN INDEX TO TYPE2 DRUGS OF THE VUID
+	; FOR USE IN FINDING THE CURRENT VA->FDB MAPPING STATUS
+	N ZI S ZI=""
+	N ZBASE
+	S ZBASE=$NA(^TMP("C0PRXN","TYPE2","V")) ; TYPE2 DRUGS ARE HERE
+	S ZINDEX=$NA(^TMP("C0PRXN","TYPE2","INDEX")) ; PUT THE INDEX HERE
+	F  S ZI=$O(@ZBASE@(ZI)) Q:ZI=""  D  ;
+	. N ZVUIDS,ZVUID
+	. S ZVUIDS=@ZBASE@(ZI,"VUID",1) ; LIST OF VUIDS ^ SEPARATED
+	. N ZN S ZN=@ZBASE@(ZI,"VANAME",1)_"^"_@ZBASE@(ZI,"FDBNAME",1)
+	. I ZVUIDS["^" D  ;
+	. . N ZJ S ZJ=""
+	. . F  S ZJ=$P(ZVUIDS,"^",1) Q:ZJ=""  D  ; FOR EACH VUID
+	. . . S ZVUID(ZJ)=ZN ;SET INDEX TO NAME
+	. . . S ZVUIDS=$P(ZVUIDS,"^",2) ; DROP THE FIRST IN THE LIST
+	. E  S ZVUID(ZVUIDS)=ZN ;SET INDEX TO VA NAME
+	. S ZJ=""
+	. F  S ZJ=$O(ZVUID(ZJ)) Q:ZJ=""  D  ; FOR EACH VUID
+	. . ;S @ZINDEX@(ZJ,ZI)=ZVUID(ZJ) ;SET THE INDEX
+	. . W !,$NA(@ZINDEX@(ZJ,ZI))_"="_ZVUID(ZJ) ;SET THE INDEX
+	Q
+EN	; ENTRY POINT TO CREATE THE ERX DRUG ANALYSIS SPREADSHEETS
+	; SEE BELOW FOR DOCUMENTATION
+	N GARY
+	S GARY=$NA(^TMP("C0PRXN","ALL")) ; PLACE TO PUT THE ENTIRE ARRAY
+	K @GARY
+	D BLDARY(GARY) ; BUILD THE ENTIRE ARRAY
+	D IDXARY(GARY) ; INDEX THE ARRAY BY TYPE AND DRUG NAME
+	D TYPES
+	Q
+	;
+TYPES	; BUILD AN ARRAY FOR EACH TYPE
+	I '$D(GARY) S GARY=$NA(^TMP("C0PRXN","ALL"))
+	N C0PN,ZTYPE
+	F C0PN=1:1:4 D  ; FOR EACH ANALYSIS TYPE
+	. S ZTYPE=$NA(^TMP("C0PRXN","TYPE"_C0PN))
+	. K @ZTYPE
+	. D BLDTYPE(GARY,ZTYPE,C0PN) ; BUILD AN EXTRACTED ARRAY ACCORDING TO TYPE
+	. S GOUT=$NA(^TMP("C0POUT"))
+	. K @GOUT
+	. D RNF2CSV^C0CRNF(GOUT,ZTYPE,"VN") ; TURN TYPE 2 INTO A CSV 
+	. W !
+	. D FILEOUT^C0CRNF(GOUT,"eRx_mapping__Type"_C0PN_".csv")
+	Q
+	;
+IDXARY(INARY)	; INDEX THE ARRAY BY TYPE AND NAME
+	;
+	N ZI
+	S ZI=""
+	F  S ZI=$O(@INARY@("V",ZI)) Q:ZI=""  D  ; FOR EACH ELEMENT OF THE ARRAY
+	. S @INARY@("INDEX",@INARY@("V",ZI,"TYPE"),@INARY@("V",ZI,"FDBNAME"),ZI)=""
+	D COUNT
+	Q
+	;
+COUNT	; COUNT AND REPORT HOW MANY ARE IN EACH TYPE
+	I '$D(INARY) S INARY=$NA(^TMP("C0PRXN","ALL"))
+	N ZN,ZI,ZJ,ZCOUNT
+	S ZN=""
+	F  S ZN=$O(@INARY@("INDEX",ZN)) Q:ZN=""  D  ; FOR EACH TYPE
+	. S ZCOUNT=0
+	. S ZI=""
+	. F  S ZI=$O(@INARY@("INDEX",ZN,ZI)) Q:ZI=""  D  ; FOR EACH INDEX ENTRY
+	. . S ZCOUNT=ZCOUNT+1
+	. W !,"COUNT FOR TYPE "_ZN_" = "_ZCOUNT
+	Q
+	;
+BLDTYPE(INARY,OARY,ITYPE)	; EXTRACT A TYPE ARRAY
+	;
+	N C0PI,C0PJ
+	S C0PI=""
+	F  S C0PI=$O(@INARY@("INDEX",ITYPE,C0PI)) Q:C0PI=""  D  ; FOR EACH OF TYPE
+	. S C0PJ=$O(@INARY@("INDEX",ITYPE,C0PI,"")) ; SET RECORD NUMBER
+	. N C0PROW
+	. M C0PROW=@INARY@("V",C0PJ) ; CONTENTS OF ROW
+	. D RNF1TO2B^C0CRNF(OARY,"C0PROW") ; USING THE "B" VERSION TO BE ABLE TO
+	. ; TO CONVERT TO A CSV
+	Q
+	;
+BLDARY(ZARY)	; BUILDS AN RNF2 ARRAY; ZARY IS PASSED BY NAME 
+	; (SEE C0CRNF.m FOR DOCUMENTATION OF RNF2 FORMAT)
+	; 
+	; FIRST DATA BANK DRUGS ARE MATCHED TO VISTA DRUGS THROUGH A MULTI-STEP
+	; PROCESS. THE MEDID IS THE FIRST DATA BANK NUMBER USED TO REFER TO THEIR
+	; DRUGS. EACH MEDID HAS A GCN (GENERIC CODE NUMBER) WHICH CAN BE USED TO
+	; LOOK UP THE DRUG IN THE RXNORM UMLS DATABASE. THE GCN IS USED TO FIND
+	; THE RXNORM CONCEPT NUMBER (RXNCUI). THE RXNCUI IS USED TO FIND THE VUID
+	; USING THE RXNORM UMLS DATABASE. THE VUID IS USED TO FIND THE IEN OF THE
+	; DRUG IN THE VA PRODUCTS FILE (ALSO KNOWN AS THE NDF - NATIONAL DRUG FILE).
+	; THE VAPROD IEN IS THEN USED TO LOOK UP THE DRUG IN THE VA DRUG FILE
+	; (FILE 50) USING A NEW CROSS REFERENCE (AC0P) CREATED FOR THIS PURPOSE.
+	; THE RESULT OF THIS CHAIN IS A DRUG MAPPED FROM THE FDB MEDID TO A
+	; VA DRUG FILE IEN. TO SUMMARIZE:
+	; 
+	; MEDID->GCN->RXNCUI->VUID->VAPROD->DRUGIEN
+	;
+	; (NOTE: THIS PROCESS WILL CHANGE - BE IMPROVED - WHEN THE VERIFIED 
+	; MEDID->RXNORM MAPPING BECOMES AVAILABLE. THIS ANALYSIS WILL ESTABLISH
+	; A BASELINE WITH WHICH TO COMPARE THE RESULT OF USING THAT MAPPING)
+	;
+	; (THE PROCESS IS ACTUALLY MORE COMPLEX THAT THIS, BECAUSE WE ALSO TRY
+	; AND MATCH DRUGS BY LOOKING AT THEIR CHEMICAL COMPONENTS BUT THIS ANALYSIS
+	; IGNORES THIS MORE COMPLEX PROCESS.)
+	; 
+	; NOT ALL DRUGS MAKE IT ALL THE WAY THROUGH THIS MAPPING. IN ADDITION, THERE
+	; MAY BE DRUGS THAT ARE IN THE DRUG FILE THAT ARE NOT IN THE FDB FILE
+	; THIS ROUTINE WILL CREATE A SPREADSHEET THAT WILL SHOW THE UNMAPPED DRUGS
+	; IN BOTH DIRECTIONS (MEDID->...>DRUGIEN AND DRUGIEN->...>MEDID)
+	; IT WILL ALSO SHOW THE DRUG NAME AS IT APPEARS IN FIRST DATA BANK
+	; AND THE NAME THAT WILL BE USED FOR THAT DRUG IN VISTA (ERX). OFTEN
+	; THEY WILL BE DIFFERENT. IF THE FDB DRUG IS NOT A GENERIC, THE GENERIC NAME
+	; WILL BY USED BY ERX TO LIST THE DRUG IN THE PATIENT'S DRUG LIST IN VISTA
+	;
+	; WE ARE GOING TO ORGANIZE AN ARRAY WITH DRUGS BY TYPE. HERE ARE THE TYPES:
+	; 
+	; TYPE 1 - FDB DRUGS THAT MAP EXACTLY TO THE DRUG FILE, WITH NAMES THAT
+	;  MATCH EXACTLY
+	;
+	; TYPE 2 - FDB DRUGS THAT MAP TO THE DRUG FILE, BUT WITH DIFFERENT NAMES.
+	;  THIS CATEGORY INCLUDES DRUGS THAT ARE SHOWN IN VISTA AS GENERICS BUT
+	;  ON FDB AS BRAND NAME DRUGS
+	; 
+	; TYPE 3 - FDB DRUGS THAT DO NOT MAP TO THE DRUG FILE, BUT DO MAP TO THE
+	;  VA PRODUCT FILE (NDF). IF ANY OF THESE DRUGS MIGHT BE ORDERED VIA ERX,
+	;  IT MIGHT BE A GOOD IDEA TO ADD THEM TO THE DRUG FILE.
+	; NOTE: FOR TYPE 3 AND ABOVE DRUGS, ERX WILL STILL FUNCTION PROPERLY BUT
+	; INSTEAD OF MAPPING THE DRUG TO THE DRUG FILE, WILL MAP IT AS A FREE TEXT
+	; DRUG AND WILL SEND A MAIL MESSAGE ABOUT THE MAPPING ERROR SO THAT THE
+	; DRUG CAN BE CONSIDERED FOR ADDING TO THE DRUG FILE
+	; 
+	; TYPE 4 - FDB DRUGS THAT DO NOT MAP TO THE DRUG FILE AND ARE ALSO NOT
+	;  FOUND IN THE NDF. THIS MIGHT BE THE CASE FOR NEWER DRUGS. ERX WILL
+	;  STILL FUNCTION, BUT THESE WILL BE FREE TEXT DRUGS. THE REMEDY IS AN
+	;  UPDATE FROM THE VA OF THE NDF OR ADDING THE DRUGS TO THE NDF AND THE
+	;  DRUG FILE. (THERE ARE COMPLEXITIES IN ADDING DRUGS TO THE NDF BECAUSE
+	;  OF HOW TO THEN HANDLE AN UPDATE FROM THE VA)
+	;
+	; TYPE 5 - DRUGS IN THE DRUG FILE THAT ARE NOT FOUND IN THE FDB DRUG DATABASE
+	;  MAPPING. THIS MIGHT INCLUDE BRAND NAME DRUGS IN THE DRUG FILE THAT HAVE
+	;  BEEN MAPPED TO GENERICS WHEN COMING FROM FDB. IN ANY CASE, THESE ARE DRUGS
+	;  FOR WHICH THERE IS NO PATH TO MAP FROM THEM TO FDB. (REDUCING THE NUMBER
+	;  OF DRUGS IN THIS TYPE TO ZERO WILL BE A GOAL BEFORE IMPLEMENTING PHASE II
+	;  OF ERX WHERE DRUGS WILL BE ORDERED ON VISTA AND SENT TO THE ERX 
+	;  SERVICE.
+	;
+	N ZI
+	S ZI=""
+	F  S ZI=$O(^C0P("FDB","B",ZI)) Q:ZI=""  D  ;
+	. N ZGCN,ZRXNCUI,ZNAME,ZVAIEN,ZDRUGIEN,ZROW,ZIEN,ZVANAME
+	. S (ZGCN,ZRXNCUI,ZNAME,ZVAIEN,ZDRUGIEN,ZVANAME)=""
+	. S ZROW("MEDID")=ZI ; FDB MEDID
+	. S ZIEN=$O(^C0P("FDB","B",ZI,"")) ; IEN OF THE FDB MED
+	. S ZROW("FDBNAME")=$$FULLNAME^C0PLKUP(ZI) ; FDB MED NAME
+	. S ZGCN=$$GCN^C0PLKUP(ZI)
+	. I ZGCN=0 D  Q  ; NO GCN, CAN'T MAP 
+	. . S ZROW("TYPE")=4
+	. . D RNF1TO2^C0CRNF(ZARY,"ZROW")
+	. S ZROW("GCN")=ZGCN
+	. S ZRXNCUI=$$RXNCUI^C0PLKUP(ZGCN) ; RETRIEVE THE RXNORM CONCEPT ID
+	. I ZRXNCUI="" W !,"ERROR, NO RXNCUI "_ZGCN D ERROR^C0PMAIN(",U113059009,",$ST($ST,"PLACE"),"ERX-INVALID-DATA","Invalid Data") QUIT
+	. S ZROW("RXNCUI")=ZRXNCUI
+	. S ZVUID=$$VUID^C0PLKUP(ZRXNCUI) ; FETCH THE VUID
+	. I ZVUID="" D  Q  ; NO VUID FOUND
+	. . S ZROW("TYPE")=4
+	. . D RNF1TO2^C0CRNF(ZARY,"ZROW")
+	. S ZROW("VUID")=ZVUID
+	. I ZVUID["^" S ZVUID=$P(ZVUID,"^",1) ; USE THE FIRST ONE
+	. S ZVAIEN=$$VAPROD^C0PLKUP(ZVUID) ; IEN IN VA PRODUCTS (NDF)
+	. I ZVAIEN=0 D  Q  ; NOT FOUND IN NDF
+	. . S ZROW("TYPE")=4
+	. . D RNF1TO2^C0CRNF(ZARY,"ZROW")
+	. S ZDRUGIEN=$$DRUG^C0PLKUP(ZVAIEN) ; IEN IN DRUG FILE
+	. I ZDRUGIEN=0 D  Q  ;
+	. . S ZROW("TYPE")=3
+	. . S ZROW("VANDFNAME")=$$GET1^DIQ(50.68,ZVAIEN_",",.01) ;NDF NAME
+	. . D RNF1TO2^C0CRNF(ZARY,"ZROW")
+	. S ZVANAME=$$GET1^DIQ(50,ZDRUGIEN_",",.01) ; VA DRUG NAME
+	. S ZROW("VANAME")=ZVANAME ; 
+	. I ZVANAME=$$UP^XLFSTR(ZNAME) S ZROW("TYPE")=1
+	. E  S ZROW("TYPE")=2
+	. D RNF1TO2^C0CRNF(ZARY,"ZROW")
+	. ;B
+	Q
+	;
+BLDFILE()	; BUILDS THE C0P RXNORM FDB VUID MAPPING FILE #113059010.002
+	; 
+	; FIRST DATA BANK DRUGS ARE MATCHED TO VISTA DRUGS THROUGH A MULTI-STEP
+	; PROCESS. THE MEDID IS THE FIRST DATA BANK NUMBER USED TO REFER TO THEIR
+	; DRUGS. EACH MEDID HAS A GCN (GENERIC CODE NUMBER) WHICH CAN BE USED TO
+	; LOOK UP THE DRUG IN THE RXNORM UMLS DATABASE. THE GCN IS USED TO FIND
+	; THE RXNORM CONCEPT NUMBER (RXNCUI). THE RXNCUI IS USED TO FIND THE VUID
+	; USING THE RXNORM UMLS DATABASE. THE VUID IS USED TO FIND THE IEN OF THE
+	; DRUG IN THE VA PRODUCTS FILE (ALSO KNOWN AS THE NDF - NATIONAL DRUG FILE).
+	; THE VAPROD IEN IS THEN USED TO LOOK UP THE DRUG IN THE VA DRUG FILE
+	; (FILE 50) USING A NEW CROSS REFERENCE (AC0P) CREATED FOR THIS PURPOSE.
+	; THE RESULT OF THIS CHAIN IS A DRUG MAPPED FROM THE FDB MEDID TO A
+	; VA DRUG FILE IEN. TO SUMMARIZE:
+	; 
+	; MEDID->GCN->RXNCUI->VUID->VAPROD->DRUGIEN
+	;
+	; (NOTE: THIS PROCESS WILL CHANGE - BE IMPROVED - WHEN THE VERIFIED 
+	; MEDID->RXNORM MAPPING BECOMES AVAILABLE. THIS ANALYSIS WILL ESTABLISH
+	; A BASELINE WITH WHICH TO COMPARE THE RESULT OF USING THAT MAPPING)
+	;
+	; (THE PROCESS IS ACTUALLY MORE COMPLEX THAT THIS, BECAUSE WE ALSO TRY
+	; AND MATCH DRUGS BY LOOKING AT THEIR CHEMICAL COMPONENTS BUT THIS ANALYSIS
+	; IGNORES THIS MORE COMPLEX PROCESS.)
+	; 
+	; NOT ALL DRUGS MAKE IT ALL THE WAY THROUGH THIS MAPPING. IN ADDITION, THERE
+	; MAY BE DRUGS THAT ARE IN THE DRUG FILE THAT ARE NOT IN THE FDB FILE
+	; THIS ROUTINE WILL CREATE A SPREADSHEET THAT WILL SHOW THE UNMAPPED DRUGS
+	; IN BOTH DIRECTIONS (MEDID->...>DRUGIEN AND DRUGIEN->...>MEDID)
+	; IT WILL ALSO SHOW THE DRUG NAME AS IT APPEARS IN FIRST DATA BANK
+	; AND THE NAME THAT WILL BE USED FOR THAT DRUG IN VISTA (ERX). OFTEN
+	; THEY WILL BE DIFFERENT. IF THE FDB DRUG IS NOT A GENERIC, THE GENERIC NAME
+	; WILL BY USED BY ERX TO LIST THE DRUG IN THE PATIENT'S DRUG LIST IN VISTA
+	;
+	; WE ARE GOING TO ORGANIZE AN ARRAY WITH DRUGS BY TYPE. HERE ARE THE TYPES:
+	; 
+	; TYPE 1 - FDB DRUGS THAT MAP EXACTLY TO THE DRUG FILE, WITH NAMES THAT
+	;  MATCH EXACTLY
+	;
+	; TYPE 2 - FDB DRUGS THAT MAP TO THE DRUG FILE, BUT WITH DIFFERENT NAMES.
+	;  THIS CATEGORY INCLUDES DRUGS THAT ARE SHOWN IN VISTA AS GENERICS BUT
+	;  ON FDB AS BRAND NAME DRUGS
+	; 
+	; TYPE 3 - FDB DRUGS THAT DO NOT MAP TO THE DRUG FILE, BUT DO MAP TO THE
+	;  VA PRODUCT FILE (NDF). IF ANY OF THESE DRUGS MIGHT BE ORDERED VIA ERX,
+	;  IT MIGHT BE A GOOD IDEA TO ADD THEM TO THE DRUG FILE.
+	; NOTE: FOR TYPE 3 AND ABOVE DRUGS, ERX WILL STILL FUNCTION PROPERLY BUT
+	; INSTEAD OF MAPPING THE DRUG TO THE DRUG FILE, WILL MAP IT AS A FREE TEXT
+	; DRUG AND WILL SEND A MAIL MESSAGE ABOUT THE MAPPING ERROR SO THAT THE
+	; DRUG CAN BE CONSIDERED FOR ADDING TO THE DRUG FILE
+	; 
+	; TYPE 4 - FDB DRUGS THAT DO NOT MAP TO THE DRUG FILE AND ARE ALSO NOT
+	;  FOUND IN THE NDF. THIS MIGHT BE THE CASE FOR NEWER DRUGS. ERX WILL
+	;  STILL FUNCTION, BUT THESE WILL BE FREE TEXT DRUGS. THE REMEDY IS AN
+	;  UPDATE FROM THE VA OF THE NDF OR ADDING THE DRUGS TO THE NDF AND THE
+	;  DRUG FILE. (THERE ARE COMPLEXITIES IN ADDING DRUGS TO THE NDF BECAUSE
+	;  OF HOW TO THEN HANDLE AN UPDATE FROM THE VA)
+	;
+	; TYPE 5 - DRUGS IN THE DRUG FILE THAT ARE NOT FOUND IN THE FDB DRUG DATABASE
+	;  MAPPING. THIS MIGHT INCLUDE BRAND NAME DRUGS IN THE DRUG FILE THAT HAVE
+	;  BEEN MAPPED TO GENERICS WHEN COMING FROM FDB. IN ANY CASE, THESE ARE DRUGS
+	;  FOR WHICH THERE IS NO PATH TO MAP FROM THEM TO FDB. (REDUCING THE NUMBER
+	;  OF DRUGS IN THIS TYPE TO ZERO WILL BE A GOAL BEFORE IMPLEMENTING PHASE II
+	;  OF ERX WHERE DRUGS WILL BE ORDERED ON VISTA AND SENT TO THE ERX 
+	;  SERVICE.
+	;
+	N FN S FN=1130590010.002 ;FILE NUMBER FOR C0P RXNORM FDB VUID MAPPING FILE
+	N C0PFDA
+	N ZI
+	S ZI=""
+	F  S ZI=$O(^C0P("FDB","B",ZI)) Q:ZI=""  D  ;
+	. D DOONE(.C0PFDA,ZI) ;BUILD AN FDA
+	. D UPDIE ;WRITE TO FILE
+	Q
+	;
+DOONE(C0PFDA,ZI)	; RETURN FDA FOR MEDID ZI
+	N FN S FN=1130590010.002 ;FILE NUMBER FOR C0P RXNORM FDB VUID MAPPING FILE
+	N ZGCN,ZRXNCUI,ZNAME,ZVAIEN,ZDRUGIEN,ZROW,ZIEN,ZVANAME,ZRXNIEN,ZRXNTXT
+	S (ZGCN,ZRXNCUI,ZNAME,ZVAIEN,ZDRUGIEN,ZVANAME)=""
+	;S ZROW("MEDID")=ZI ; FDB MEDID
+	S C0PFDA(FN,"+1,",.02)=ZI ; FDB MEDID
+	S ZIEN=$O(^C0P("FDB","B",ZI,"")) ; IEN OF THE FDB MED
+	S C0PFDA(FN,"+1,",1.02)=ZIEN ;POINTER TO FDB MED
+	;S ZROW("FDBNAME")=$$FULLNAME^C0PLKUP(ZI) ; FDB MED NAME
+	S ZNAME=$$FULLNAME^C0PLKUP(ZI) ; FDB MED NAME
+	S C0PFDA(FN,"+1,",2.02)=ZNAME ; FDB MED NAME
+	S ZGCN=$$GCN^C0PLKUP(ZI)
+	I ZGCN=0 D  Q  ; NO GCN, CAN'T GO FURTHER 
+	. ;S ZROW("TYPE")=4
+	. S C0PFDA(FN,"+1,",3)=4 ;TYPE 4, CAN'T MAP FDB TO RXN
+	. S C0PFDA(FN,"+1,",.01)="MISSING RXN" ;NEED TO HAVE A .01
+	. ;D RNF1TO2^C0CRNF(ZARY,"ZROW")
+	;S ZROW("GCN")=ZGCN
+	S C0PFDA(FN,"+1,",.04)=$$GCN^C0PLKUP(ZI) ;GENERIC CATEGORY NUMBER
+	S ZRXNCUI=$$RXNCUI^C0PLKUP(ZGCN) ; RETRIEVE THE RXNORM CONCEPT ID
+	I ZRXNCUI="" W !,"ERROR, NO RXNCUI "_ZGCN D ERROR^C0PMAIN(",U113059009,",$ST($ST,"PLACE"),"ERX-INVALID-DATA","Invalid Data") QUIT  ;shouldn't happen
+	S C0PFDA(FN,"+1,",.01)=ZRXNCUI ; RXN CONCEPT
+	S ZRXNIEN=$O(^C0P("RXN","B",ZRXNCUI,"")) ; RXN CONCEPT IEN
+	S C0PFDA(FN,"+1,",1.01)=ZRXNIEN ; POINTER TO RXN CONCEPT
+	S ZRXNTXT=$G(^C0P("RXN",ZRXNIEN,1,1,0)) ; FIRST LINE OF RXN TEXT
+	S C0PFDA(FN,"+1,",2.01)=ZRXNTXT ; RXN CONCEPT LABEL
+	;S ZROW("RXNCUI")=ZRXNCUI
+	S ZVUID=$$VUID^C0PLKUP(ZRXNCUI) ; FETCH THE VUID
+	I ZVUID="" D  Q  ; NO VUID FOUND
+	. ;S ZROW("TYPE")=4
+	. S C0PFDA(FN,"+1,",3)=4 ;TYPE 4, CAN'T MAP RXNCUI TO VUID
+	. ;D RNF1TO2^C0CRNF(ZARY,"ZROW")
+	;S ZROW("VUID")=ZVUID
+	S ZVUID=$TR(ZVUID,"^","|") ; CAN'T HAVE ^ IN FIELDS
+	S C0PFDA(FN,"+1,",.03)=ZVUID ;SET OF VUIDS
+	I ZVUID["|" S ZVUID=$P(ZVUID,"|",1) ; USE THE FIRST ONE
+	S ZVAIEN=$$VAPROD^C0PLKUP(ZVUID) ; IEN IN VA PRODUCTS (NDF)
+	I +ZVAIEN=0 D  Q  ; NOT FOUND IN NDF
+	. ;S ZROW("TYPE")=4
+	. S C0PFDA(FN,"+1,",3)=4 ;TYPE 4, CAN'T MAP VUID TO NDF
+	. ;D RNF1TO2^C0CRNF(ZARY,"ZROW")
+	S ZDRUGIEN=$$DRUG^C0PLKUP(ZVAIEN) ; IEN IN DRUG FILE
+	I ZDRUGIEN["^" S ZDRUGIEN=$P(ZDRUGIEN,"^",1) ; USE THE FIRST ONE
+	I +ZDRUGIEN=0 D  Q  ;
+	. S ZROW("TYPE")=3
+	. S C0PFDA(FN,"+1,",3)=3 ;TYPE 3, CAN'T MAP VUID TO DRUG FILE
+	. ;S ZROW("VANDFNAME")=$$GET1^DIQ(50.68,ZVAIEN_",",.01) ;NDF NAME
+	. S C0PFDA(FN,"+1,",1.04)=ZVAIEN ;POINTER TO NDF
+	. S C0PFDA(FN,"+1,",2.04)=$$GET1^DIQ(50.68,ZVAIEN_",",.01) ;NDF NAME
+	. ;D RNF1TO2^C0CRNF(ZARY,"ZROW")
+	S ZVANAME=$$GET1^DIQ(50,ZDRUGIEN_",",.01) ; VA DRUG NAME
+	S C0PFDA(FN,"+1,",2.03)=ZVANAME ; VA DRUG FILE NAME
+	S C0PFDA(FN,"+1,",1.03)=$G(ZDRUGIEN) ; VA DRUG FILE IEN
+	;S ZROW("VANAME")=ZVANAME ; 
+	I ZVANAME=$$UP^XLFSTR(ZNAME) S ZROW("TYPE")=1
+	E  S ZROW("TYPE")=2
+	S C0PFDA(FN,"+1,",3)=ZROW("TYPE") ; MATCHING TYPE 1 OR 2
+	;D RNF1TO2^C0CRNF(ZARY,"ZROW")
+	;B
+	Q
+	;
+UPDIE	  ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+	;Q  ;//SMH don't want an update
+	;I C0PFDA(FN,"+1,",3)'=3 Q  ;
+	I C0PFDA(FN,"+1,",1.02)=1 Q  ;
+	;ZWR C0PFDA ;
+	K ZERR
+	D CLEAN^DILF
+	D UPDATE^DIE("","C0PFDA","","ZERR")
+	I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
+	K C0PFDA
+	Q
Index: ePrescribing/trunk/p/C0PTRXN2.m
===================================================================
--- ePrescribing/trunk/p/C0PTRXN2.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PTRXN2.m	(revision 1595)
@@ -0,0 +1,390 @@
+C0PTRXN   ; ERX/GPL - Med file eRx analysis routines ; 7/10/10
+ ;;0.1;C0P;nopatch;noreleasedate;Build 77
+ ;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
+ ;
+ ; gpl 7/2010 - these routines are to test the Drug file mappings 
+ ; to see how well they will work for eRx. None of this code is needed
+ ; for operation of the eRx Package. It is for analysis, debugging and future
+ ; development
+ ;
+FDBFN() Q 1130590010 ; First Databank Drugs file number
+RXNFN() Q 1130590011.001 ; RxNorm Concepts file number
+T1 ; TEST1
+ N ZI
+ S ZI=""
+ F  S ZI=$O(^C0P("FDB","B",ZI)) Q:ZI=""  D  ;
+ . N ZGCN,ZRXNCUI,ZNAME,ZVAIEN,ZDRUGIEN
+ . S (ZGCN,ZRXNCUI,ZNAME,ZVAIEN,ZDRUGIEN)=""
+ . S ZGCN=$$GCN^C0PLKUP(ZI)
+ . S ZRXNCUI=$$RXNCUI^C0PLKUP(ZGCN)
+ . I ZRXNCUI'="" S ZVUID=$$VUID^C0PLKUP(ZRXNCUI)
+ . E  S ZRXNCUI="NONE"
+ . S ZNAME=$$FULLNAME^C0PLKUP(ZI)
+ . I ZVUID'="" S ZVAIEN=$$VAPROD^C0PLKUP(ZVUID)
+ . I ZVAIEN'="" S ZDRUGIEN=$$DRUG^C0PLKUP(ZVAIEN)
+ . E  S ZDRUGIEN="N/A"
+ . W !,ZI," ",ZGCN," ",ZRXNCUI," ",ZVUID," ",ZVAIEN," ",ZDRUGIEN," ",ZNAME
+ Q
+ ; OK, T1 IS JUST SOME EXPLORITORY WORK. TIME TO GET ORGANIZED
+ ;
+TEST ;
+ ;
+ S GARY=$NA(^TMP("C0PRXN","TYPE2"))
+ S GOUT=$NA(^TMP("C0POUT"))
+ K @GOUT
+ D RNF2CSV^C0CRNF(GOUT,GARY,"VN") ; TURN TYPE 2 INTO A CSV 
+ D FILEOUT^C0CRNF(GOUT,"TYPE2_TEST.csv")
+ Q
+ ;
+INDEX2 ; ADD AN INDEX TO TYPE2 DRUGS OF THE VUID
+ ; FOR USE IN FINDING THE CURRENT VA->FDB MAPPING STATUS
+ N ZI S ZI=""
+ N ZBASE
+ S ZBASE=$NA(^TMP("C0PRXN","TYPE2","V")) ; TYPE2 DRUGS ARE HERE
+ S ZINDEX=$NA(^TMP("C0PRXN","TYPE2","INDEX")) ; PUT THE INDEX HERE
+ F  S ZI=$O(@ZBASE@(ZI)) Q:ZI=""  D  ;
+ . N ZVUIDS,ZVUID
+ . S ZVUIDS=@ZBASE@(ZI,"VUID",1) ; LIST OF VUIDS ^ SEPARATED
+ . N ZN S ZN=@ZBASE@(ZI,"VANAME",1)_"^"_@ZBASE@(ZI,"FDBNAME",1)
+ . I ZVUIDS["^" D  ;
+ . . N ZJ S ZJ=""
+ . . F  S ZJ=$P(ZVUIDS,"^",1) Q:ZJ=""  D  ; FOR EACH VUID
+ . . . S ZVUID(ZJ)=ZN ;SET INDEX TO NAME
+ . . . S ZVUIDS=$P(ZVUIDS,"^",2) ; DROP THE FIRST IN THE LIST
+ . E  S ZVUID(ZVUIDS)=ZN ;SET INDEX TO VA NAME
+ . S ZJ=""
+ . F  S ZJ=$O(ZVUID(ZJ)) Q:ZJ=""  D  ; FOR EACH VUID
+ . . ;S @ZINDEX@(ZJ,ZI)=ZVUID(ZJ) ;SET THE INDEX
+ . . W !,$NA(@ZINDEX@(ZJ,ZI))_"="_ZVUID(ZJ) ;SET THE INDEX
+ Q
+EN ; ENTRY POINT TO CREATE THE ERX DRUG ANALYSIS SPREADSHEETS
+ ; SEE BELOW FOR DOCUMENTATION
+ N GARY
+ S GARY=$NA(^TMP("C0PRXN","ALL")) ; PLACE TO PUT THE ENTIRE ARRAY
+ K @GARY
+ D BLDARY(GARY) ; BUILD THE ENTIRE ARRAY
+ D IDXARY(GARY) ; INDEX THE ARRAY BY TYPE AND DRUG NAME
+ D TYPES
+ Q
+ ;
+TYPES ; BUILD AN ARRAY FOR EACH TYPE
+ I '$D(GARY) S GARY=$NA(^TMP("C0PRXN","ALL"))
+ N C0PN,ZTYPE
+ F C0PN=1:1:4 D  ; FOR EACH ANALYSIS TYPE
+ . S ZTYPE=$NA(^TMP("C0PRXN","TYPE"_C0PN))
+ . K @ZTYPE
+ . D BLDTYPE(GARY,ZTYPE,C0PN) ; BUILD AN EXTRACTED ARRAY ACCORDING TO TYPE
+ . S GOUT=$NA(^TMP("C0POUT"))
+ . K @GOUT
+ . D RNF2CSV^C0CRNF(GOUT,ZTYPE,"VN") ; TURN TYPE 2 INTO A CSV 
+ . W !
+ . D FILEOUT^C0CRNF(GOUT,"eRx_mapping__Type"_C0PN_".csv")
+ Q
+ ;
+IDXARY(INARY) ; INDEX THE ARRAY BY TYPE AND NAME
+ ;
+ N ZI
+ S ZI=""
+ F  S ZI=$O(@INARY@("V",ZI)) Q:ZI=""  D  ; FOR EACH ELEMENT OF THE ARRAY
+ . S @INARY@("INDEX",@INARY@("V",ZI,"TYPE"),@INARY@("V",ZI,"FDBNAME"),ZI)="" 
+ D COUNT
+ Q
+ ;
+COUNT ; COUNT AND REPORT HOW MANY ARE IN EACH TYPE
+ I '$D(INARY) S INARY=$NA(^TMP("C0PRXN","ALL"))
+ N ZN,ZI,ZJ,ZCOUNT
+ S ZN=""
+ F  S ZN=$O(@INARY@("INDEX",ZN)) Q:ZN=""  D  ; FOR EACH TYPE
+ . S ZCOUNT=0
+ . S ZI=""
+ . F  S ZI=$O(@INARY@("INDEX",ZN,ZI)) Q:ZI=""  D  ; FOR EACH INDEX ENTRY
+ . . S ZCOUNT=ZCOUNT+1
+ . W !,"COUNT FOR TYPE "_ZN_" = "_ZCOUNT
+ Q
+ ;
+BLDTYPE(INARY,OARY,ITYPE) ; EXTRACT A TYPE ARRAY
+ ;
+ N C0PI,C0PJ
+ S C0PI=""
+ F  S C0PI=$O(@INARY@("INDEX",ITYPE,C0PI)) Q:C0PI=""  D  ; FOR EACH OF TYPE
+ . S C0PJ=$O(@INARY@("INDEX",ITYPE,C0PI,"")) ; SET RECORD NUMBER
+ . N C0PROW
+ . M C0PROW=@INARY@("V",C0PJ) ; CONTENTS OF ROW
+ . D RNF1TO2B^C0CRNF(OARY,"C0PROW") ; USING THE "B" VERSION TO BE ABLE TO
+ . ; TO CONVERT TO A CSV
+ Q
+ ;
+BLDARY(ZARY) ; BUILDS AN RNF2 ARRAY; ZARY IS PASSED BY NAME 
+ ; (SEE C0CRNF.m FOR DOCUMENTATION OF RNF2 FORMAT)
+ ; 
+ ; FIRST DATA BANK DRUGS ARE MATCHED TO VISTA DRUGS THROUGH A MULTI-STEP
+ ; PROCESS. THE MEDID IS THE FIRST DATA BANK NUMBER USED TO REFER TO THEIR
+ ; DRUGS. EACH MEDID HAS A GCN (GENERIC CODE NUMBER) WHICH CAN BE USED TO
+ ; LOOK UP THE DRUG IN THE RXNORM UMLS DATABASE. THE GCN IS USED TO FIND
+ ; THE RXNORM CONCEPT NUMBER (RXNCUI). THE RXNCUI IS USED TO FIND THE VUID
+ ; USING THE RXNORM UMLS DATABASE. THE VUID IS USED TO FIND THE IEN OF THE
+ ; DRUG IN THE VA PRODUCTS FILE (ALSO KNOWN AS THE NDF - NATIONAL DRUG FILE).
+ ; THE VAPROD IEN IS THEN USED TO LOOK UP THE DRUG IN THE VA DRUG FILE
+ ; (FILE 50) USING A NEW CROSS REFERENCE (AC0P) CREATED FOR THIS PURPOSE.
+ ; THE RESULT OF THIS CHAIN IS A DRUG MAPPED FROM THE FDB MEDID TO A
+ ; VA DRUG FILE IEN. TO SUMMARIZE:
+ ; 
+ ; MEDID->GCN->RXNCUI->VUID->VAPROD->DRUGIEN
+ ;
+ ; (NOTE: THIS PROCESS WILL CHANGE - BE IMPROVED - WHEN THE VERIFIED 
+ ; MEDID->RXNORM MAPPING BECOMES AVAILABLE. THIS ANALYSIS WILL ESTABLISH
+ ; A BASELINE WITH WHICH TO COMPARE THE RESULT OF USING THAT MAPPING)
+ ;
+ ; (THE PROCESS IS ACTUALLY MORE COMPLEX THAT THIS, BECAUSE WE ALSO TRY
+ ; AND MATCH DRUGS BY LOOKING AT THEIR CHEMICAL COMPONENTS BUT THIS ANALYSIS
+ ; IGNORES THIS MORE COMPLEX PROCESS.)
+ ; 
+ ; NOT ALL DRUGS MAKE IT ALL THE WAY THROUGH THIS MAPPING. IN ADDITION, THERE
+ ; MAY BE DRUGS THAT ARE IN THE DRUG FILE THAT ARE NOT IN THE FDB FILE
+ ; THIS ROUTINE WILL CREATE A SPREADSHEET THAT WILL SHOW THE UNMAPPED DRUGS
+ ; IN BOTH DIRECTIONS (MEDID->...>DRUGIEN AND DRUGIEN->...>MEDID)
+ ; IT WILL ALSO SHOW THE DRUG NAME AS IT APPEARS IN FIRST DATA BANK
+ ; AND THE NAME THAT WILL BE USED FOR THAT DRUG IN VISTA (ERX). OFTEN
+ ; THEY WILL BE DIFFERENT. IF THE FDB DRUG IS NOT A GENERIC, THE GENERIC NAME
+ ; WILL BY USED BY ERX TO LIST THE DRUG IN THE PATIENT'S DRUG LIST IN VISTA
+ ;
+ ; WE ARE GOING TO ORGANIZE AN ARRAY WITH DRUGS BY TYPE. HERE ARE THE TYPES:
+ ; 
+ ; TYPE 1 - FDB DRUGS THAT MAP EXACTLY TO THE DRUG FILE, WITH NAMES THAT
+ ;  MATCH EXACTLY
+ ;
+ ; TYPE 2 - FDB DRUGS THAT MAP TO THE DRUG FILE, BUT WITH DIFFERENT NAMES.
+ ;  THIS CATEGORY INCLUDES DRUGS THAT ARE SHOWN IN VISTA AS GENERICS BUT
+ ;  ON FDB AS BRAND NAME DRUGS
+ ; 
+ ; TYPE 3 - FDB DRUGS THAT DO NOT MAP TO THE DRUG FILE, BUT DO MAP TO THE
+ ;  VA PRODUCT FILE (NDF). IF ANY OF THESE DRUGS MIGHT BE ORDERED VIA ERX,
+ ;  IT MIGHT BE A GOOD IDEA TO ADD THEM TO THE DRUG FILE.
+ ; NOTE: FOR TYPE 3 AND ABOVE DRUGS, ERX WILL STILL FUNCTION PROPERLY BUT
+ ; INSTEAD OF MAPPING THE DRUG TO THE DRUG FILE, WILL MAP IT AS A FREE TEXT
+ ; DRUG AND WILL SEND A MAIL MESSAGE ABOUT THE MAPPING ERROR SO THAT THE
+ ; DRUG CAN BE CONSIDERED FOR ADDING TO THE DRUG FILE
+ ; 
+ ; TYPE 4 - FDB DRUGS THAT DO NOT MAP TO THE DRUG FILE AND ARE ALSO NOT
+ ;  FOUND IN THE NDF. THIS MIGHT BE THE CASE FOR NEWER DRUGS. ERX WILL
+ ;  STILL FUNCTION, BUT THESE WILL BE FREE TEXT DRUGS. THE REMEDY IS AN
+ ;  UPDATE FROM THE VA OF THE NDF OR ADDING THE DRUGS TO THE NDF AND THE
+ ;  DRUG FILE. (THERE ARE COMPLEXITIES IN ADDING DRUGS TO THE NDF BECAUSE
+ ;  OF HOW TO THEN HANDLE AN UPDATE FROM THE VA)
+ ;
+ ; TYPE 5 - DRUGS IN THE DRUG FILE THAT ARE NOT FOUND IN THE FDB DRUG DATABASE
+ ;  MAPPING. THIS MIGHT INCLUDE BRAND NAME DRUGS IN THE DRUG FILE THAT HAVE
+ ;  BEEN MAPPED TO GENERICS WHEN COMING FROM FDB. IN ANY CASE, THESE ARE DRUGS
+ ;  FOR WHICH THERE IS NO PATH TO MAP FROM THEM TO FDB. (REDUCING THE NUMBER
+ ;  OF DRUGS IN THIS TYPE TO ZERO WILL BE A GOAL BEFORE IMPLEMENTING PHASE II
+ ;  OF ERX WHERE DRUGS WILL BE ORDERED ON VISTA AND SENT TO THE ERX 
+ ;  SERVICE.
+ ;
+ N ZI
+ S ZI=""
+ F  S ZI=$O(^C0P("FDB","B",ZI)) Q:ZI=""  D  ;
+ . N ZGCN,ZRXNCUI,ZNAME,ZVAIEN,ZDRUGIEN,ZROW,ZIEN,ZVANAME
+ . S (ZGCN,ZRXNCUI,ZNAME,ZVAIEN,ZDRUGIEN,ZVANAME)=""
+ . S ZROW("MEDID")=ZI ; FDB MEDID
+ . S ZIEN=$O(^C0P("FDB","B",ZI,"")) ; IEN OF THE FDB MED
+ . S ZROW("FDBNAME")=$$FULLNAME^C0PLKUP(ZI) ; FDB MED NAME
+ . S ZGCN=$$GCN^C0PLKUP(ZI)
+ . I ZGCN=0 D  Q  ; NO GCN, CAN'T MAP 
+ . . S ZROW("TYPE")=4
+ . . D RNF1TO2^C0CRNF(ZARY,"ZROW")
+ . S ZROW("GCN")=ZGCN
+ . S ZRXNCUI=$$RXNCUI^C0PLKUP(ZGCN) ; RETRIEVE THE RXNORM CONCEPT ID
+ . I ZRXNCUI="" W !,"ERROR, NO RXNCUI "_ZGCN B  ; SHOULDN'T HAPPEN
+ . S ZROW("RXNCUI")=ZRXNCUI
+ . S ZVUID=$$VUID^C0PLKUP(ZRXNCUI) ; FETCH THE VUID
+ . I ZVUID="" D  Q  ; NO VUID FOUND
+ . . S ZROW("TYPE")=4
+ . . D RNF1TO2^C0CRNF(ZARY,"ZROW")
+ . S ZROW("VUID")=ZVUID
+ . I ZVUID["^" S ZVUID=$P(ZVUID,"^",1) ; USE THE FIRST ONE
+ . S ZVAIEN=$$VAPROD^C0PLKUP(ZVUID) ; IEN IN VA PRODUCTS (NDF)
+ . I ZVAIEN=0 D  Q  ; NOT FOUND IN NDF
+ . . S ZROW("TYPE")=4
+ . . D RNF1TO2^C0CRNF(ZARY,"ZROW")
+ . S ZDRUGIEN=$$DRUG^C0PLKUP(ZVAIEN) ; IEN IN DRUG FILE
+ . I ZDRUGIEN=0 D  Q  ;
+ . . S ZROW("TYPE")=3
+ . . S ZROW("VANDFNAME")=$$GET1^DIQ(50.68,ZVAIEN_",",.01) ;NDF NAME
+ . . D RNF1TO2^C0CRNF(ZARY,"ZROW")
+ . S ZVANAME=$$GET1^DIQ(50,ZDRUGIEN_",",.01) ; VA DRUG NAME
+ . S ZROW("VANAME")=ZVANAME ; 
+ . I ZVANAME=$$UP^XLFSTR(ZNAME) S ZROW("TYPE")=1
+ . E  S ZROW("TYPE")=2
+ . D RNF1TO2^C0CRNF(ZARY,"ZROW")
+ . ;B
+ Q
+ ;
+BLDFILE() ; BUILDS THE C0P RXNORM FDB VUID MAPPING FILE #113059010.002
+ ; 
+ ; FIRST DATA BANK DRUGS ARE MATCHED TO VISTA DRUGS THROUGH A MULTI-STEP
+ ; PROCESS. THE MEDID IS THE FIRST DATA BANK NUMBER USED TO REFER TO THEIR
+ ; DRUGS. EACH MEDID HAS A GCN (GENERIC CODE NUMBER) WHICH CAN BE USED TO
+ ; LOOK UP THE DRUG IN THE RXNORM UMLS DATABASE. THE GCN IS USED TO FIND
+ ; THE RXNORM CONCEPT NUMBER (RXNCUI). THE RXNCUI IS USED TO FIND THE VUID
+ ; USING THE RXNORM UMLS DATABASE. THE VUID IS USED TO FIND THE IEN OF THE
+ ; DRUG IN THE VA PRODUCTS FILE (ALSO KNOWN AS THE NDF - NATIONAL DRUG FILE).
+ ; THE VAPROD IEN IS THEN USED TO LOOK UP THE DRUG IN THE VA DRUG FILE
+ ; (FILE 50) USING A NEW CROSS REFERENCE (AC0P) CREATED FOR THIS PURPOSE.
+ ; THE RESULT OF THIS CHAIN IS A DRUG MAPPED FROM THE FDB MEDID TO A
+ ; VA DRUG FILE IEN. TO SUMMARIZE:
+ ; 
+ ; MEDID->GCN->RXNCUI->VUID->VAPROD->DRUGIEN
+ ;
+ ; (NOTE: THIS PROCESS WILL CHANGE - BE IMPROVED - WHEN THE VERIFIED 
+ ; MEDID->RXNORM MAPPING BECOMES AVAILABLE. THIS ANALYSIS WILL ESTABLISH
+ ; A BASELINE WITH WHICH TO COMPARE THE RESULT OF USING THAT MAPPING)
+ ;
+ ; (THE PROCESS IS ACTUALLY MORE COMPLEX THAT THIS, BECAUSE WE ALSO TRY
+ ; AND MATCH DRUGS BY LOOKING AT THEIR CHEMICAL COMPONENTS BUT THIS ANALYSIS
+ ; IGNORES THIS MORE COMPLEX PROCESS.)
+ ; 
+ ; NOT ALL DRUGS MAKE IT ALL THE WAY THROUGH THIS MAPPING. IN ADDITION, THERE
+ ; MAY BE DRUGS THAT ARE IN THE DRUG FILE THAT ARE NOT IN THE FDB FILE
+ ; THIS ROUTINE WILL CREATE A SPREADSHEET THAT WILL SHOW THE UNMAPPED DRUGS
+ ; IN BOTH DIRECTIONS (MEDID->...>DRUGIEN AND DRUGIEN->...>MEDID)
+ ; IT WILL ALSO SHOW THE DRUG NAME AS IT APPEARS IN FIRST DATA BANK
+ ; AND THE NAME THAT WILL BE USED FOR THAT DRUG IN VISTA (ERX). OFTEN
+ ; THEY WILL BE DIFFERENT. IF THE FDB DRUG IS NOT A GENERIC, THE GENERIC NAME
+ ; WILL BY USED BY ERX TO LIST THE DRUG IN THE PATIENT'S DRUG LIST IN VISTA
+ ;
+ ; WE ARE GOING TO ORGANIZE AN ARRAY WITH DRUGS BY TYPE. HERE ARE THE TYPES:
+ ; 
+ ; TYPE 1 - FDB DRUGS THAT MAP EXACTLY TO THE DRUG FILE, WITH NAMES THAT
+ ;  MATCH EXACTLY
+ ;
+ ; TYPE 2 - FDB DRUGS THAT MAP TO THE DRUG FILE, BUT WITH DIFFERENT NAMES.
+ ;  THIS CATEGORY INCLUDES DRUGS THAT ARE SHOWN IN VISTA AS GENERICS BUT
+ ;  ON FDB AS BRAND NAME DRUGS
+ ; 
+ ; TYPE 3 - FDB DRUGS THAT DO NOT MAP TO THE DRUG FILE, BUT DO MAP TO THE
+ ;  VA PRODUCT FILE (NDF). IF ANY OF THESE DRUGS MIGHT BE ORDERED VIA ERX,
+ ;  IT MIGHT BE A GOOD IDEA TO ADD THEM TO THE DRUG FILE.
+ ; NOTE: FOR TYPE 3 AND ABOVE DRUGS, ERX WILL STILL FUNCTION PROPERLY BUT
+ ; INSTEAD OF MAPPING THE DRUG TO THE DRUG FILE, WILL MAP IT AS A FREE TEXT
+ ; DRUG AND WILL SEND A MAIL MESSAGE ABOUT THE MAPPING ERROR SO THAT THE
+ ; DRUG CAN BE CONSIDERED FOR ADDING TO THE DRUG FILE
+ ; 
+ ; TYPE 4 - FDB DRUGS THAT DO NOT MAP TO THE DRUG FILE AND ARE ALSO NOT
+ ;  FOUND IN THE NDF. THIS MIGHT BE THE CASE FOR NEWER DRUGS. ERX WILL
+ ;  STILL FUNCTION, BUT THESE WILL BE FREE TEXT DRUGS. THE REMEDY IS AN
+ ;  UPDATE FROM THE VA OF THE NDF OR ADDING THE DRUGS TO THE NDF AND THE
+ ;  DRUG FILE. (THERE ARE COMPLEXITIES IN ADDING DRUGS TO THE NDF BECAUSE
+ ;  OF HOW TO THEN HANDLE AN UPDATE FROM THE VA)
+ ;
+ ; TYPE 5 - DRUGS IN THE DRUG FILE THAT ARE NOT FOUND IN THE FDB DRUG DATABASE
+ ;  MAPPING. THIS MIGHT INCLUDE BRAND NAME DRUGS IN THE DRUG FILE THAT HAVE
+ ;  BEEN MAPPED TO GENERICS WHEN COMING FROM FDB. IN ANY CASE, THESE ARE DRUGS
+ ;  FOR WHICH THERE IS NO PATH TO MAP FROM THEM TO FDB. (REDUCING THE NUMBER
+ ;  OF DRUGS IN THIS TYPE TO ZERO WILL BE A GOAL BEFORE IMPLEMENTING PHASE II
+ ;  OF ERX WHERE DRUGS WILL BE ORDERED ON VISTA AND SENT TO THE ERX 
+ ;  SERVICE.
+ ;
+ N FN S FN=1130590010.002 ;FILE NUMBER FOR C0P RXNORM FDB VUID MAPPING FILE
+ N C0PFDA 
+ N ZI
+ S ZI=""
+ F  S ZI=$O(^C0P("FDB","B",ZI)) Q:ZI=""  D  ;
+        . W !,ZI
+ . D DOONE(.C0PFDA,ZI) ;BUILD AN FDA
+ . D UPDIE ;WRITE TO FILE
+        . K C0PDFA
+ Q
+ ;
+DOONE(C0PFDA,ZI) ; RETURN FDA FOR MEDID ZI
+ N FN S FN=1130590010.002 ;FILE NUMBER FOR C0P RXNORM FDB VUID MAPPING FILE
+ N ZGCN,ZRXNCUI,ZNAME,ZVAIEN,ZDRUGIEN,ZROW,ZIEN,ZVANAME,ZRXNIEN,ZRXNTXT
+ S (ZGCN,ZRXNCUI,ZNAME,ZVAIEN,ZDRUGIEN,ZVANAME)=""
+ ;S ZROW("MEDID")=ZI ; FDB MEDID
+ S C0PFDA(FN,"?+1,",.02)=ZI ; FDB MEDID
+ S ZIEN=$O(^C0P("FDB","B",ZI,"")) ; IEN OF THE FDB MED
+ S C0PFDA(FN,"?+1,",1.02)=ZIEN ;POINTER TO FDB MED
+ ;S ZROW("FDBNAME")=$$FULLNAME^C0PLKUP(ZI) ; FDB MED NAME
+ S ZNAME=$$FULLNAME^C0PLKUP(ZI) ; FDB MED NAME
+ S C0PFDA(FN,"?+1,",2.02)=ZNAME ; FDB MED NAME
+ S ZGCN=$$GCN^C0PLKUP(ZI)
+ I ZGCN=0 D  Q  ; NO GCN, CAN'T GO FURTHER 
+ . ;S ZROW("TYPE")=4
+ . S C0PFDA(FN,"?+1,",3)=4 ;TYPE 4, CAN'T MAP FDB TO RXN
+ . S C0PFDA(FN,"?+1,",.01)="MISSING RXN" ;NEED TO HAVE A .01
+ . ;D RNF1TO2^C0CRNF(ZARY,"ZROW")
+ ;S ZROW("GCN")=ZGCN
+ S C0PFDA(FN,"?+1,",.04)=$$GCN^C0PLKUP(ZI) ;GENERIC CATEGORY NUMBER
+ S ZRXNCUI=$$RXNCUI^C0PLKUP(ZGCN) ; RETRIEVE THE RXNORM CONCEPT ID
+ I ZRXNCUI="" W !,"ERROR, NO RXNCUI "_ZGCN B  ; SHOULDN'T HAPPEN
+ S C0PFDA(FN,"?+1,",.01)=ZRXNCUI ; RXN CONCEPT
+ S ZRXNIEN=$O(^C0P("RXN","B",ZRXNCUI,"")) ; RXN CONCEPT IEN
+ S C0PFDA(FN,"?+1,",1.01)=ZRXNIEN ; POINTER TO RXN CONCEPT
+ S ZRXNTXT=$G(^C0P("RXN",ZRXNIEN,1,1,0)) ; FIRST LINE OF RXN TEXT
+ S C0PFDA(FN,"?+1,",2.01)=ZRXNTXT ; RXN CONCEPT LABEL
+ ;S ZROW("RXNCUI")=ZRXNCUI
+ S ZVUID=$$VUID^C0PLKUP(ZRXNCUI) ; FETCH THE VUID
+ I ZVUID="" D  Q  ; NO VUID FOUND
+ . ;S ZROW("TYPE")=4
+ . S C0PFDA(FN,"?+1,",3)=4 ;TYPE 4, CAN'T MAP RXNCUI TO VUID
+ . ;D RNF1TO2^C0CRNF(ZARY,"ZROW")
+ ;S ZROW("VUID")=ZVUID
+ S ZVUID=$TR(ZVUID,"^","|") ; CAN'T HAVE ^ IN FIELDS
+ S C0PFDA(FN,"?+1,",.03)=ZVUID ;SET OF VUIDS
+ I ZVUID["|" S ZVUID=$P(ZVUID,"|",1) ; USE THE FIRST ONE
+ S ZVAIEN=$$VAPROD^C0PLKUP(ZVUID) ; IEN IN VA PRODUCTS (NDF)
+ I +ZVAIEN=0 D  Q  ; NOT FOUND IN NDF
+ . ;S ZROW("TYPE")=4
+ . S C0PFDA(FN,"?+1,",3)=4 ;TYPE 4, CAN'T MAP VUID TO NDF
+ . ;D RNF1TO2^C0CRNF(ZARY,"ZROW")
+ S ZDRUGIEN=$$DRUG^C0PLKUP(ZVAIEN) ; IEN IN DRUG FILE
+ I ZDRUGIEN["^" S ZDRUGIEN=$P(ZDRUGIEN,"^",1) ; USE THE FIRST ONE
+ I +ZDRUGIEN=0 D  Q  ;
+ . S ZROW("TYPE")=3
+ . S C0PFDA(FN,"?+1,",3)=3 ;TYPE 3, CAN'T MAP VUID TO DRUG FILE
+ . ;S ZROW("VANDFNAME")=$$GET1^DIQ(50.68,ZVAIEN_",",.01) ;NDF NAME
+ . S C0PFDA(FN,"?+1,",1.04)=ZVAIEN ;POINTER TO NDF
+ . S C0PFDA(FN,"?+1,",2.04)=$$GET1^DIQ(50.68,ZVAIEN_",",.01) ;NDF NAME
+ . ;D RNF1TO2^C0CRNF(ZARY,"ZROW")
+ S ZVANAME=$$GET1^DIQ(50,ZDRUGIEN_",",.01) ; VA DRUG NAME
+ S C0PFDA(FN,"?+1,",2.03)=ZVANAME ; VA DRUG FILE NAME
+ S C0PFDA(FN,"?+1,",1.03)=$G(ZDRUGIEN) ; VA DRUG FILE IEN
+ ;S ZROW("VANAME")=ZVANAME ; 
+ I ZVANAME=$$UP^XLFSTR(ZNAME) S ZROW("TYPE")=1
+ E  S ZROW("TYPE")=2
+ S C0PFDA(FN,"?+1,",3)=ZROW("TYPE") ; MATCHING TYPE 1 OR 2
+ ;D RNF1TO2^C0CRNF(ZARY,"ZROW")
+ ;B
+ Q
+ ;
+UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+ ;Q  ;//SMH don't want an update
+ ;I C0PFDA(FN,"+1,",3)'=3 Q  ;
+        ;I C0PFDA(FN,"+1,",1.02)=1 Q  ;
+ ;ZWR C0PFDA ;
+ K ZERR
+ D CLEAN^DILF
+ D UPDATE^DIE("","C0PFDA","","ZERR")
+ ;I $D(ZERR) D  ;
+ ;. W "ERROR",!
+ ;. ZWR ZERR
+ ;. B
+ K C0PFDA
+ Q
+ ;
Index: ePrescribing/trunk/p/C0PWPS.m
===================================================================
--- ePrescribing/trunk/p/C0PWPS.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PWPS.m	(revision 1595)
@@ -0,0 +1,164 @@
+C0PWPS	  ; ERX/GPL - eRx CPRS RPCs ; 2/8/10 ; 5/8/12 5:24pm
+	;;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
+	; These routines are substitutes for COVER^ORWPS and DETAIL^ORWPS to
+	; display eRx and CCR/CCD medication lists accurately
+	;
+COVER(LST,DFN)	 ; retrieve meds for cover sheet
+	K ^TMP("PS",$J)
+	D OCL^PSOORRL(DFN,"","")  ;DBIA #2400
+	N ILST,ITMP,X S ILST=0
+	S ITMP="" F  S ITMP=$O(^TMP("PS",$J,ITMP)) Q:'ITMP  D
+	. S X=^TMP("PS",$J,ITMP,0)
+	. I '$L($P(X,U,2)) S X="??"  ; show something if drug empty
+	. I $D(^TMP("PS",$J,ITMP,"CLINIC",0)) S LST($$NXT^ORWPS)=$P(X,U,1,2)_U_$P(X,U,8,9)_U_"C"
+	. E  S LST($$NXT^ORWPS)=$P(X,U,1,2)_U_$P(X,U,8,9)
+	K ^TMP("PS",$J)
+	; BEGIN NEW PROCESSING (EVERYTHING ABOVE WAS COPIED FROM COVER^0RWPS
+	N ZCUR
+	D GET^C0PCUR(.ZCUR,DFN) ; GET THE DETAIL FOR THE SAME MEDS LIST
+	N ZI S ZI=""
+	F  S ZI=$O(LST(ZI)) Q:ZI=""  D  ;FOR EACH MED IN THE LIST
+	. I $P(LST(ZI),U,2)["FREE TXT" D  ; IS AN ERX UNMAPPED DRUG
+	. . N ZD
+	. . S ZD=$P(ZCUR(ZI,"SIG",1,0),"|",1) ; REAL DRUG NAME SHOULD BE IN SIG
+	. . ; SEPARATED BY "|"
+	. . I ZD'="" S $P(LST(ZI),U,2)=ZD ; IF SO, USE THE REAL NAME
+	; BEGIN VISTACOM MOD -
+	; SAVE THE DUZ OFF TO THE VISTACOM TMP GLOBAL
+	S ^TMP("ZEWD",$J,"DUZ")=DUZ ; TO BE PICKED UP AND DELETED LATER BY VISTACOM
+	Q
+COVER2(LST,DFN)	 ; retrieve meds for cover sheet ;
+	; THIS VERSION WILL DISPLAY THE DRUG NAME FROM THE PHARMACY ORDERABLE
+	; ITEMS FILE FOR ERX DRUGS. THIS ALLOWS THE DRUG TO APPEAR AS GENERIC(BRAND)
+	; FOR CERTAIN DRUGS - GPL 10/5/10
+	K ^TMP("PS",$J)
+	D OCL^PSOORRL(DFN,"","")  ;DBIA #2400
+	N ILST,ITMP,X S ILST=0
+	S ITMP="" F  S ITMP=$O(^TMP("PS",$J,ITMP)) Q:'ITMP  D
+	. S X=^TMP("PS",$J,ITMP,0)
+	. I '$L($P(X,U,2)) S X="??"  ; show something if drug empty
+	. I $D(^TMP("PS",$J,ITMP,"CLINIC",0)) S LST($$NXT^ORWPS)=$P(X,U,1,2)_U_$P(X,U,8,9)_U_"C"
+	. E  S LST($$NXT^ORWPS)=$P(X,U,1,2)_U_$P(X,U,8,9)
+	K ^TMP("PS",$J)
+	; BEGIN NEW PROCESSING (EVERYTHING ABOVE WAS COPIED FROM COVER^0RWPS
+	N ZCUR
+	D GET^C0PCUR(.ZCUR,DFN) ; GET THE DETAIL FOR THE SAME MEDS LIST
+	N ZI S ZI=""
+	F  S ZI=$O(LST(ZI)) Q:ZI=""  D  ;FOR EACH MED IN THE LIST
+	. I $P(LST(ZI),U,2)["FREE TXT" D  ; IS AN ERX UNMAPPED DRUG
+	. . N ZD
+	. . S ZD=$P(ZCUR(ZI,"SIG",1,0),"|",1) ; REAL DRUG NAME SHOULD BE IN SIG
+	. . ; SEPARATED BY "|"
+	. . I ZD'="" S $P(LST(ZI),U,2)=ZD ; IF SO, USE THE REAL NAME
+	. E  I $P(LST(ZI),U,1)["N" D  ; THIS IS A NONVA DRUG
+	. . N ZD,ZDIEN
+	. . I $G(ZCUR(ZI,"COMMENTS",1))["E-Rx" D  ; IS AN ERX DRUG
+	. . . S ZDIEN=$G(ZCUR(ZI,"DRUG")) ; IEN IN THE DRUG FILE
+	. . . S ZD=$$GET1^DIQ(50,ZDIEN,2.1) ; THE PHARMACY ORDERABLE ITEM
+	. . . I ZD'="" S $P(LST(ZI),U,2)=ZD ; USE THIS DRUG NAME
+	; BEGIN VISTACOM MOD -
+	; SAVE THE DUZ OFF TO THE VISTACOM TMP GLOBAL
+	S ^TMP("ZEWD",$J,"DUZ")=DUZ ; TO BE PICKED UP AND DELETED LATER BY VISTACOM
+	Q
+COVER3(LST,DFN)	 ; retrieve meds for cover sheet ;
+	; THIS VERSION WILL DISPLAY THE FIRST DATA BANK DRUG NAME WHERE AVAILABLE
+	;  - GPL 10/6/10
+	K ^TMP("PS",$J)
+	D OCL^PSOORRL(DFN,"","")  ;DBIA #2400
+	N ILST,ITMP,X S ILST=0
+	S ITMP="" F  S ITMP=$O(^TMP("PS",$J,ITMP)) Q:'ITMP  D
+	. S X=^TMP("PS",$J,ITMP,0)
+	. I '$L($P(X,U,2)) S X="??"  ; show something if drug empty
+	. I $D(^TMP("PS",$J,ITMP,"CLINIC",0)) S LST($$NXT^ORWPS)=$P(X,U,1,2)_U_$P(X,U,8,9)_U_"C"
+	. E  S LST($$NXT^ORWPS)=$P(X,U,1,2)_U_$P(X,U,8,9)
+	K ^TMP("PS",$J)
+	; BEGIN NEW PROCESSING (EVERYTHING ABOVE WAS COPIED FROM COVER^0RWPS
+	N ZCUR
+	D GET^C0PCUR(.ZCUR,DFN) ; GET THE DETAIL FOR THE SAME MEDS LIST
+	N ZI S ZI=""
+	F  S ZI=$O(LST(ZI)) Q:ZI=""  D  ;FOR EACH MED IN THE LIST
+	. I $P(LST(ZI),U,2)["FREE TXT" D  ; IS AN ERX UNMAPPED DRUG
+	. . N ZD
+	. . S ZD=$P(ZCUR(ZI,"SIG",1,0),"|",1) ; REAL DRUG NAME SHOULD BE IN SIG
+	. . ; SEPARATED BY "|"
+	. . I ZD'="" S $P(LST(ZI),U,2)=ZD ; IF SO, USE THE REAL NAME
+	. E  I $P(LST(ZI),U,1)["N" D  ; THIS IS A NONVA DRUG
+	. . N ZD,ZDSIG
+	. . S ZDSIG=ZCUR(ZI,"SIG",1,0) ; THE SIG (CHECK THIS PLEASE)
+	. . I ZDSIG["|" D  ; THERE ARE TWO PARTS TO THE SIG
+	. . . S ZD=$P(ZDSIG,"|",1) ; FDB DRUG NAME SHOULD BE IN SIG
+	. . . I ZD'="" S $P(LST(ZI),U,2)=ZD ; IF SO, USE THE FDB NAME
+	; BEGIN VISTACOM MOD -
+	; SAVE THE DUZ OFF TO THE VISTACOM TMP GLOBAL
+	S ^TMP("ZEWD",$J,"DUZ")=DUZ ; TO BE PICKED UP AND DELETED LATER BY VISTACOM
+	Q
+DETAIL(ROOT,DFN,ID)	; -- show details for a med order
+	K ^TMP("ORXPND",$J)
+	N ZID
+	S ZID=ID
+	N LCNT,ORVP
+	S LCNT=0,ORVP=DFN_";DPT("
+	D MEDS^ORCXPND1
+	S ROOT=$NA(^TMP("ORXPND",$J))
+	I @ROOT@(11,0)="Order #0" D ERXDET
+	Q
+ERXDET	; BUILD ERX MED DETAIL
+	N ZMEDS
+	D GET^C0PCUR(.ZMEDS,DFN)
+	N ZI,FOUND
+	S FOUND=0 S ZI=""
+	F  Q:FOUND'=0  S ZI=$O(ZMEDS(ZI)) Q:ZI=""  D  ; SEARCH FOR THE ID
+	. I $P(ZMEDS(ZI,0),U,1)=ZID S FOUND=1 ; ID MATCHES THE MED
+	I FOUND=0 Q  ; NO MATCH FOR THE MED
+	K @ROOT ; CLEAR OUT THE NULL DETAIL
+	;W !,"MED FOUND ",ZI," ",ZID
+	N ZNAME,ZSIG,ZCOM,ZFDBN
+	S ZNAME=$P(ZMEDS(ZI,0),U,2)
+	S ZSIG=$G(ZMEDS(ZI,"SIG",1,0))
+	M ZCOM=ZMEDS(ZI,"COMMENTS")
+	I ZNAME["FREE TXT" D  ;
+	. S ZNAME=$P(ZSIG,"|",1)
+	. S ZSIG=$P(ZSIG,"| ",2)
+	E  I ZSIG["|" D  ; NEED TO PULL OUT THE DRUG NAME FROM THE SIG
+	. S ZFDBN=$P(ZSIG,"|",1)
+	. S ZSIG=$P(ZSIG,"| ",2)
+	N ZN S ZN=1
+	S @ROOT@(ZN,0)=" Medication: "_ZNAME S ZN=ZN+1
+	I $G(ZFDBN)'="" D  ; IF FIRST DATA BANK NAME IS KNOWN
+	. S @ROOT@(ZN,0)="                                     " S ZN=ZN+1
+	. S @ROOT@(ZN,0)="   FDB Name: "_ZFDBN S ZN=ZN+1
+	. S @ROOT@(ZN,0)="                                     " S ZN=ZN+1
+	E  S @ROOT@(ZN,0)="                                     " S ZN=ZN+1
+	S @ROOT@(ZN,0)="        Sig: "_ZSIG S ZN=ZN+1
+	S @ROOT@(ZN,0)=""  S ZN=ZN+1
+	S @ROOT@(ZN,0)="     Status: "_$P(ZMEDS(ZI,0),U,9) S ZN=ZN+1
+	S @ROOT@(ZN,0)="" S ZN=ZN+1
+	S @ROOT@(ZN,0)="   Schedule: "_$G(ZMEDS(ZI,"SCH",1,0)) S ZN=ZN+1
+	S @ROOT@(ZN,0)="                " S ZN=ZN+1
+	S @ROOT@(ZN,0)=" Start Date: "_$$FMTE^XLFDT($G(ZMEDS(ZI,"START"))) S ZN=ZN+1
+	S @ROOT@(ZN,0)="                " S ZN=ZN+1
+	S @ROOT@(ZN,0)="    Source:  ePrescribing          " S ZN=ZN+1
+	S @ROOT@(ZN,0)="                " S ZN=ZN+1
+	N ZI S ZI=""
+	F  S ZI=$O(ZCOM(ZI)) Q:ZI=""  D   ;
+	. S @ROOT@(12+ZI,0)=ZCOM(ZI) ;COMMENT LINE
+	Q
+	;
Index: ePrescribing/trunk/p/C0PWS1.m
===================================================================
--- ePrescribing/trunk/p/C0PWS1.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PWS1.m	(revision 1595)
@@ -0,0 +1,452 @@
+C0PWS1	  ; ERX/GPL - Web Service utilities; 8/31/09 ; 5/9/12 12:14am
+	;;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.
+TEST(C0PDUZ,C0PDFN)	; TEST RETRIEVAL OF PATIENT1 MEDS
+	;S DEBUG=1 ;
+	D SOAP("C0POUT",6,C0PDUZ,C0PDFN)
+	ZWRITE C0POUT
+	Q
+	;
+ACCOUNTF()	 Q 113059002  ; file number for account file
+XMLFN()	 Q 113059001  ; XML TEMPLATE FILE NUMBER
+BINDFN()	 Q 113059001.04 ; FILE NUMBER FOR BINDING SUBFILE
+	;
+GETTID(C0PWS,C0PTNAME)	; EXTRINSIC WHICH RETURNS THE TEMPLATE ID FOR
+	; TEMPLATE NAMED C0PTNAME BELONGING TO WEB SERVICE NAMED C0PWS
+	; ALSO WORKS IF THE ACCOUNT NUMBER IS PASSED IN C0PWS
+	S C0PXF=113059001 ; FILE NUMBER FOR THE C0P XML TEMPLATE FILE
+	S C0PAF=113059002 ; FILE NUMBER FOR THE C0P WS ACCT FILE
+	N C0PA,C0PT ; C0P ACCOUNT AND C0P TEMPLATE
+	I C0PWS>0 S C0PA=C0PWS
+	E  D  ; NAME NOT RECORD NUMBER IS PASSED FOR ACCOUNT
+	. S C0PA=$O(^C0PS("B",C0PWS,"")) ; RECORD NUMBER OF ACCOUNT
+	. I C0PA="" D  Q  ; OOPS ACCOUNT NOT FOUND
+	. . W "ACCOUNT "_C0PWS_" NOT FOUND",!
+	S C0PT=$O(^C0PX("C",C0PA,C0PTNAME,"")) ; RECORD NUMBER OF TEMPLATE
+	; WE USE THE C INDEX TO INSURE THAT THE TEMPLATE BELONGS TO THE WEB SERVICE
+	Q C0PT
+	;
+RESTID(C0PDUZ,C0PTID)	; RESOLVE TEMPLATE ID FROM SUBSCRIPTION
+	;
+	N C0PAIEN S C0PAIEN=$$SUBINIT^C0PSUB(C0PDUZ) ;IEN OF SUBSCRIPTION
+	N C0PACCT S C0PACCT=$$GET1^DIQ(C0PSUBF,C0PAIEN_","_C0PDUZ_",",1,"I") ;ACCT
+	N C0PWBS S C0PWBS=$$GET1^DIQ(C0PAF,C0PACCT_",",4,"I") ;WEB SERVICE IEN
+	N C0PUTID S C0PUTID=$$GETTID(C0PWBS,C0PTID) ;TEMPLATE ID
+	Q C0PUTID
+	;
+SOAP(C0PRTN,C0PTID,C0PDUZ,C0PDFN,C0PVOR)	; MAKES A SOAP CALL FOR 
+	; TEMPLATE ID C0PTID
+	; RETURNS THE XML RESULT IN C0PRTN, PASSED BY NAME
+	; C0PVOR IS THE NAME OF A VARIABLE OVERRIDE ARRAY, WHICH IS APPLIED 
+	; BEFORE MAPPING
+	;
+	; ARTIFACTS SECTION
+	; THE FOLLOWING WILL SET UP DEBUGGING ARTIFACTS FOR A POSSIBLE FUTURE
+	; ONLINE DEBUGGER. IF DEBUG=1, VARIABLES CONTAINING INTERMEDIATE RESULTS
+	; WILL NOT BE NEWED.
+	I $G(DEBUG)="" N C0PV ; CATALOG OF ARTIFACT VARIABLES AND ARRAYS
+	S C0PV(100,"C0PXF","XML TEMPLATE FILE NUMBER")=""
+	S C0PV(200,"C0PHEAD","SOAP HEADER VARIABLE NAME")=""
+	S C0PV(300,"header","SOAP HEADER")=""
+	S C0PV(400,"C0PMIME","MIME TYPE")=""
+	S C0PV(500,"C0PURL","WS URL")=""
+	S C0PV(550,"C0PPURL","PROXY URL")=""
+	S C0PV(600,"C0PXML","XML VARIABLE NAME")=""
+	S C0PV(700,"xml","OUTBOUND XML")=""
+	S C0PV(800,"C0PRSLT","RAW XML RESULT RETURNED FROM WEB SERVICE")=""
+	S C0PV(900,"C0PRHDR","RETURNED HEADER")=""
+	S C0PV(1000,"C0PRXML","XML RESULT NORMALIZED")=""
+	S C0PV(1100,"C0PR","REPLY TEMPLATE")=""
+	S C0PV(1200,"C0PREDUX","REDUX STRING")=""
+	S C0PV(1300,"C0PIDX","RESULT XPATH INDEX")=""
+	S C0PV(1400,"C0PARY","RESULT XPATH ARRAY")=""
+	S C0PV(1500,"C0PNOM","RESULT DOM DOCUMENT NAME")=""
+	S C0PV(1600,"C0PID","RESULT DOM ID")=""
+	I $G(DEBUG)'="" G NOTNEW ; SKIP NEWING THE VARIABLES IF IN DEBUG
+	N ZI,ZJ S ZI=""
+NEW	; new the variables
+	S ZI=$O(C0PV(ZI))
+	S ZJ=$O(C0PV(ZI,"")) ; SET UP NEW COMMAND
+	;W ZJ,!
+	N @ZJ ; NEW THE VARIABLE
+	I $O(C0PV(ZI))'="" G NEW ;LOOP TO GET NEW IN CONTEXT
+NOTNEW	; (goto label) don't new the variables... skip that
+	; END ARTIFACTS
+	;
+	D INITXPF("C0PF") ; SET FILE NUMBER AND PARAMATERS 
+	S C0PXF=C0PF("XML FILE NUMBER") ; FILE NUMBER FOR THE C0P XML TEMPLATE FILE
+	I +C0PTID=0 D  ; A STRING WAS PASSED FOR THE TEMPLATE NAME
+	. S C0PUTID=$$RESTID(C0PDUZ,C0PTID) ;RESOLVE TEMPLATE IEN FROM NAME
+	E  S C0PUTID=C0PTID ; AN IEN WAS PASSED
+	N xml,template,header
+	S C0PHEAD=$$GET1^DIQ(C0PXF,C0PUTID_",",2.2,,"header")
+	S C0PMIME=$$GET1^DIQ(C0PXF,C0PUTID_",","MIME TYPE")
+	S C0PPURL=$$GET1^DIQ(C0PXF,C0PUTID_",","PROXY SERVER")
+	;S C0PURL=$$GET1^DIQ(C0PXF,C0PUTID_",","URL") ;GPL CHANGE TO USE PROD FLAG
+	D SETUP^C0PMAIN() ; INITIALIZE C0PACCT IEN OF WS ACCOUNT
+	S C0PURL=$$WSURL^C0PMAIN(C0PACCT) ; RESOLVES PRODUCTION VS TEST
+	S C0PXML=$$GET1^DIQ(C0PXF,C0PUTID_",",2.1,,"xml")
+	S C0PTMPL=$$GET1^DIQ(C0PXF,C0PUTID_",",3,,"template")
+	I C0PTMPL="template" D  ; there is a template to process
+	. K xml ; going to replace the xml array
+	. D EN^C0PMAIN("xml","url",C0PDUZ,C0PDFN,C0PUTID,$G(C0PVOR))
+	. ;N ZZG M ZZG(1)=xml
+	. ;S ZDIR=^TMP("C0CCCR","ODIR")
+	. ;ZWR ZZG(1)
+	. ;W $$OUTPUT^C0CXPATH("xml(1)","GPLTEST-"_ZDFN_".xml",ZDIR)
+	I $G(C0PPROXY) S C0PURL=C0PPURL
+	I '$D(C0PERROR) S C0PERROR="0^NO ERRORS" ; to do: start using this gpl
+	K C0PRSLT,C0PRHDR
+	;
+	; token to catch runaway linux jobs - gpl 4/12/2012
+	; But not ready for release b/c depends on code that is not available --smh 5/9/12
+	; D LOG^C0PTRAK($J,"PULLBACK")
+	;
+	S ok=$$httpPOST^%zewdGTM(C0PURL,.xml,C0PMIME,.C0PRSLT,.header,"",.gpl5,.C0PRHDR)
+	;
+	; kill token after return from EWD
+	;
+	;D UNLOG^C0PTRAK($J) ; success, remove the token ; smh commented out 5/9/12
+	;K ^TMP("C0PERX",$J)
+	K C0PRXML
+	;I DUZ=135 B  ; patch so others can use the pullback while i debug - gpl
+	;. ;I $D(C0PRSLT(1)) D NORMAL("C0PRXML","C0PRSLT(1)") ;RETURN XML IN AN ARRAY
+	;. I $D(C0PRSLT(1)) D CHUNK("C0PRXML","C0PRSLT",2000) ;RETURN IN AN ARRAY  
+	;. ; SWITCHED TO CHUNK TO HANDLE ARRAYS OF XML
+	;E  I $D(C0PRSLT(1)) D NORMAL("C0PRXML","C0PRSLT(1)") ;RETURN XML IN AN ARRAY
+	; The following is a temporary fix to keep eRx working while a better 
+	; solution is developed. Template ID 6 is GETMEDS for eRx and it needs
+	; to handle xml files that are too big for NORMAL to handle. So, I wrote
+	; CHUNK which will allow us to handle any size xml file bound for the
+	; EWD parser. 
+	; However, all the other templates in eRx need NORMAL to find the 
+	; embedded XML file in their web service responses. So, we will use
+	; CHUNK for template 6 and continue to use NORMAL for all other templates
+	; we can handle big med lists, but not big web service calls.
+	; What is needed is a better NORMAL (see NORMAL2) or another routine
+	; to detect, extract, and decode embeded XML files of any size. gpl 10/8/10
+	I C0PUTID=6 D  ;
+	. I $D(C0PRSLT(1)) D CHUNK("C0PRXML","C0PRSLT",2000) ;RETURN IN AN ARRAY  
+	E  I $D(C0PRSLT(1)) D NORMAL("C0PRXML","C0PRSLT(1)") ;RETURN XML IN AN ARRAY
+	S C0PR=$$GET1^DIQ(C0PXF,C0PUTID_",",.03,"I") ; REPLY TEMPLATE
+	; reply templates are optional and are specified by populating a
+	; template pointer in field 2.5 of the request template
+	; if specified, the reply template is the source of the REDUX string
+	; used for XPath on the reply, and for UNBIND processing
+	; if no reply template is specified, REDUX is obtained from the request
+	; template and no UNBIND processing is performed. The XPath array is
+	; returned without variable bindings
+	I C0PR'="" D  ; REPLY TEMPLATE EXISTS
+	. I +$G(DEBUG)'=0 W "REPLY TEMPLATE:",C0PR,!
+	. S C0PTID=C0PR ;
+	S C0PREDUX=$$GET1^DIQ(C0PXF,C0PUTID_",",2.5) ;XPATH REDUCTION STRING
+	K C0PIDX,C0PARY ; XPATH INDEX AND ARRAY VARS
+	S C0PNOM="C0PMEDS"_$J ; DOCUMENT NAME FOR THE DOM
+	N ZBIG S ZBIG=0
+	I C0PUTID'=6 D  ;
+	. S ZBIG=$$TOOBIG("C0PRXML") ; PATCH BY GPL WHICH ASSUMES ONLY
+	. ; TEMPLATE 1 IS A REGULAR XML FILE.. EVERYTHING ELSE HAS EMBEDDED XML
+	I ZBIG>0 D  ; PROBABLY AN EMBEDDED XML DOCUMENT
+	. S C0PID=$$UNWRAP("C0PRXML",ZBIG,C0PNOM) ; DECODE AND PARSE THE EMBEDED XML
+	E  S C0PID=$$PARSE^C0PXEWD("C0PRXML",C0PNOM) ;CALL THE PARSER
+	;S C0PID=$$PARSE^C0PXEWD("C0PRXML",C0PNOM) ;CALL THE PARSER
+	S C0PID=$$FIRST^C0PXEWD($$ID^C0PXEWD(C0PNOM)) ;ID OF FIRST NODE
+	D XPATH^C0PXEWD(C0PID,"/","C0PIDX","C0PARY","",C0PREDUX) ;XPATH GENERATOR
+	S OK=$$DELETE^C0PXEWD(C0PNOM) ; REMOVE PARSED XML FROM THE EWD DOM
+	; Next, call UNBIND to map the reply XPath array to variables
+	; This is only done if a Reply Template is provided
+	D DEMUXARY(C0PRTN,"C0PARY")
+	; M @C0PRTN=C0PARY
+	Q
+	;
+TOOBIG(ZXML)	; EXTRINSIC WHICH RETURNS TRUE IF ANY NODE IS OVER 2000 CHARS
+	; RETURNS THE INDEX OF THE LARGE NODE . IF NO LARGE NODE, RETURNS ZERO
+	N ZI,ZR
+	S ZI=""
+	S ZR=0 ; DEFAULT FALSE
+	F  S ZI=$O(@ZXML@(ZI)) Q:ZI=""  D  ;
+	. I $L(@ZXML@(ZI))>1000 S ZR=ZI
+	Q ZR
+	;
+NORMAL(OUTXML,INXML)	;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
+	; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
+	;
+	N ZI,ZN,ZTMP
+	S ZN=1
+	S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">"
+	S ZN=ZN+1
+	F  S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)=""  D  ;
+	. S @OUTXML@(ZN)=@OUTXML@(ZN)_">"
+	. S ZN=ZN+1
+	Q
+	;
+CHUNK(OUTXML,INXML,ZSIZE)	; BREAKS INXML INTO ZSIZE BLOCKS
+	; INXML IS AN ARRAY PASSED BY NAME OF STRINGS
+	; OUTXML IS ALSO PASSED BY NAME
+	; IF ZSIZE IS NOT PASSED, 1000 IS USED
+	I '$D(ZSIZE) S ZSIZE=1000 ; DEFAULT BLOCK SIZE
+	N ZB,ZI,ZJ,ZK,ZL,ZN
+	S ZB=ZSIZE-1
+	S ZN=1
+	S ZI=0 ; BEGINNING OF INDEX TO INXML
+	F  S ZI=$O(@INXML@(ZI)) Q:+ZI=0  D  ; FOR EACH STRING IN INXML
+	. S ZL=$L(@INXML@(ZI)) ; LENGTH OF THE STRING
+	. F ZJ=1:ZSIZE:ZL D  ;
+	. . S ZK=$S(ZJ+ZB<ZL:ZJ+ZB,1:ZL) ; END FOR EXTRACT
+	. . S @OUTXML@(ZN)=$E(@INXML@(ZI),ZJ,ZK) ; PULL OUT THE PIECE
+	. . S ZN=ZN+1 ; INCREMENT OUT ARRAY INDEX
+	Q
+	;
+NORMAL2(OUTXML,INXML)	;NORMALIZES AN ARRAY OF XML STRINGS PASSED BY NAME INXML
+	; AS @INXML@(1) TO @INXML@(x) ALL NUMERIC
+	; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
+	; this routine doesn't work unless the blocks are on xml tag boundaries - gpl
+	; which is hard to do... this routine is left here awaiting future development
+	N ZI,ZN,ZJ
+	S ZJ=0
+	S ZN=1
+	F  S ZJ=$O(@INXML@(ZJ)) Q:+ZJ=0  D  ; FOR EACH XML STRING IN ARRAY
+	. S @OUTXML@(ZN)=$P(@INXML@(ZJ),"><",ZN)_">"
+	. S ZN=ZN+1
+	. F  S @OUTXML@(ZN)="<"_$P(@INXML@(ZJ),"><",ZN) Q:$P(@INXML@(ZJ),"><",ZN+1)=""  D  ;
+	. . S @OUTXML@(ZN)=@OUTXML@(ZN)_">"
+	. . S ZN=ZN+1
+	Q
+	;
+UNWRAP(ZXML,ZI,ZNOM)	; EXTRINSIC TO LOCATE, DECODE AND PARSE AN EMBEDED XML DOC
+	; RETURNS THE DOCID OF THE DOM
+	N ZS,ZX
+	S ZS=$P($P(@ZXML@(ZI),">",2),"<",1) ; PULL OUT THE ENCODED STRING
+	S ZX=$$DECODE^RGUTUU(ZS)
+	N ZZ
+	N ZY S ZY="<?xml version=""1.0"" encoding=""utf-8""?>"
+	I $E(ZX,1,5)'="<?xml" S ZZ(1)=ZY_ZX
+	E  S ZZ(1)=ZX
+	N ZI
+	;F ZI=1:1 Q:$$REDUCE(.ZZ,ZI) ; CHOP THE STRING INTO 4000 CHAR ARRAY
+	S ZI=$$REDUCRCR(.ZZ,1) ; RECURSIVE VERSION OF REDUCE
+	S G=$$PARSE^C0PXEWD("ZZ",C0PNOM)
+	I G=0 D ERROR^C0PMAIN(",U113059005,",$ST($ST,"PLACE"),"ERX-XML-PRS","XML Parsing Error") QUIT  ;ZWR ^TMP("MXMLERR",$J,*) B
+	Q G
+	;
+REDUCE(ZARY,ZN)	; WILL REDUCE ZARY(ZN) BY CHOPPING IT TO 4000 CHARS
+	; AND PUTTING THE REST IN ZARY(ZN+1)
+	; ZARY IS PASSED BY REFERENCE
+	; EXTRINSIC WHICH RETURNS FALSE IF THERE IS NOTHING TO REDUCE
+	I $L(ZARY(ZN))<4001 Q 0 ;NOTHING TO REDUCE
+	S ZARY(ZN+1)=$E(ZARY(ZN),4001,$L(ZZ(ZN))) ;BREAK IT UP
+	S ZARY(ZN)=$E(ZARY(ZN),1,4000) ;  
+	Q 1  ;ACTUALLY REDUCED
+	;
+REDUCRCR(ZARY,ZN)	; RECURSIVE VERSION OF REDUCE ABOVE
+	; WILL REDUCE ZARY(ZN) BY CHOPPING IT TO 4000 CHARS
+	; AND PUTTING THE REST IN ZARY(ZN+1)
+	; ZARY IS PASSED BY REFERENCE
+	; EXTRINSIC WHICH RETURNS FALSE IF THERE IS NOTHING TO REDUCE
+	I $L(ZARY(ZN))<4001 Q 0 ;NOTHING TO REDUCE
+	S ZARY(ZN+1)=$E(ZARY(ZN),4001,$L(ZZ(ZN))) ;BREAK IT UP
+	S ZARY(ZN)=$E(ZARY(ZN),1,4000) ;  
+	I '$$REDUCRCR(.ZARY,ZN+1) Q 1 ; CALL RECURSIVELY
+	Q 1  ;ACTUALLY REDUCED
+	;
+DEMUXARY(OARY,IARY)	;CONVERT AN XPATH ARRAY PASSED AS IARY TO
+	; FORMAT @OARY@(x,xpath) where x is the first multiple
+	N ZI,ZJ,ZK,ZL S ZI=""
+	F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ;
+	. D DEMUX^C0CMXP("ZJ",ZI)
+	. S ZK=$P(ZJ,"^",3)
+	. S ZK=$RE($P($RE(ZK),"/",1))
+	. S ZL=$P(ZJ,"^",1)
+	. I ZL="" S ZL=1
+	. S @OARY@(ZL,ZK)=@IARY@(ZI)
+	Q
+	;
+	; BEGIN OLD CODE - REMOVE AFTER A WHILE WHEN "SOAP" SETTLES DOWN - GPL
+	;s URL="http://preproduction.newcropaccounts.com/InterfaceV7/Doctor.xml"
+	;D GETPOST1(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))
+	;I $$GET1^DIQ(113059001,"3,",2.1,,"gpl")'="gpl" D  Q  ; ERR GETTING TEMPLATE
+	;. W "ERROR RETRIEVING TEMPLATE",!
+	;S gpl(1)="RxInput="_gpl(1)
+	S url="https://preproduction.newcropaccounts.com/InterfaceV7/RxEntry.aspx"
+	S url="https://secure.newcropaccounts.com/V7/WebServices/Doctor.asmx"
+	S url="http://76.110.202.22/v7/WebServices/Doctor.asmx" ;RICHARD'S SOAP PROXY SERVER
+	;S url="http://76.110.202.22/" ;RICHARD'S SOAP PROXY SERVER
+	N header
+	S ZH=$$GET1^DIQ(113059001,"3,",2.2,,"header")
+	;W $$OUTPUT^C0CXPATH("gpl(1)","NewCropV7-DOCTOR2.xml","/home/dev/CCR/"),!
+	S ok=$$httpPOST^%zewdGTM(url,.gpl,"text/xml; charset=utf-8",.gpl6,.header,"",.gpl5,.gpl7)
+	;S ok=$$httpPOST2(.RTN,url,.gpl,"text/xml; charset=utf-8",.gpl6,.header,"",.gpl5,.gpl7)
+	;S ok=$$httpPOST2(.RTN,"https://preproduction.newcropaccounts.com/InterfaceV7/RxEntry.aspx",.gpl,"application/x-www-form-urlencoded",.gpl6,"","",.gpl5,.gpl7)
+	ZWRITE gpl6 ; smh: this zwrite is never reached.
+	Q
+PARSE(INXML,INDOC)	;CALL THE EWD PARSER ON INXML, PASSED BY NAME
+	; INDOC IS PASSED AS THE DOCUMENT NAME TO EWD
+	; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY EWD
+	N ZR
+	M ^CacheTempEWD($j)=@INXML ;
+	S ZR=$$parseDocument^%zewdHTMLParser(INDOC)
+	K ^CacheTempEWD($j) ;clean up after
+	Q ZR
+	;
+ADDWS(WSNAME,WSTNAM,WSURL)	; ADD A WEB SERVICE TEMPLATE GIVEN A WSDL URL
+	; WSNAME IS THE NAME OF THE WEB SERVICE.. WILL BE LAYGO
+	; WSTNAM IS THE TEMPLATE NAME TO BE ADDED TO BE CREATED AND IMPORTED
+	; WSURL IS THE URL TO THE WSDL DEFINITION OF THE TEMPLATE
+	; WILL FIRST TRY AND FETCH THE XML FROM THE INTERNET USING THE URL
+	; IF SUCCESSFUL, AND THE RETURN XML IS VALID, AN ENTRY IN THE XML TEMPLATE
+	; FILE WILL BE CREATED, WITH THE RAW XML AND DERIVED TEMPLATE XML.
+	; THEN ENTRIES IN THE BINDING SUBFILE WILL BE CREATED FOR EACH XPATH
+	; FINALLY, THE TEMPLATE WILL BE POINTED TO IN THE WEB SERVICE FILE TEMPLATE
+	; MULTIPLE
+	N C0PWSF S C0PWSF=113059003 ; WEB SERVICE FILE
+	N C0PXTF S C0PXTF=113059001 ; XML TEMPLATE FILE
+	; NEVER MIND... WRONG APPROACH
+	Q
+	;
+TBLD(INT)	; TEMPLATE BUILD OF TEMPLATE INT
+	; want to break this up into pieces -  gpl
+	; THE TEMPLATE NEEDS TO EXIST AND THE DEFINING XML URL MUST BE POPULATED
+	; THEN THE DEFINING XML WILL BE RETRIVED AND STORED INTO THE RAW XML FIELD
+	; IT WILL BE TRANSFORMED INTO A TEMPLATE AND STORED IN THE TEMPLATE FIELD
+	; ALL THE XPATHs WILL BE EXTRACTED AND A BINDING MULTIPLE CREATED FOR EACH
+	; ALL IN ONE SIMPLE ROUTINE
+	; WHAT REMAINS IS FOR MANUAL ENTRY OF THE OTHER FIELDS IN THE BINDINGS
+	N C0PXTF S C0PXTF=113059001 ; XML TEMPLATE FILE
+	N C0PURL ; URL TO RETRIEVE THE DEFINING XML FOR THE TEMPLATE
+	S C0PURL=$$GET1^DIQ(C0PXTF,INT,2)
+	D GET1URL^C0PEWD2(C0PURL)
+	D CLEAN^DILF
+	; D WP^DIE(ZF,ZIEN_",",1,,$NA(@ZOR@(ZD,ZI,"TX"))) ; WP OF ORDER TXT
+	D WP^DIE(C0PXTF,INT_",",2.1,,$NA(gpl))
+	D WP^DIE(C0PXTF,INT_",",3,,$NA(gplTEMP))
+	;N C0PFDA ; DON'T NEW FOR TESTING
+	D ADDXP("gpl2",INT)
+	Q
+	;
+COMPILE(INTID)	;COMPILE A XML TEMPLATE IN RECORD INTID
+	;
+	D INITXPF("C0PF") ;FILE ARRAY TO POINT TO C0P FILES
+	D COMPILE^C0CMXP(INTID,"C0PF") ;COMPILE THE TEMPLATE
+	Q
+	;
+CPBIND(INID,OUTID,FORCE)	; COPIES XPATH BINDINGS FROM TEMPLATE INID
+	; TO TEMPLATE OUTID - ONLY BINDINGS FOR MATCHING XPATHS ARE COPIED
+	; NOTE - REDO THIS TO USE FILEMAN CALLS GPL
+	; WILL NOT OVERWRITE UNLESS FORCE=1
+	N FARY S FARY="C0PF"
+	D INITXPF("C0PF")
+	I +OUTID=0 S OUTID=$$RESTID^C0CSOAP(OUTID,FARY) ;RESOLVE TEMPLATE NAME
+	I +INID=0 S INID=$$RESTID^C0CSOAP(INID,FARY) ;RESOLVE TEMPLATE NAME
+	N ZI
+	S ZI=0
+	F  S ZI=$O(^C0PX(OUTID,5,ZI)) Q:+ZI=0  D  ; FOR EACH XPATH IN OUTID
+	. W !,ZI," ",^C0PX(OUTID,5,ZI,0)
+	. S ZN=^C0PX(OUTID,5,ZI,0)
+	. I $D(^C0PX(OUTID,5,ZI,1)) D  ;Q  ;
+	. . W !,"ERROR XPATH BINDING EXISTS ",ZI
+	. D  ; LOOK FOR MATCHING XPATH IN SOURCE
+	. . S ZJ=$O(^C0PX(INID,5,"B",ZN,""))
+	. . ;W " FOUND:",ZJ
+	. . I ZJ'="" D  ;
+	. . . ;W !,"SETTING ",$G(^C0PX(INID,5,ZJ,1))
+	. . . S ^C0PX(OUTID,5,ZI,0)=^C0PX(INID,5,ZJ,0) ;GET BOTH FIELDS
+	. . . S ^C0PX(OUTID,5,ZI,1)=$G(^C0PX(INID,5,ZJ,1))
+	Q
+	;
+INITXPF(ARY)	;INITIAL XML/XPATH FILE ARRAY
+	;
+	S @ARY@("XML FILE NUMBER")=113059001
+	S @ARY@("BINDING SUBFILE NUMBER")=113059001.04
+	S @ARY@("MIME TYPE")="2.3"
+	S @ARY@("PROXY SERVER")="2.4"
+	S @ARY@("REPLY TEMPLATE")=".03"
+	S @ARY@("TEMPLATE NAME")=".01"
+	S @ARY@("TEMPLATE XML")="3"
+	S @ARY@("URL")="1"
+	S @ARY@("WSDL URL")="2"
+	S @ARY@("XML")="2.1"
+	S @ARY@("XML HEADER")="2.2"
+	S @ARY@("XPATH REDUCTION STRING")="2.5"
+	S @ARY@("CCR VARIABLE")="4"
+	S @ARY@("FILEMAN FIELD NAME")="1"
+	S @ARY@("FILEMAN FIELD NUMBER")="1.2"
+	S @ARY@("FILEMAN FILE POINTER")="1.1"
+	S @ARY@("INDEXED BY")=".05"
+	S @ARY@("SQLI FIELD NAME")="3"
+	S @ARY@("VARIABLE NAME")="2"
+	Q
+	;
+ADDXP(INARY,TID)	;ADD XPATH .01 FIELD TO BINDING SUBFILE OF TEMPLATE TID
+	N FARY S FARY="C0PFILES"
+	D INITXPF(FARY)
+	D ADDXP^C0CMXP(INARY,TID,FARY) ;
+	Q
+	; 
+ADDXML(INXML,TEMPID)	;ADD XML TO A TEMPLATE ID TEMPID
+	; INXML IS PASSED BY NAME
+	N FARY S FARY="C0PFILES"
+	D INITXPF(FARY)
+	D ADDXML^C0CMXP(INXML,TEMPID,FARY) ;CALL C0C ROUTINE TO ADD TO THE FILE
+	Q
+	;
+ADDTEMP(INXML,TEMPID,FARY)	;ADD XML TEMPLATE TO TEMPLATE RECORD TEMPID FIELD 3
+	;
+	N FARY S FARY="C0PFILES"
+	D INITXPF(FARY)
+	D ADDTEMP^C0CMXP(INXML,TEMPID,FARY)
+	Q
+	;
+GETXML(OUTXML,TEMPID,FARY)	;GET THE XML FROM TEMPLATE TEMPID
+	;
+	N FARY S FARY="C0PFILES"
+	D INITXPF(FARY)
+	N C0PUTID ; TEMPLATE IEN TO USE
+	D GETXML^C0CMXP(OUTXML,TEMPID,FARY)
+	Q
+	;
+GETTEMP(OUTXML,TEMPID,FARY)	;GET THE TEMPLATE XML FROM TEMPLATE TEMPID
+	;
+	N FARY S FARY="C0PFILES"
+	D INITXPF(FARY)
+	N C0PUTID ; TEMPLATE IEN TO USE
+	D GETTEMP^C0CMXP(OUTXML,TEMPID,FARY)
+	Q
+	;
+COPYHDR(ZS,ZD)	; COPY XML HEADER FROM RECORD ZS TO ZD
+	; ASSUMES C0P XML TEMPLATE FILE
+	N FARY
+	D INITXPF("FARY")
+	D COPYWP^C0CMXP("XML HEADER",ZS,ZD,"FARY")
+	Q
+	;
+UPDIE	  ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+	K ZERR
+	D CLEAN^DILF
+	D UPDATE^DIE("","C0PFDA","","ZERR")
+	I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
+	K C0PFDA
+	Q
+	;
Index: ePrescribing/trunk/p/C0PWS2.m
===================================================================
--- ePrescribing/trunk/p/C0PWS2.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PWS2.m	(revision 1595)
@@ -0,0 +1,528 @@
+C0PWS2	  ; ERX/GPL - Web Service utilities; 8/31/09; 12/08/2010 ; 5/9/12 12:29am
+	;;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.
+	; Modified by Chris Richardson, November, 2010.
+	; Code has been modified to accept very large XML documents and block them logically.
+	; 3101208 - RCR - Correct end of buffer condition, BF=">"
+	QUIT
+	;
+	; TEST Lines below not intended for End Users. Programmers only.
+	; BEWARE ZWRITE SYNTAX. It may not work in other M Implementations.
+TEST(C0PDUZ,C0PDFN)	; TEST RETRIEVAL OF PATIENT1 MEDS
+	;S DEBUG=1 ;
+	D SOAP("C0POUT",6,C0PDUZ,C0PDFN)
+	ZWRITE C0POUT ; Should use ^%ZOSV Node, this is very GT.M Specific
+	QUIT
+	;
+ACCOUNTF()	 QUIT 113059002  ; file number for account file
+	;
+XMLFN()	 QUIT 113059001  ; XML TEMPLATE FILE NUMBER
+	;
+BINDFN()	 QUIT 113059001.04 ; FILE NUMBER FOR BINDING SUBFILE
+	;
+	;
+GETTID(C0PWS,C0PTNAME)	; EXTRINSIC WHICH RETURNS THE TEMPLATE ID FOR
+	; TEMPLATE NAMED C0PTNAME BELONGING TO WEB SERVICE NAMED C0PWS
+	; ALSO WORKS IF THE ACCOUNT NUMBER IS PASSED IN C0PWS
+	S C0PXF=113059001 ; FILE NUMBER FOR THE C0P XML TEMPLATE FILE
+	S C0PAF=113059002 ; FILE NUMBER FOR THE C0P WS ACCT FILE
+	N C0PA,C0PT       ; C0P ACCOUNT AND C0P TEMPLATE
+	DO
+	. I C0PWS>0 S C0PA=C0PWS QUIT
+	. ;
+	. DO  ; NAME NOT RECORD NUMBER IS PASSED FOR ACCOUNT
+	. . S C0PA=$O(^C0PS("B",C0PWS,"")) ; RECORD NUMBER OF ACCOUNT
+	. . I C0PA="" D  Q  ; OOPS ACCOUNT NOT FOUND
+	. . . W "ACCOUNT "_C0PWS_" NOT FOUND",!
+	. . .QUIT
+	. .QUIT
+	.QUIT
+	S C0PT=$O(^C0PX("C",C0PA,C0PTNAME,"")) ; RECORD NUMBER OF TEMPLATE
+	; WE USE THE C INDEX TO INSURE THAT THE TEMPLATE BELONGS TO THE WEB SERVICE
+	Q C0PT
+	;
+RESTID(C0PDUZ,C0PTID)	; RESOLVE TEMPLATE ID FROM SUBSCRIPTION
+	;
+	N C0PAIEN,COPACCT,COPWBS,COPUTID
+	S C0PAIEN=$$SUBINIT^C0PSUB(C0PDUZ) ;IEN OF SUBSCRIPTION
+	; N C0PACCT
+	S C0PACCT=$$GET1^DIQ(C0PSUBF,C0PAIEN_","_C0PDUZ_",",1,"I") ;ACCT
+	; N C0PWBS
+	S C0PWBS=$$GET1^DIQ(C0PAF,C0PACCT_",",4,"I") ;WEB SERVICE IEN
+	; N C0PUTID
+	S C0PUTID=$$GETTID(C0PWBS,C0PTID) ;TEMPLATE ID
+	Q C0PUTID
+	;
+SOAP(C0PRTN,C0PTID,C0PDUZ,C0PDFN,C0PVOR)	; MAKES A SOAP CALL FOR 
+	; TEMPLATE ID C0PTID
+	; RETURNS THE XML RESULT IN C0PRTN, PASSED BY NAME
+	; C0PVOR IS THE NAME OF A VARIABLE OVERRIDE ARRAY, WHICH IS APPLIED 
+	; BEFORE MAPPING
+	;
+	; ARTIFACTS SECTION
+	; THE FOLLOWING WILL SET UP DEBUGGING ARTIFACTS FOR A POSSIBLE FUTURE
+	; ONLINE DEBUGGER. IF DEBUG=1, VARIABLES CONTAINING INTERMEDIATE RESULTS
+	; WILL NOT BE NEWED.
+	I $G(DEBUG)="" N C0PV ; CATALOG OF ARTIFACT VARIABLES AND ARRAYS
+	S C0PV(100,"C0PXF","XML TEMPLATE FILE NUMBER")=""
+	S C0PV(200,"C0PHEAD","SOAP HEADER VARIABLE NAME")=""
+	S C0PV(300,"header","SOAP HEADER")=""
+	S C0PV(400,"C0PMIME","MIME TYPE")=""
+	S C0PV(500,"C0PURL","WS URL")=""
+	S C0PV(550,"C0PPURL","PROXY URL")=""
+	S C0PV(600,"C0PXML","XML VARIABLE NAME")=""
+	S C0PV(700,"xml","OUTBOUND XML")=""
+	S C0PV(800,"C0PRSLT","RAW XML RESULT RETURNED FROM WEB SERVICE")=""
+	S C0PV(900,"C0PRHDR","RETURNED HEADER")=""
+	S C0PV(1000,"C0PRXML","XML RESULT NORMALIZED")=""
+	S C0PV(1100,"C0PR","REPLY TEMPLATE")=""
+	S C0PV(1200,"C0PREDUX","REDUX STRING")=""
+	S C0PV(1300,"C0PIDX","RESULT XPATH INDEX")=""
+	S C0PV(1400,"C0PARY","RESULT XPATH ARRAY")=""
+	S C0PV(1500,"C0PNOM","RESULT DOM DOCUMENT NAME")=""
+	S C0PV(1600,"C0PID","RESULT DOM ID")=""
+	N ZI,ZN,ZS
+	S ZN=""
+	D:$G(DEBUG)=""   ; G NOTNEW ; SKIP NEWING THE VARIABLES IF IN DEBUG
+	. S ZI="",ZN="",ZS=""
+	. F  S ZI=$O(COPV(ZI)) Q:ZI=""  D
+	. . ; S ZJ=$O(C0PV(ZI,"")) ; SET UP NEW COMMAND
+	. . S ZN=ZN_ZS_$O(C0PV(ZI,"")),ZS=","
+	. .QUIT
+	.QUIT
+	I $L(ZN) N @ZN  ; Apply collected NEW Variables 1 time
+	; NEW
+	; S ZI=$O(C0PV(ZI))
+	; S ZJ=$O(C0PV(ZI,"")) ; SET UP NEW COMMAND
+	;W ZJ,!
+	; N @ZJ ; NEW THE VARIABLE
+	; I $O(C0PV(ZI))'="" G NEW ;LOOP TO GET NEW IN CONTEXT
+	;NOTNEW
+	; END ARTIFACTS
+	;
+	D INITXPF("C0PF") ; SET FILE NUMBER AND PARAMATERS 
+	S C0PXF=C0PF("XML FILE NUMBER") ; FILE NUMBER FOR THE C0P XML TEMPLATE FILE
+	D
+	. I +C0PTID=0 D  Q  ; A STRING WAS PASSED FOR THE TEMPLATE NAME
+	. . S C0PUTID=$$RESTID(C0PDUZ,C0PTID) ;RESOLVE TEMPLATE IEN FROM NAME
+	. .QUIT
+	. ;
+	. S C0PUTID=C0PTID ; AN IEN WAS PASSED
+	.QUIT
+	N xml,template,header
+	S C0PHEAD=$$GET1^DIQ(C0PXF,C0PUTID_",",2.2,,"header")
+	S C0PMIME=$$GET1^DIQ(C0PXF,C0PUTID_",","MIME TYPE")
+	S C0PPURL=$$GET1^DIQ(C0PXF,C0PUTID_",","PROXY SERVER")
+	;S C0PURL=$$GET1^DIQ(C0PXF,C0PUTID_",","URL") ;GPL CHANGE TO USE PROD FLAG
+	D SETUP^C0PMAIN() ; INITIALIZE C0PACCT IEN OF WS ACCOUNT
+	S C0PURL=$$WSURL^C0PMAIN(C0PACCT) ; RESOLVES PRODUCTION VS TEST
+	S C0PXML=$$GET1^DIQ(C0PXF,C0PUTID_",",2.1,,"xml")
+	S C0PTMPL=$$GET1^DIQ(C0PXF,C0PUTID_",",3,,"template")
+	I C0PTMPL="template" D  ; there is a template to process
+	. K xml ; going to replace the xml array
+	. D EN^C0PMAIN("xml","url",C0PDUZ,C0PDFN,C0PUTID,$G(C0PVOR))
+	. ;N ZZG M ZZG(1)=xml
+	. ;S ZDIR=^TMP("C0CCCR","ODIR")
+	. ;ZWR ZZG(1)
+	. ;W $$OUTPUT^C0CXPATH("xml(1)","GPLTEST-"_ZDFN_".xml",ZDIR)
+	.QUIT
+	I $G(C0PPROXY) S C0PURL=C0PPURL
+	K C0PRSLT,C0PRHDR
+	S ok=$$httpPOST^%zewdGTM(C0PURL,.xml,C0PMIME,.C0PRSLT,.header,"",.gpl5,.C0PRHDR)
+	K C0PRXML
+	I $D(GPLTEST) D  ; WAY TO TEST WITH DATA FROM LIVE
+	. K C0PSRLT ; GPL HACK TO TEST XML FROM LIVE
+	. I GPLTEST=1 M C0PRSLT=^C0PG ; THIS IS THE BIG STATUS EMBEDDED XML FROM LIVE
+	. I GPLTEST=2 M C0PRSLT=^C0PG2 ; THIS IS THE BIG REFILL XML  FROM LIVE 
+	. Q
+	; The following is a temporary fix to keep eRx working while a better 
+	; solution is developed. Template ID 6 is GETMEDS for eRx and it needs
+	; to handle xml files that are too big for NORMAL to handle. So, I wrote
+	; CHUNK which will allow us to handle any size xml file bound for the
+	; EWD parser. 
+	; However, all the other templates in eRx need NORMAL to find the 
+	; embedded XML file in their web service responses. So, we will use
+	; CHUNK for template 6 and continue to use NORMAL for all other templates
+	; we can handle big med lists, but not big web service calls.
+	; What is needed is a better NORMAL (see NORMAL2) or another routine
+	; to detect, extract, and decode embeded XML files of any size. gpl 10/8/10
+	;
+	I $D(C0PRSLT(1)) D  ;
+	. D CHUNK("C0PRXML","C0PRSLT",1000) ;RETURN IN AN ARRAY
+	. I $G(C0PRSLT("RELOC",1,1))'="" D  ; THERE WAS EMBEDED XML
+	. . K C0PRXML ; THROW AWAY WRAPPER
+	. . M C0PRXML=C0PRSLT("RELOC",1) ; REPLACE WITH EMBEDDED DOCUMENT 
+	; D:C0PUTID=6 
+	;. I $D(C0PRSLT(1)) D CHUNK("C0PRXML","C0PRSLT",2000) QUIT  ;RETURN IN AN ARRAY
+	;. ;
+	;. I $D(C0PRSLT(1)) D NORMAL("C0PRXML","C0PRSLT(1)") ;RETURN XML IN AN ARRAY
+	;.QUIT
+	S C0PR=$$GET1^DIQ(C0PXF,C0PUTID_",",.03,"I") ; REPLY TEMPLATE
+	; reply templates are optional and are specified by populating a
+	; template pointer in field 2.5 of the request template
+	; if specified, the reply template is the source of the REDUX string
+	; used for XPath on the reply, and for UNBIND processing
+	; if no reply template is specified, REDUX is obtained from the request
+	; template and no UNBIND processing is performed. The XPath array is
+	; returned without variable bindings
+	I C0PR'="" D  ; REPLY TEMPLATE EXISTS
+	. I +$G(DEBUG)'=0 W "REPLY TEMPLATE:"_C0PR,!
+	. S C0PTID=C0PR ;
+	.QUIT
+	S C0PREDUX=$$GET1^DIQ(C0PXF,C0PUTID_",",2.5) ;XPATH REDUCTION STRING
+	K C0PIDX,C0PARY ; XPATH INDEX AND ARRAY VARS
+	S C0PNOM="C0PMEDS"_$J ; DOCUMENT NAME FOR THE DOM
+	N ZBIG S ZBIG=0
+	;I C0PUTID'=6 D  ;
+	;. S ZBIG=$$TOOBIG("C0PRXML") ; PATCH BY GPL WHICH ASSUMES ONLY
+	;. ; TEMPLATE 1 IS A REGULAR XML FILE.. EVERYTHING ELSE HAS EMBEDDED XML
+	;.QUIT
+	;D
+	;. I ZBIG>0 D    QUIT  ; PROBABLY AN EMBEDDED XML DOCUMENT
+	;. . S C0PID=$$UNWRAP("C0PRXML",ZBIG,C0PNOM) ; DECODE AND PARSE THE EMBEDED XML
+	;. .QUIT
+	;. ;
+	;. ; ELSE
+	;. S C0PID=$$PARSE^C0PXEWD("C0PRXML",C0PNOM) ;CALL THE PARSER
+	;.QUIT
+	; I $D(GPLTEST) B  ; STOP TO LOOK AT C0PRXML --> use ZB SOAP+137^C0PWS2 //SMH
+	S C0PID=$$PARSE^C0PXEWD("C0PRXML",C0PNOM) ;CALL THE PARSER
+	S C0PID=$$FIRST^C0PXEWD($$ID^C0PXEWD(C0PNOM)) ;ID OF FIRST NODE
+	D XPATH^C0PXEWD(C0PID,"/","C0PIDX","C0PARY","",C0PREDUX) ;XPATH GENERATOR
+	S OK=$$DELETE^C0PXEWD(C0PNOM) ; REMOVE PARSED XML FROM THE EWD DOM
+	; Next, call UNBIND to map the reply XPath array to variables
+	; This is only done if a Reply Template is provided
+	D DEMUXARY(C0PRTN,"C0PARY")
+	; M @C0PRTN=C0PARY
+	QUIT
+	;
+TOOBIG(ZXML)	; EXTRINSIC WHICH RETURNS TRUE IF ANY NODE IS OVER 2000 CHARS
+	; RETURNS THE INDEX OF THE LARGE NODE . IF NO LARGE NODE, RETURNS ZERO
+	N ZI,ZR
+	S ZI=""
+	S ZR=0 ; DEFAULT FALSE
+	; First time we go over 1,000, we can stop.
+	F  S ZI=$O(@ZXML@(ZI)) Q:ZI=""  I $L(@ZXML@(ZI))>1000 S ZR=ZI Q   ; First oversize stops
+	QUIT ZR
+	; ===================
+NORMAL(OUTXML,INXML)	;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
+	; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
+	;
+	N INBF,ZI,ZN,ZTMP
+	S ZN=1,INBF=@INXML
+	S @OUTXML@(ZN)=$P(INBF,"><",ZN)_">"
+	; S ZN=ZN+1
+	; F  S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)=""  D  ;
+	; Should speed up, and not leave a dangling node, and doesn't stop at first NULL
+	F ZN=2:1:$L(INBF,"><") S @OUTXML@(ZN)="<"_$P(INBF,"><",ZN)_">"
+	; . ; S ZN=ZN+1 
+	; .QUIT
+	QUIT
+	;  ================
+	; The goal of this block has changed a little bit.  Most modern MUMPS engines can
+	; handle a 1,000,000 byte string.  We will use BF to hold hunks that big so that 
+	; we can logically suck up a big hunk of the input to supply the reblocking of the XML
+	; into more logical blocks less than 2000 bytes in length blocks.
+	; A series of signals will be needed, Source (INXML) is exhausted (INEND),
+	; BF is less than 2200 bytes (BFLD, BuFfer reLoaD)
+	; BF is Full (BF contains 998,000 bytes or more, BFULL)
+	; BF and Process is Complete (BFEND)
+	; ZSIZE defaults to 2,000 now, but can be set lower or higher
+	;
+CHUNK(OUTXML,INXML,ZSIZE)	; BREAKS INXML INTO ZSIZE BLOCKS
+	; INXML IS AN ARRAY PASSED BY NAME OF STRINGS
+	; OUTXML IS ALSO PASSED BY NAME
+	; IF ZSIZE IS NOT PASSED, 2000 IS USED
+	I '$D(ZSIZE) S ZSIZE=2000 ; DEFAULT BLOCK SIZE
+	N BF,BFEND,BFLD,BFMAX,BFULL,INEND,ZB,ZI,ZJ,ZK,ZL,ZN
+	; S ZB=ZSIZE-1
+	S ZN=1
+	S BFMAX=998000
+	S ZI=0 ; BEGINNING OF INDEX TO INXML
+	S (BFLD,BFEND,BFULL,INEND)=0,BF=""
+	; Major loop loads the buffer, BF, and unloads it into the Output Array
+	;  in 
+	F  D  Q:BFEND
+	. ; Input LOADER
+	. D:'INEND
+	. . F  S ZI=$O(@INXML@(ZI)) S INEND=(ZI="")  Q:INEND!BFULL  D   ; LOAD EACH STRING IN INXML
+	. . . S BF=BF_@INXML@(ZI)                                       ; ADD TO THE BF STRING
+	. . . S BFULL=($L(BF)>BFMAX)
+	. . .QUIT
+	. .QUIT
+	. ;  Full Buffer, BF, now check for Encryption and Unpack
+	. D TEST4COD(.BF,"C0PRSLT(""RELOC"")")
+	. ; Output BREAKER
+	. F  Q:BFLD  D   ; ZJ=1:ZSIZE:ZL D  ;
+	. . ; ZK=$S(ZJ+ZB<ZL:ZJ+ZB,1:ZL) ; END FOR EXTRACT
+	. . F ZK=ZSIZE:-1:0  Q:$E(BF,ZK)=">"
+	. . I ZK=0 S ZK=ZSIZE
+	. . S @OUTXML@(ZN)=$E(BF,1,ZK) ; PULL OUT THE PIECE
+	. . S ZN=ZN+1 ; INCREMENT OUT ARRAY INDEX
+	. . S BF=$E(BF,ZK+1,BFMAX)
+	. . S BFLD=($L(BF)<(ZSIZE*2))
+	. .QUIT
+	. S BFEND=(INEND&BFLD)!(">"[BF)
+	. I $L(BF)&BFEND S @OUTXML@(ZN)=BF,BF=""
+	.QUIT
+	QUIT
+	;  ==============
+	; Test for Encryption, extract it and decode it.
+TEST4COD(INBF,RELOC)	
+	N DBF,I,MSK,TBF,TRG,RCNT
+	S RCNT=0
+	;  Segments expected <seg 1>DATA</seg 1><seg 2>DATA</seg 2>
+	;                           ^   ^
+	S MSK=""   ; It turns out that some of the characters used were not reliable
+	F I=32:1:42,44:1:47,62:1:64,91:1:96 S MSK=MSK_$C(I)
+	F I=1:1:$L(INBF,"</")-1 D
+	. S TBF=$RE($P($RE($P(INBF,"</",I)),">"))
+	. ; Remove sample for testing
+	. ; Set the trigger, mostly included to show intent and associated code
+	. ;  this could be refined later if determined already obvious enough
+	. S TRG=0
+	. ;DO:$L(TBF)>20  ; If $TR doesn't remove anything, then these characters are not there
+	. ; gpl  trying to keep refills from crashing.. 20 chars is not enough
+	. DO:$L(TBF)>100  ; If $TR doesn't remove anything, then these characters are not there
+	. . I (TBF=$TR(TBF,MSK))   S TRG=1
+	. . ; I (TBF=$TR(TBF," <->@*!?.,:;#$%&[/|\]={}~")) S TRG=1
+	. . ;   <>!"#$%&'()*,-./67:;<>?@[\]^_`fqr{|}~  <<= Ignore 6,7,f,q, and r
+	. . ; Now we set up for the DECODE and replacement in INBF
+	. . DO:TRG
+	. . . N A,C,CC,CV,CCX,K,XBF,T,V
+	. . . DO
+	. . . . N I
+	. . . . S DBF=$$DECODER(TBF)
+	. . . .QUIT
+	. . . ;
+	. . . S CCX=""
+	. . . F K=1:1:$L(DBF) S CC=$E(DBF,K) S:CC?1C C=$A(CC),A(C)=$G(A(C))+1
+	. . . S C="",V=""
+	. . . F  S C=$O(A(C)) Q:C=""  S CCX=CCX_$C(C) S:A(C)>V V=A(C),CV=C
+	. . . S CC=$C(CV)
+	. . . ;  The "_$C(13,10)_" may need to be generalized, tested and set earlier
+	. . . ;    Expand embedded XML in XBF
+	. . . F K=1:1:$L(DBF,CC) S T=$P(DBF,CC,K),XBF(K)=$TR(T,CCX)
+	. . . S RCNT=RCNT+1
+	. . . M @RELOC@(RCNT)=XBF
+	. . . ;   Curley braces and = makes it so it won't trigger a second time by retest.                                
+	. . . S INBF=$P(INBF,TBF)_"<{REPLACED}="_RCNT_$P(INBF,TBF,2,999)
+	. . .QUIT
+	. .QUIT
+	.QUIT
+	;  Now shorten the INBF so it gets smaller
+	;S INBF=$P(INBF,">",I+1,99999)
+	QUIT
+	;
+DECODER(BF)	; Decrypts the Encrypted Strings
+	QUIT $$DECODE^RGUTUU(BF)
+	;
+NORMAL2(OUTXML,INXML)	;NORMALIZES AN ARRAY OF XML STRINGS PASSED BY NAME INXML
+	; AS @INXML@(1) TO @INXML@(x) ALL NUMERIC
+	; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
+	; this routine doesn't work unless the blocks are on xml tag boundaries - gpl
+	; which is hard to do... this routine is left here awaiting future development
+	N ZI,ZN,ZJ
+	S ZJ=0
+	S ZN=1
+	F  S ZJ=$O(@INXML@(ZJ)) Q:+ZJ=0  D  ; FOR EACH XML STRING IN ARRAY
+	. S @OUTXML@(ZN)=$P(@INXML@(ZJ),"><",ZN)_">"
+	. S ZN=ZN+1
+	. F  S @OUTXML@(ZN)="<"_$P(@INXML@(ZJ),"><",ZN) Q:$P(@INXML@(ZJ),"><",ZN+1)=""  D  ;
+	. . S @OUTXML@(ZN)=@OUTXML@(ZN)_">"
+	. . S ZN=ZN+1
+	. .QUIT
+	.QUIT
+	QUIT
+	;  ===============
+	;
+UNWRAP(ZXML,ZI,ZNOM)	; EXTRINSIC TO LOCATE, DECODE AND PARSE AN EMBEDED XML DOC
+	; RETURNS THE DOCID OF THE DOM
+	N ZS,ZX
+	S ZS=$P($P(@ZXML@(ZI),">",2),"<",1) ; PULL OUT THE ENCODED STRING
+	S ZX=$$DECODE^RGUTUU(ZS)
+	N ZZ
+	N ZY S ZY="<?xml version=""1.0"" encoding=""utf-8""?>"
+	I $E(ZX,1,5)'="<?xml" S ZZ(1)=ZY_ZX
+	E  S ZZ(1)=ZX
+	N ZI
+	;F ZI=1:1 Q:$$REDUCE(.ZZ,ZI) ; CHOP THE STRING INTO 4000 CHAR ARRAY
+	S ZI=$$REDUCRCR(.ZZ,1) ; RECURSIVE VERSION OF REDUCE
+	S G=$$PARSE^C0PXEWD("ZZ",C0PNOM)
+	; GTM Specific
+	; I G=0 ZWR ^TMP("MXMLERR",$J,*) B
+	QUIT G
+	;  =============
+REDUCE(ZARY,ZN)	; WILL REDUCE ZARY(ZN) BY CHOPPING IT TO 4000 CHARS
+	; AND PUTTING THE REST IN ZARY(ZN+1)
+	; ZARY IS PASSED BY REFERENCE
+	; EXTRINSIC WHICH RETURNS FALSE IF THERE IS NOTHING TO REDUCE
+	I $L(ZARY(ZN))<4001   QUIT 0 ;NOTHING TO REDUCE
+	;
+	S ZARY(ZN+1)=$E(ZARY(ZN),4001,$L(ZZ(ZN))) ;BREAK IT UP
+	S ZARY(ZN)=$E(ZARY(ZN),1,4000) ;  
+	QUIT 1  ;ACTUALLY REDUCED
+	;  ===========
+REDUCRCR(ZARY,ZN)	; RECURSIVE VERSION OF REDUCE ABOVE
+	; WILL REDUCE ZARY(ZN) BY CHOPPING IT TO 4000 CHARS
+	; AND PUTTING THE REST IN ZARY(ZN+1)
+	; ZARY IS PASSED BY REFERENCE
+	; EXTRINSIC WHICH RETURNS FALSE IF THERE IS NOTHING TO REDUCE
+	I $L(ZARY(ZN))<4001 Q 0 ;NOTHING TO REDUCE
+	; 
+	S ZARY(ZN+1)=$E(ZARY(ZN),4001,$L(ZZ(ZN))) ;BREAK IT UP
+	S ZARY(ZN)=$E(ZARY(ZN),1,4000) ;  
+	I '$$REDUCRCR(.ZARY,ZN+1) Q 1 ; CALL RECURSIVELY
+	;  
+	QUIT 1  ;ACTUALLY REDUCED
+	;
+DEMUXARY(OARY,IARY)	;CONVERT AN XPATH ARRAY PASSED AS IARY TO
+	; FORMAT @OARY@(x,xpath) where x is the first multiple
+	N ZI,ZJ,ZK,ZL S ZI=""
+	F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ;
+	. D DEMUX^C0CMXP("ZJ",ZI)
+	. S ZK=$P(ZJ,"^",3)
+	. S ZK=$RE($P($RE(ZK),"/",1))
+	. S ZL=$P(ZJ,"^",1)
+	. I ZL="" S ZL=1
+	. S @OARY@(ZL,ZK)=@IARY@(ZI)
+	.QUIT
+	QUIT
+	;
+PARSE(INXML,INDOC)	;CALL THE EWD PARSER ON INXML, PASSED BY NAME
+	; INDOC IS PASSED AS THE DOCUMENT NAME TO EWD
+	; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY EWD
+	N ZR
+	M ^CacheTempEWD($j)=@INXML ;
+	S ZR=$$parseDocument^%zewdHTMLParser(INDOC)
+	K ^CacheTempEWD($j) ;clean up after
+	QUIT ZR
+	;
+TBLD(INT)	; TEMPLATE BUILD OF TEMPLATE INT
+	; want to break this up into pieces -  gpl
+	; THE TEMPLATE NEEDS TO EXIST AND THE DEFINING XML URL MUST BE POPULATED
+	; THEN THE DEFINING XML WILL BE RETRIVED AND STORED INTO THE RAW XML FIELD
+	; IT WILL BE TRANSFORMED INTO A TEMPLATE AND STORED IN THE TEMPLATE FIELD
+	; ALL THE XPATHs WILL BE EXTRACTED AND A BINDING MULTIPLE CREATED FOR EACH
+	; ALL IN ONE SIMPLE ROUTINE
+	; WHAT REMAINS IS FOR MANUAL ENTRY OF THE OTHER FIELDS IN THE BINDINGS
+	N C0PXTF S C0PXTF=113059001 ; XML TEMPLATE FILE
+	N C0PURL ; URL TO RETRIEVE THE DEFINING XML FOR THE TEMPLATE
+	S C0PURL=$$GET1^DIQ(C0PXTF,INT,2)
+	D GET1URL^C0PEWD2(C0PURL)
+	D CLEAN^DILF
+	; D WP^DIE(ZF,ZIEN_",",1,,$NA(@ZOR@(ZD,ZI,"TX"))) ; WP OF ORDER TXT
+	D WP^DIE(C0PXTF,INT_",",2.1,,$NA(gpl))
+	D WP^DIE(C0PXTF,INT_",",3,,$NA(gplTEMP))
+	;N C0PFDA ; DON'T NEW FOR TESTING
+	D ADDXP("gpl2",INT)
+	QUIT
+	;  ==========
+COMPILE(INTID)	;COMPILE A XML TEMPLATE IN RECORD INTID
+	D INITXPF("C0PF") ;FILE ARRAY TO POINT TO C0P FILES
+	D COMPILE^C0CMXP(INTID,"C0PF") ;COMPILE THE TEMPLATE
+	QUIT
+	;  ==========
+CPBIND(INID,OUTID,FORCE)	; COPIES XPATH BINDINGS FROM TEMPLATE INID
+	; TO TEMPLATE OUTID - ONLY BINDINGS FOR MATCHING XPATHS ARE COPIED
+	; NOTE - REDO THIS TO USE FILEMAN CALLS GPL
+	; WILL NOT OVERWRITE UNLESS FORCE=1
+	N FARY,ZI
+	S FARY="C0PF"
+	D INITXPF("C0PF")
+	I +OUTID=0 S OUTID=$$RESTID^C0CSOAP(OUTID,FARY) ;RESOLVE TEMPLATE NAME
+	I +INID=0 S INID=$$RESTID^C0CSOAP(INID,FARY) ;RESOLVE TEMPLATE NAME
+	S ZI=0
+	F  S ZI=$O(^C0PX(OUTID,5,ZI)) Q:+ZI=0  D  ; FOR EACH XPATH IN OUTID
+	. W !,ZI," ",^C0PX(OUTID,5,ZI,0)
+	. S ZN=^C0PX(OUTID,5,ZI,0)
+	. I $D(^C0PX(OUTID,5,ZI,1)) D  ;Q  ;
+	. . W !,"ERROR XPATH BINDING EXISTS ",ZI
+	. .QUIT
+	. D  ; LOOK FOR MATCHING XPATH IN SOURCE
+	. . S ZJ=$O(^C0PX(INID,5,"B",ZN,""))
+	. . ;W " FOUND:",ZJ
+	. . I ZJ'="" D  ;
+	. . . ;W !,"SETTING ",$G(^C0PX(INID,5,ZJ,1))
+	. . . S ^C0PX(OUTID,5,ZI,0)=^C0PX(INID,5,ZJ,0) ;GET BOTH FIELDS
+	. . . S ^C0PX(OUTID,5,ZI,1)=$G(^C0PX(INID,5,ZJ,1))
+	QUIT
+	;
+INITXPF(ARY)	;INITIAL XML/XPATH FILE ARRAY
+	;
+	S @ARY@("XML FILE NUMBER")=113059001
+	S @ARY@("BINDING SUBFILE NUMBER")=113059001.04
+	S @ARY@("MIME TYPE")="2.3"
+	S @ARY@("PROXY SERVER")="2.4"
+	S @ARY@("REPLY TEMPLATE")=".03"
+	S @ARY@("TEMPLATE NAME")=".01"
+	S @ARY@("TEMPLATE XML")="3"
+	S @ARY@("URL")="1"
+	S @ARY@("WSDL URL")="2"
+	S @ARY@("XML")="2.1"
+	S @ARY@("XML HEADER")="2.2"
+	S @ARY@("XPATH REDUCTION STRING")="2.5"
+	S @ARY@("CCR VARIABLE")="4"
+	S @ARY@("FILEMAN FIELD NAME")="1"
+	S @ARY@("FILEMAN FIELD NUMBER")="1.2"
+	S @ARY@("FILEMAN FILE POINTER")="1.1"
+	S @ARY@("INDEXED BY")=".05"
+	S @ARY@("SQLI FIELD NAME")="3"
+	S @ARY@("VARIABLE NAME")="2"
+	QUIT
+	;
+ADDXP(INARY,TID)	;ADD XPATH .01 FIELD TO BINDING SUBFILE OF TEMPLATE TID
+	N FARY
+	S FARY="C0PFILES"
+	D INITXPF(FARY)
+	D ADDXP^C0CMXP(INARY,TID,FARY) ;
+	QUIT
+	;
+ADDXML(INXML,TEMPID)	;ADD XML TO A TEMPLATE ID TEMPID
+	; INXML IS PASSED BY NAME
+	N FARY S FARY="C0PFILES"
+	D INITXPF(FARY)
+	D ADDXML^C0CMXP(INXML,TEMPID,FARY) ;CALL C0C ROUTINE TO ADD TO THE FILE
+	QUIT
+	;
+ADDTEMP(INXML,TEMPID,FARY)	;ADD XML TEMPLATE TO TEMPLATE RECORD TEMPID FIELD 3
+	;
+	N FARY
+	S FARY="C0PFILES"
+	D INITXPF(FARY)
+	D ADDTEMP^C0CMXP(INXML,TEMPID,FARY)
+	QUIT
+	;
+GETXML(OUTXML,TEMPID,FARY)	;GET THE XML FROM TEMPLATE TEMPID
+	;
+	N FARY
+	S FARY="C0PFILES"
+	D INITXPF(FARY)
+	N C0PUTID ; TEMPLATE IEN TO USE
+	D GETXML^C0CMXP(OUTXML,TEMPID,FARY)
+	QUIT
+	;
+GETTEMP(OUTXML,TEMPID,FARY)	;GET THE TEMPLATE XML FROM TEMPLATE TEMPID
+	;
+	N FARY
+	S FARY="C0PFILES"
+	D INITXPF(FARY)
+	N C0PUTID ; TEMPLATE IEN TO USE
+	D GETTEMP^C0CMXP(OUTXML,TEMPID,FARY)
+	QUIT
+	;
+COPYHDR(ZS,ZD)	; COPY XML HEADER FROM RECORD ZS TO ZD
+	; ASSUMES C0P XML TEMPLATE FILE
+	N FARY
+	D INITXPF("FARY")
+	D COPYWP^C0CMXP("XML HEADER",ZS,ZD,"FARY")
+	QUIT
+	;
+UPDIE	  ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+	K ZERR
+	D CLEAN^DILF
+	D UPDATE^DIE("","C0PFDA","","ZERR")
+	I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
+	K C0PFDA
+	QUIT
Index: ePrescribing/trunk/p/C0PXEWD.m
===================================================================
--- ePrescribing/trunk/p/C0PXEWD.m	(revision 1595)
+++ ePrescribing/trunk/p/C0PXEWD.m	(revision 1595)
@@ -0,0 +1,140 @@
+C0PXEWD	  ; ERX/GPL - EWD based XPath utilities; 10/11/09 ; 5/4/12 4:29pm
+	;;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
+	;
+	; gpl July, 2010. This routine interfaces with EWD to generate an XPath
+	; array from an XML file. It recursively visits the EWD DOM and creates
+	; an XPath index, an XPath array of node values, and an XPath template
+	; in three different variables. It is used to prepare incoming xml for
+	; processing by applications. 
+	;
+TEST	;
+	D XPATH($$FIRST($$ID("CCR1")),"/","GIDX","GARY")
+	Q
+	;
+TEST2	;
+	S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail"
+	D XPATH($$FIRST($$ID("gpl")),"/","GIDX","GARY","",REDUX)
+	Q
+	;
+XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX)	; RECURSIVE ROUTINE TO POPULATE
+	; THE XPATH INDEX ZXIDX, PASSED BY NAME
+	; THE XPATH ARRAY XPARY, PASSED BY NAME
+	; ZOID IS THE STARTING OID
+	; ZPATH IS THE STARTING XPATH, USUALLY "/"
+	; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
+	; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
+	I '$D(ZREDUX) S ZREDUX=""
+	N NEWPATH
+	N NEWNUM S NEWNUM=""
+	I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
+	S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
+	I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
+	. N GT S GT=$P(NEWPATH,ZREDUX,2)
+	. I GT'="" S NEWPATH=GT
+	S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
+	N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
+	I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
+	E  I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
+	I GD'="" S @ZXPARY@(NEWPATH)=GD ; IF YES, ADD IT TO THE XPATH ARRAY
+	N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
+	I ZFRST'="" D  ; THERE IS A CHILD
+	. N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
+	. D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD
+	N GNXT S GNXT=$$NXTSIB(ZOID)
+	I GNXT'="" D  ; MOVE ON TO THE NEXT SIBLING
+	. D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB
+	Q
+	;
+PARSE(INXML,INDOC)	;CALL THE EWD PARSER ON INXML, PASSED BY NAME
+	; INDOC IS PASSED AS THE DOCUMENT NAME TO EWD
+	; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY EWD
+	N ZR
+	K ^CacheTempEWD($j) ; CLEAN OUT ANYTHING THAT MIGHT HAVE BEEN THERE
+	M ^CacheTempEWD($j)=@INXML ;
+	S ZR=$$parseDocument^%zewdHTMLParser(INDOC)
+	K ^CacheTempEWD($j) ;clean up after ourselves
+	Q ZR
+	;
+DELETE(INDOC)	; DELETE A PARSED DOCUMENT FROM THE EWD DOM 
+	; AFTER IT'S NO LONGER NEEDED
+	N OK
+	S OK=$$removeDocument^%zewdDOM(INDOC)
+	Q OK
+	;
+ISMULT(ZOID)	; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
+	N ZN
+	S ZN=$$NXTSIB(ZOID)
+	I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
+	Q 0
+	;
+DETAIL(ZRTN,ZOID)	; RETURNS DETAIL FOR NODE ZOID IN ZRTN, PASSED BY NAME
+	N DET
+	D getElementDetails^%zewdXPath(ZOID,.DET)
+	M @ZRTN=DET
+	Q
+	;
+ID(ZNAME)	;RETURNS THE docOID OF THE DOCUMENT NAMED ZNAME
+	Q $$getDocumentNode^%zewdDOM(ZNAME)
+	;
+NAME(ZOID)	;RETURNS THE NAME OF THE DOCUMENAT WITH docOID ZOID
+	Q $$getDocumentName^%zewdDOM(ZOID)
+	;
+FIRST(ZOID)	;RETURNS THE OID OF THE FIRST CHILD OF ZOID
+	N GOID
+	S GOID=ZOID
+	S GOID=$$getFirstChild^%zewdDOM(GOID)
+	I GOID="" Q ""
+	I $$getNodeType^%zewdDOM(GOID)'=1 S GOID=$$NXTCHLD(GOID)
+	Q GOID
+	;
+HASCHILD(ZOID)	; RETURNS TRUE IF ZOID HAS CHILD NODES
+	Q $$hasChildNodes^%zewdDOM(ZOID)
+	;
+CHILDREN(ZRTN,ZOID)	;RETURNS CHILDREN OF ZOID IN ARRAY ZRTN, PASSED BY NAME
+	N childArray
+	d getChildrenInOrder^%zewdDOM(ZOID,.childArray)
+	m @ZRTN=childArray
+	q
+	;
+TAG(ZOID)	; RETURNS THE XML TAG FOR THE NODE
+	Q $$getName^%zewdDOM(ZOID)
+	;
+NXTSIB(ZOID)	; RETURNS THE NEXT SIBLING
+	Q $$getNextSibling^%zewdDOM(ZOID)
+	;
+NXTCHLD(ZOID)	; RETURNS THE NEXT CHILD IN PARENT ZPAR
+	N GOID
+	S GOID=$$getNextChild^%zewdDOM($$PARENT(ZOID),ZOID)
+	I GOID="" Q ""
+	I $$getNodeType^%zewdDOM(GOID)'=1 S GOID=$$NXTCHLD(GOID)
+	Q GOID
+	;
+PARENT(ZOID)	; RETURNS PARENT OF ZOID
+	Q $$getParentNode^%zewdDOM(ZOID)
+	;
+DATA(ZT,ZOID)	; RETURNS DATA FOR THE NODE
+	N ZT2
+	S ZT2=$$getElementText^%zewdDOM(ZOID,.ZT2)
+	M @ZT=ZT2
+	Q
+	;Q $$getTextValue^%zewdXPath(ZOID)
+	;Q $$getData^%zewdDOM(ZOID,.ZT)
+	;
Index: ePrescribing/trunk/p/C0P_1_0_1_T1.KID
===================================================================
--- ePrescribing/trunk/p/C0P_1_0_1_T1.KID	(revision 518)
+++ 	(revision )
@@ -1,1484 +1,0 @@
-KIDS Distribution saved on Apr 11, 2009@16:23:57
-Initial ePrescribing prototyping
-**KIDS**:C0P*1.0*1^
-
-**INSTALL NAME**
-C0P*1.0*1
-"BLD",6966,0)
-C0P*1.0*1^^0^3090411^y
-"BLD",6966,4,0)
-^9.64PA^175.201^2
-"BLD",6966,4,175.101,0)
-175.101
-"BLD",6966,4,175.101,222)
-y^y^f^^n^^y^o^n
-"BLD",6966,4,175.201,0)
-175.201
-"BLD",6966,4,175.201,222)
-y^y^f^^n^^y^o^n
-"BLD",6966,4,"B",175.101,175.101)
-
-"BLD",6966,4,"B",175.201,175.201)
-
-"BLD",6966,6.3)
-1
-"BLD",6966,"KRN",0)
-^9.67PA^8989.52^19
-"BLD",6966,"KRN",.4,0)
-.4
-"BLD",6966,"KRN",.401,0)
-.401
-"BLD",6966,"KRN",.402,0)
-.402
-"BLD",6966,"KRN",.403,0)
-.403
-"BLD",6966,"KRN",.5,0)
-.5
-"BLD",6966,"KRN",.84,0)
-.84
-"BLD",6966,"KRN",3.6,0)
-3.6
-"BLD",6966,"KRN",3.8,0)
-3.8
-"BLD",6966,"KRN",9.2,0)
-9.2
-"BLD",6966,"KRN",9.8,0)
-9.8
-"BLD",6966,"KRN",9.8,"NM",0)
-^9.68A^2^2
-"BLD",6966,"KRN",9.8,"NM",1,0)
-C0PEWD1^^0^B8658372
-"BLD",6966,"KRN",9.8,"NM",2,0)
-C0PEWDU^^0^B1881609
-"BLD",6966,"KRN",9.8,"NM","B","C0PEWD1",1)
-
-"BLD",6966,"KRN",9.8,"NM","B","C0PEWDU",2)
-
-"BLD",6966,"KRN",19,0)
-19
-"BLD",6966,"KRN",19.1,0)
-19.1
-"BLD",6966,"KRN",101,0)
-101
-"BLD",6966,"KRN",409.61,0)
-409.61
-"BLD",6966,"KRN",771,0)
-771
-"BLD",6966,"KRN",870,0)
-870
-"BLD",6966,"KRN",8989.51,0)
-8989.51
-"BLD",6966,"KRN",8989.52,0)
-8989.52
-"BLD",6966,"KRN",8994,0)
-8994
-"BLD",6966,"KRN","B",.4,.4)
-
-"BLD",6966,"KRN","B",.401,.401)
-
-"BLD",6966,"KRN","B",.402,.402)
-
-"BLD",6966,"KRN","B",.403,.403)
-
-"BLD",6966,"KRN","B",.5,.5)
-
-"BLD",6966,"KRN","B",.84,.84)
-
-"BLD",6966,"KRN","B",3.6,3.6)
-
-"BLD",6966,"KRN","B",3.8,3.8)
-
-"BLD",6966,"KRN","B",9.2,9.2)
-
-"BLD",6966,"KRN","B",9.8,9.8)
-
-"BLD",6966,"KRN","B",19,19)
-
-"BLD",6966,"KRN","B",19.1,19.1)
-
-"BLD",6966,"KRN","B",101,101)
-
-"BLD",6966,"KRN","B",409.61,409.61)
-
-"BLD",6966,"KRN","B",771,771)
-
-"BLD",6966,"KRN","B",870,870)
-
-"BLD",6966,"KRN","B",8989.51,8989.51)
-
-"BLD",6966,"KRN","B",8989.52,8989.52)
-
-"BLD",6966,"KRN","B",8994,8994)
-
-"DATA",175.101,1,0)
-DrugAllergyInteraction^https://secure.newcropaccounts.com/V7/webservices/DrugAllergyInteraction
-"DATA",175.101,1,1,0)
-^175.1012^28^28^3090303^^
-"DATA",175.101,1,1,1,0)
- <DrugAllergyInteraction 
-"DATA",175.101,1,1,2,0)
-xmlns="https://secure.newcropaccounts.com/V7/webservices">
-"DATA",175.101,1,1,3,0)
-      <credentials>
-"DATA",175.101,1,1,4,0)
-        <PartnerName>string</PartnerName>
-"DATA",175.101,1,1,5,0)
-        <Name>string</Name>
-"DATA",175.101,1,1,6,0)
-        <Password>string</Password>
-"DATA",175.101,1,1,7,0)
-      </credentials>
-"DATA",175.101,1,1,8,0)
-      <accountRequest>
-"DATA",175.101,1,1,9,0)
-        <AccountId>string</AccountId>
-"DATA",175.101,1,1,10,0)
-        <SiteId>string</SiteId>
-"DATA",175.101,1,1,11,0)
-      </accountRequest>
-"DATA",175.101,1,1,12,0)
-      <patientRequest>
-"DATA",175.101,1,1,13,0)
-        <PatientId>string</PatientId>
-"DATA",175.101,1,1,14,0)
-      </patientRequest>
-"DATA",175.101,1,1,15,0)
-      <patientInformationRequester>
-"DATA",175.101,1,1,16,0)
-        <UserType>string</UserType>
-"DATA",175.101,1,1,17,0)
-        <UserId>string</UserId>
-"DATA",175.101,1,1,18,0)
-      </patientInformationRequester>
-"DATA",175.101,1,1,19,0)
-      <allergies>
-"DATA",175.101,1,1,20,0)
-        <string>string</string>
-"DATA",175.101,1,1,21,0)
-        <string>string</string>
-"DATA",175.101,1,1,22,0)
-      </allergies>
-"DATA",175.101,1,1,23,0)
-      <proposedMedications>
-"DATA",175.101,1,1,24,0)
-        <string>string</string>
-"DATA",175.101,1,1,25,0)
-        <string>string</string>
-"DATA",175.101,1,1,26,0)
-      </proposedMedications>
-"DATA",175.101,1,1,27,0)
-      <drugStandardType>string</drugStandardType>
-"DATA",175.101,1,1,28,0)
-    </DrugAllergyInteraction>
-"DATA",175.101,1,2,0)
-^175.1013^18^18^3090303^^
-"DATA",175.101,1,2,1,0)
-<DrugAllergyInteractionResult>
-"DATA",175.101,1,2,2,0)
-        <result>
-"DATA",175.101,1,2,3,0)
-          <Status>Unknown or OK or Fail or NotFound</Status>
-"DATA",175.101,1,2,4,0)
-          <Message>string</Message>
-"DATA",175.101,1,2,5,0)
-          <XmlResponse>string</XmlResponse>
-"DATA",175.101,1,2,6,0)
-          <RowCount>int</RowCount>
-"DATA",175.101,1,2,7,0)
-          <Timing>int</Timing>
-"DATA",175.101,1,2,8,0)
-        </result>
-"DATA",175.101,1,2,9,0)
-        <drugAllergyDetailArray>
-"DATA",175.101,1,2,10,0)
-          <DrugAllergyDetail>
-"DATA",175.101,1,2,11,0)
-            <InteractionText>string</InteractionText>
-"DATA",175.101,1,2,12,0)
-          </DrugAllergyDetail>
-"DATA",175.101,1,2,13,0)
-          <DrugAllergyDetail>
-"DATA",175.101,1,2,14,0)
-            <InteractionText>string</InteractionText>
-"DATA",175.101,1,2,15,0)
-          </DrugAllergyDetail>
-"DATA",175.101,1,2,16,0)
-        </drugAllergyDetailArray>
-"DATA",175.101,1,2,17,0)
-      </DrugAllergyInteractionResult>
-"DATA",175.101,1,2,18,0)
-    </DrugAllergyInteractionResponse>
-"DATA",175.101,2,0)
-DrugDrugInteraction^https://secure.newcropaccounts.com/V7/webservices/DrugDrugInteraction
-"DATA",175.101,2,1,0)
-^^28^28^3090303^
-"DATA",175.101,2,1,1,0)
-<DrugDrugInteraction 
-"DATA",175.101,2,1,2,0)
-xmlns="https://secure.newcropaccounts.com/V7/webservices">
-"DATA",175.101,2,1,3,0)
-      <credentials>
-"DATA",175.101,2,1,4,0)
-        <PartnerName>string</PartnerName>
-"DATA",175.101,2,1,5,0)
-        <Name>string</Name>
-"DATA",175.101,2,1,6,0)
-        <Password>string</Password>
-"DATA",175.101,2,1,7,0)
-      </credentials>
-"DATA",175.101,2,1,8,0)
-      <accountRequest>
-"DATA",175.101,2,1,9,0)
-        <AccountId>string</AccountId>
-"DATA",175.101,2,1,10,0)
-        <SiteId>string</SiteId>
-"DATA",175.101,2,1,11,0)
-      </accountRequest>
-"DATA",175.101,2,1,12,0)
-      <patientRequest>
-"DATA",175.101,2,1,13,0)
-        <PatientId>string</PatientId>
-"DATA",175.101,2,1,14,0)
-      </patientRequest>
-"DATA",175.101,2,1,15,0)
-      <patientInformationRequester>
-"DATA",175.101,2,1,16,0)
-        <UserType>string</UserType>
-"DATA",175.101,2,1,17,0)
-        <UserId>string</UserId>
-"DATA",175.101,2,1,18,0)
-      </patientInformationRequester>
-"DATA",175.101,2,1,19,0)
-      <currentMedications>
-"DATA",175.101,2,1,20,0)
-        <string>string</string>
-"DATA",175.101,2,1,21,0)
-        <string>string</string>
-"DATA",175.101,2,1,22,0)
-      </currentMedications>
-"DATA",175.101,2,1,23,0)
-      <proposedMedications>
-"DATA",175.101,2,1,24,0)
-        <string>string</string>
-"DATA",175.101,2,1,25,0)
-        <string>string</string>
-"DATA",175.101,2,1,26,0)
-      </proposedMedications>
-"DATA",175.101,2,1,27,0)
-      <drugStandardType>string</drugStandardType>
-"DATA",175.101,2,1,28,0)
-    </DrugDrugInteraction>
-"DATA",175.101,2,2,0)
-^^48^48^3090303^
-"DATA",175.101,2,2,1,0)
- <DrugDrugInteractionResponse 
-"DATA",175.101,2,2,2,0)
-xmlns="https://secure.newcropaccounts.com/V7/webservices">
-"DATA",175.101,2,2,3,0)
-      <DrugDrugInteractionResult>
-"DATA",175.101,2,2,4,0)
-        <result>
-"DATA",175.101,2,2,5,0)
-          <Status>Unknown or OK or Fail or NotFound</Status>
-"DATA",175.101,2,2,6,0)
-          <Message>string</Message>
-"DATA",175.101,2,2,7,0)
-          <XmlResponse>string</XmlResponse>
-"DATA",175.101,2,2,8,0)
-          <RowCount>int</RowCount>
-"DATA",175.101,2,2,9,0)
-          <Timing>int</Timing>
-"DATA",175.101,2,2,10,0)
-        </result>
-"DATA",175.101,2,2,11,0)
-        <drugInteractionArray>
-"DATA",175.101,2,2,12,0)
-          <DrugInteraction>
-"DATA",175.101,2,2,13,0)
-            <MechanismOfAction>string</MechanismOfAction>
-"DATA",175.101,2,2,14,0)
-            <Discussion>string</Discussion>
-"DATA",175.101,2,2,15,0)
-            <ClinicalEffects>string</ClinicalEffects>
-"DATA",175.101,2,2,16,0)
-            <SeverityLevel>string</SeverityLevel>
-"DATA",175.101,2,2,17,0)
-            <PatientManagement>string</PatientManagement>
-"DATA",175.101,2,2,18,0)
-            <PredisposingFactors>string</PredisposingFactors>
-"DATA",175.101,2,2,19,0)
-            <References>string</References>
-"DATA",175.101,2,2,20,0)
-            <MonographTitle>string</MonographTitle>
-"DATA",175.101,2,2,21,0)
-            <Drug1>string</Drug1>
-"DATA",175.101,2,2,22,0)
-            <Drug1ID>string</Drug1ID>
-"DATA",175.101,2,2,23,0)
-            <Drug1Type>string</Drug1Type>
-"DATA",175.101,2,2,24,0)
-            <Drug2>string</Drug2>
-"DATA",175.101,2,2,25,0)
-            <Drug2ID>string</Drug2ID>
-"DATA",175.101,2,2,26,0)
-            <Drug2Type>string</Drug2Type>
-"DATA",175.101,2,2,27,0)
-            <Performance>string</Performance>
-"DATA",175.101,2,2,28,0)
-          </DrugInteraction>
-"DATA",175.101,2,2,29,0)
-          <DrugInteraction>
-"DATA",175.101,2,2,30,0)
-            <MechanismOfAction>string</MechanismOfAction>
-"DATA",175.101,2,2,31,0)
-            <Discussion>string</Discussion>
-"DATA",175.101,2,2,32,0)
-            <ClinicalEffects>string</ClinicalEffects>
-"DATA",175.101,2,2,33,0)
-            <SeverityLevel>string</SeverityLevel>
-"DATA",175.101,2,2,34,0)
-            <PatientManagement>string</PatientManagement>
-"DATA",175.101,2,2,35,0)
-            <PredisposingFactors>string</PredisposingFactors>
-"DATA",175.101,2,2,36,0)
-            <References>string</References>
-"DATA",175.101,2,2,37,0)
-            <MonographTitle>string</MonographTitle>
-"DATA",175.101,2,2,38,0)
-            <Drug1>string</Drug1>
-"DATA",175.101,2,2,39,0)
-            <Drug1ID>string</Drug1ID>
-"DATA",175.101,2,2,40,0)
-            <Drug1Type>string</Drug1Type>
-"DATA",175.101,2,2,41,0)
-            <Drug2>string</Drug2>
-"DATA",175.101,2,2,42,0)
-            <Drug2ID>string</Drug2ID>
-"DATA",175.101,2,2,43,0)
-            <Drug2Type>string</Drug2Type>
-"DATA",175.101,2,2,44,0)
-            <Performance>string</Performance>
-"DATA",175.101,2,2,45,0)
-          </DrugInteraction>
-"DATA",175.101,2,2,46,0)
-        </drugInteractionArray>
-"DATA",175.101,2,2,47,0)
-      </DrugDrugInteractionResult>
-"DATA",175.101,2,2,48,0)
-    </DrugDrugInteractionResponse>
-"DATA",175.101,3,0)
-DrugFoodInteraction^https://secure.newcropaccounts.com/V7/webservices/DrugFoodInteraction
-"DATA",175.101,3,1,0)
-^^14^14^3090303^
-"DATA",175.101,3,1,1,0)
-<DrugFoodInteraction 
-"DATA",175.101,3,1,2,0)
-xmlns="https://secure.newcropaccounts.com/V7/webservices">
-"DATA",175.101,3,1,3,0)
-      <credentials>
-"DATA",175.101,3,1,4,0)
-        <PartnerName>string</PartnerName>
-"DATA",175.101,3,1,5,0)
-        <Name>string</Name>
-"DATA",175.101,3,1,6,0)
-        <Password>string</Password>
-"DATA",175.101,3,1,7,0)
-      </credentials>
-"DATA",175.101,3,1,8,0)
-      <accountRequest>
-"DATA",175.101,3,1,9,0)
-        <AccountId>string</AccountId>
-"DATA",175.101,3,1,10,0)
-        <SiteId>string</SiteId>
-"DATA",175.101,3,1,11,0)
-      </accountRequest>
-"DATA",175.101,3,1,12,0)
-      <drugId>string</drugId>
-"DATA",175.101,3,1,13,0)
-      <drugStandardType>string</drugStandardType>
-"DATA",175.101,3,1,14,0)
-    </DrugFoodInteraction>
-"DATA",175.101,3,2,0)
-^^32^32^3090303^
-"DATA",175.101,3,2,1,0)
-<DrugFoodInteractionResponse 
-"DATA",175.101,3,2,2,0)
-xmlns="https://secure.newcropaccounts.com/V7/webservices">
-"DATA",175.101,3,2,3,0)
-      <DrugFoodInteractionResult>
-"DATA",175.101,3,2,4,0)
-        <result>
-"DATA",175.101,3,2,5,0)
-          <Status>Unknown or OK or Fail or NotFound</Status>
-"DATA",175.101,3,2,6,0)
-          <Message>string</Message>
-"DATA",175.101,3,2,7,0)
-          <XmlResponse>string</XmlResponse>
-"DATA",175.101,3,2,8,0)
-          <RowCount>int</RowCount>
-"DATA",175.101,3,2,9,0)
-          <Timing>int</Timing>
-"DATA",175.101,3,2,10,0)
-        </result>
-"DATA",175.101,3,2,11,0)
-        <drugFoodDetailArray>
-"DATA",175.101,3,2,12,0)
-          <DrugFoodDetail>
-"DATA",175.101,3,2,13,0)
-            <DataProvider>string</DataProvider>
-"DATA",175.101,3,2,14,0)
-            <DrugID>string</DrugID>
-"DATA",175.101,3,2,15,0)
-            <DrugName>string</DrugName>
-"DATA",175.101,3,2,16,0)
-            <SeverityLevel>string</SeverityLevel>
-"DATA",175.101,3,2,17,0)
-            <Result>string</Result>
-"DATA",175.101,3,2,18,0)
-            <Line1>string</Line1>
-"DATA",175.101,3,2,19,0)
-            <Line2>string</Line2>
-"DATA",175.101,3,2,20,0)
-          </DrugFoodDetail>
-"DATA",175.101,3,2,21,0)
-          <DrugFoodDetail>
-"DATA",175.101,3,2,22,0)
-            <DataProvider>string</DataProvider>
-"DATA",175.101,3,2,23,0)
-            <DrugID>string</DrugID>
-"DATA",175.101,3,2,24,0)
-            <DrugName>string</DrugName>
-"DATA",175.101,3,2,25,0)
-            <SeverityLevel>string</SeverityLevel>
-"DATA",175.101,3,2,26,0)
-            <Result>string</Result>
-"DATA",175.101,3,2,27,0)
-            <Line1>string</Line1>
-"DATA",175.101,3,2,28,0)
-            <Line2>string</Line2>
-"DATA",175.101,3,2,29,0)
-          </DrugFoodDetail>
-"DATA",175.101,3,2,30,0)
-        </drugFoodDetailArray>
-"DATA",175.101,3,2,31,0)
-      </DrugFoodInteractionResult>
-"DATA",175.101,3,2,32,0)
-    </DrugFoodInteractionResponse>
-"DATA",175.101,4,0)
-DrugSearchWithFormulary^https://secure.newcropaccounts.com/V7/webservices/DrugSearchWithFormulary
-"DATA",175.101,4,1,0)
-^^26^26^3090303^
-"DATA",175.101,4,1,1,0)
-<DrugSearchWithFormulary 
-"DATA",175.101,4,1,2,0)
-xmlns="https://secure.newcropaccounts.com/V7/webservices">
-"DATA",175.101,4,1,3,0)
-      <credentials>
-"DATA",175.101,4,1,4,0)
-        <PartnerName>string</PartnerName>
-"DATA",175.101,4,1,5,0)
-        <Name>string</Name>
-"DATA",175.101,4,1,6,0)
-        <Password>string</Password>
-"DATA",175.101,4,1,7,0)
-      </credentials>
-"DATA",175.101,4,1,8,0)
-      <accountRequest>
-"DATA",175.101,4,1,9,0)
-        <AccountId>string</AccountId>
-"DATA",175.101,4,1,10,0)
-        <SiteId>string</SiteId>
-"DATA",175.101,4,1,11,0)
-      </accountRequest>
-"DATA",175.101,4,1,12,0)
-      <patientRequest>
-"DATA",175.101,4,1,13,0)
-        <PatientId>string</PatientId>
-"DATA",175.101,4,1,14,0)
-      </patientRequest>
-"DATA",175.101,4,1,15,0)
-      <patientInformationRequester>
-"DATA",175.101,4,1,16,0)
-        <UserType>string</UserType>
-"DATA",175.101,4,1,17,0)
-        <UserId>string</UserId>
-"DATA",175.101,4,1,18,0)
-      </patientInformationRequester>
-"DATA",175.101,4,1,19,0)
-      <healthplanID>string</healthplanID>
-"DATA",175.101,4,1,20,0)
-      <healthplanTypeID>string</healthplanTypeID>
-"DATA",175.101,4,1,21,0)
-      <drugName>string</drugName>
-"DATA",175.101,4,1,22,0)
-      <includeObsolete>string</includeObsolete>
-"DATA",175.101,4,1,23,0)
-      <searchBrandGeneric>string</searchBrandGeneric>
-"DATA",175.101,4,1,24,0)
-      <searchRxOTC>string</searchRxOTC>
-"DATA",175.101,4,1,25,0)
-      <searchDrugSupply>string</searchDrugSupply>
-"DATA",175.101,4,1,26,0)
-    </DrugSearchWithFormulary>
-"DATA",175.101,4,2,0)
-^^22^22^3090303^
-"DATA",175.101,4,2,1,0)
-<DrugSearchWithFormularyResponse 
-"DATA",175.101,4,2,2,0)
-xmlns="https://secure.newcropaccounts.com/V7/webservices">
-"DATA",175.101,4,2,3,0)
-      <DrugSearchWithFormularyResult>
-"DATA",175.101,4,2,4,0)
-        <result>
-"DATA",175.101,4,2,5,0)
-          <Status>Unknown or OK or Fail or NotFound</Status>
-"DATA",175.101,4,2,6,0)
-          <Message>string</Message>
-"DATA",175.101,4,2,7,0)
-          <XmlResponse>string</XmlResponse>
-"DATA",175.101,4,2,8,0)
-          <RowCount>int</RowCount>
-"DATA",175.101,4,2,9,0)
-          <Timing>int</Timing>
-"DATA",175.101,4,2,10,0)
-        </result>
-"DATA",175.101,4,2,11,0)
-        <drugFormularyDetailArray>
-"DATA",175.101,4,2,12,0)
-          <DrugFormularyDetail>
-"DATA",175.101,4,2,13,0)
-            <drugDetail xsi:nil="true" />
-"DATA",175.101,4,2,14,0)
-            <formularyCoverage>string</formularyCoverage>
-"DATA",175.101,4,2,15,0)
-          </DrugFormularyDetail>
-"DATA",175.101,4,2,16,0)
-          <DrugFormularyDetail>
-"DATA",175.101,4,2,17,0)
-            <drugDetail xsi:nil="true" />
-"DATA",175.101,4,2,18,0)
-            <formularyCoverage>string</formularyCoverage>
-"DATA",175.101,4,2,19,0)
-          </DrugFormularyDetail>
-"DATA",175.101,4,2,20,0)
-        </drugFormularyDetailArray>
-"DATA",175.101,4,2,21,0)
-      </DrugSearchWithFormularyResult>
-"DATA",175.101,4,2,22,0)
-    </DrugSearchWithFormularyResponse>
-"DATA",175.101,5,0)
-DrugsByDiagnosis^https://secure.newcropaccounts.com/V7/webservices/DrugsByDiagnosis
-"DATA",175.101,5,1,0)
-^^24^24^3090303^
-"DATA",175.101,5,1,1,0)
-<DrugsByDiagnosis 
-"DATA",175.101,5,1,2,0)
-xmlns="https://secure.newcropaccounts.com/V7/webservices">
-"DATA",175.101,5,1,3,0)
-      <credentials>
-"DATA",175.101,5,1,4,0)
-        <PartnerName>string</PartnerName>
-"DATA",175.101,5,1,5,0)
-        <Name>string</Name>
-"DATA",175.101,5,1,6,0)
-        <Password>string</Password>
-"DATA",175.101,5,1,7,0)
-      </credentials>
-"DATA",175.101,5,1,8,0)
-      <accountRequest>
-"DATA",175.101,5,1,9,0)
-        <AccountId>string</AccountId>
-"DATA",175.101,5,1,10,0)
-        <SiteId>string</SiteId>
-"DATA",175.101,5,1,11,0)
-      </accountRequest>
-"DATA",175.101,5,1,12,0)
-      <patientRequest>
-"DATA",175.101,5,1,13,0)
-        <PatientId>string</PatientId>
-"DATA",175.101,5,1,14,0)
-      </patientRequest>
-"DATA",175.101,5,1,15,0)
-      <patientInformationRequester>
-"DATA",175.101,5,1,16,0)
-        <UserType>string</UserType>
-"DATA",175.101,5,1,17,0)
-        <UserId>string</UserId>
-"DATA",175.101,5,1,18,0)
-      </patientInformationRequester>
-"DATA",175.101,5,1,19,0)
-      <diagnosisList>
-"DATA",175.101,5,1,20,0)
-        <string>string</string>
-"DATA",175.101,5,1,21,0)
-        <string>string</string>
-"DATA",175.101,5,1,22,0)
-      </diagnosisList>
-"DATA",175.101,5,1,23,0)
-      <diagnosisListType>string</diagnosisListType>
-"DATA",175.101,5,1,24,0)
-    </DrugsByDiagnosis>
-"DATA",175.101,5,2,0)
-^^56^56^3090303^
-"DATA",175.101,5,2,1,0)
-<DrugsByDiagnosisResponse 
-"DATA",175.101,5,2,2,0)
-xmlns="https://secure.newcropaccounts.com/V7/webservices">
-"DATA",175.101,5,2,3,0)
-      <DrugsByDiagnosisResult>
-"DATA",175.101,5,2,4,0)
-        <result>
-"DATA",175.101,5,2,5,0)
-          <Status>Unknown or OK or Fail or NotFound</Status>
-"DATA",175.101,5,2,6,0)
-          <Message>string</Message>
-"DATA",175.101,5,2,7,0)
-          <XmlResponse>string</XmlResponse>
-"DATA",175.101,5,2,8,0)
-          <RowCount>int</RowCount>
-"DATA",175.101,5,2,9,0)
-          <Timing>int</Timing>
-"DATA",175.101,5,2,10,0)
-        </result>
-"DATA",175.101,5,2,11,0)
-        <drugDetailArray>
-"DATA",175.101,5,2,12,0)
-          <DrugDetail>
-"DATA",175.101,5,2,13,0)
-            <DataProvider>string</DataProvider>
-"DATA",175.101,5,2,14,0)
-            <Drug>string</Drug>
-"DATA",175.101,5,2,15,0)
-            <DrugID>string</DrugID>
-"DATA",175.101,5,2,16,0)
-            <DrugSubID1>string</DrugSubID1>
-"DATA",175.101,5,2,17,0)
-            <DrugName>string</DrugName>
-"DATA",175.101,5,2,18,0)
-            <DrugNameID>string</DrugNameID>
-"DATA",175.101,5,2,19,0)
-            <GenericName>string</GenericName>
-"DATA",175.101,5,2,20,0)
-            <DeaClassCode>string</DeaClassCode>
-"DATA",175.101,5,2,21,0)
-            <Dosage>string</Dosage>
-"DATA",175.101,5,2,22,0)
-            <DosageForm>string</DosageForm>
-"DATA",175.101,5,2,23,0)
-            <Route>string</Route>
-"DATA",175.101,5,2,24,0)
-            <Status>string</Status>
-"DATA",175.101,5,2,25,0)
-            <TherapeuticClass>string</TherapeuticClass>
-"DATA",175.101,5,2,26,0)
-            <DeaGenericNamedCode>string</DeaGenericNamedCode>
-"DATA",175.101,5,2,27,0)
-            
-"DATA",175.101,5,2,28,0)
-<DeaGenericNamedDescription>string</DeaGenericNamedDescription>
-"DATA",175.101,5,2,29,0)
-            <DeaLegendCode>string</DeaLegendCode>
-"DATA",175.101,5,2,30,0)
-            <DeaLegendDescription>string</DeaLegendDescription>
-"DATA",175.101,5,2,31,0)
-            <Touchdate>string</Touchdate>
-"DATA",175.101,5,2,32,0)
-          </DrugDetail>
-"DATA",175.101,5,2,33,0)
-          <DrugDetail>
-"DATA",175.101,5,2,34,0)
-            <DataProvider>string</DataProvider>
-"DATA",175.101,5,2,35,0)
-            <Drug>string</Drug>
-"DATA",175.101,5,2,36,0)
-            <DrugID>string</DrugID>
-"DATA",175.101,5,2,37,0)
-            <DrugSubID1>string</DrugSubID1>
-"DATA",175.101,5,2,38,0)
-            <DrugName>string</DrugName>
-"DATA",175.101,5,2,39,0)
-            <DrugNameID>string</DrugNameID>
-"DATA",175.101,5,2,40,0)
-            <GenericName>string</GenericName>
-"DATA",175.101,5,2,41,0)
-            <DeaClassCode>string</DeaClassCode>
-"DATA",175.101,5,2,42,0)
-            <Dosage>string</Dosage>
-"DATA",175.101,5,2,43,0)
-            <DosageForm>string</DosageForm>
-"DATA",175.101,5,2,44,0)
-            <Route>string</Route>
-"DATA",175.101,5,2,45,0)
-            <Status>string</Status>
-"DATA",175.101,5,2,46,0)
-            <TherapeuticClass>string</TherapeuticClass>
-"DATA",175.101,5,2,47,0)
-            <DeaGenericNamedCode>string</DeaGenericNamedCode>
-"DATA",175.101,5,2,48,0)
-            
-"DATA",175.101,5,2,49,0)
-<DeaGenericNamedDescription>string</DeaGenericNamedDescription>
-"DATA",175.101,5,2,50,0)
-            <DeaLegendCode>string</DeaLegendCode>
-"DATA",175.101,5,2,51,0)
-            <DeaLegendDescription>string</DeaLegendDescription>
-"DATA",175.101,5,2,52,0)
-            <Touchdate>string</Touchdate>
-"DATA",175.101,5,2,53,0)
-          </DrugDetail>
-"DATA",175.101,5,2,54,0)
-        </drugDetailArray>
-"DATA",175.101,5,2,55,0)
-      </DrugsByDiagnosisResult>
-"DATA",175.101,5,2,56,0)
-    </DrugsByDiagnosisResponse>
-"DATA",175.101,6,0)
-DrugsByDiagnosisWithFormulary^https://secure.newcropaccounts.com/V7/webservices/DrugsByDiagnosisWithFormulary
-"DATA",175.101,6,1,0)
-^^26^26^3090303^
-"DATA",175.101,6,1,1,0)
-<DrugsByDiagnosisWithFormulary 
-"DATA",175.101,6,1,2,0)
-xmlns="https://secure.newcropaccounts.com/V7/webservices">
-"DATA",175.101,6,1,3,0)
-      <credentials>
-"DATA",175.101,6,1,4,0)
-        <PartnerName>string</PartnerName>
-"DATA",175.101,6,1,5,0)
-        <Name>string</Name>
-"DATA",175.101,6,1,6,0)
-        <Password>string</Password>
-"DATA",175.101,6,1,7,0)
-      </credentials>
-"DATA",175.101,6,1,8,0)
-      <accountRequest>
-"DATA",175.101,6,1,9,0)
-        <AccountId>string</AccountId>
-"DATA",175.101,6,1,10,0)
-        <SiteId>string</SiteId>
-"DATA",175.101,6,1,11,0)
-      </accountRequest>
-"DATA",175.101,6,1,12,0)
-      <patientRequest>
-"DATA",175.101,6,1,13,0)
-        <PatientId>string</PatientId>
-"DATA",175.101,6,1,14,0)
-      </patientRequest>
-"DATA",175.101,6,1,15,0)
-      <patientInformationRequester>
-"DATA",175.101,6,1,16,0)
-        <UserType>string</UserType>
-"DATA",175.101,6,1,17,0)
-        <UserId>string</UserId>
-"DATA",175.101,6,1,18,0)
-      </patientInformationRequester>
-"DATA",175.101,6,1,19,0)
-      <healthplanID>string</healthplanID>
-"DATA",175.101,6,1,20,0)
-      <healthplanTypeID>string</healthplanTypeID>
-"DATA",175.101,6,1,21,0)
-      <diagnosisList>
-"DATA",175.101,6,1,22,0)
-        <string>string</string>
-"DATA",175.101,6,1,23,0)
-        <string>string</string>
-"DATA",175.101,6,1,24,0)
-      </diagnosisList>
-"DATA",175.101,6,1,25,0)
-      <diagnosisListType>string</diagnosisListType>
-"DATA",175.101,6,1,26,0)
-    </DrugsByDiagnosisWithFormulary>
-"DATA",175.101,6,2,0)
-^^22^22^3090303^
-"DATA",175.101,6,2,1,0)
-<DrugsByDiagnosisWithFormularyResponse 
-"DATA",175.101,6,2,2,0)
-xmlns="https://secure.newcropaccounts.com/V7/webservices">
-"DATA",175.101,6,2,3,0)
-      <DrugsByDiagnosisWithFormularyResult>
-"DATA",175.101,6,2,4,0)
-        <result>
-"DATA",175.101,6,2,5,0)
-          <Status>Unknown or OK or Fail or NotFound</Status>
-"DATA",175.101,6,2,6,0)
-          <Message>string</Message>
-"DATA",175.101,6,2,7,0)
-          <XmlResponse>string</XmlResponse>
-"DATA",175.101,6,2,8,0)
-          <RowCount>int</RowCount>
-"DATA",175.101,6,2,9,0)
-          <Timing>int</Timing>
-"DATA",175.101,6,2,10,0)
-        </result>
-"DATA",175.101,6,2,11,0)
-        <drugFormularyDetailArray>
-"DATA",175.101,6,2,12,0)
-          <DrugFormularyDetail>
-"DATA",175.101,6,2,13,0)
-            <drugDetail xsi:nil="true" />
-"DATA",175.101,6,2,14,0)
-            <formularyCoverage>string</formularyCoverage>
-"DATA",175.101,6,2,15,0)
-          </DrugFormularyDetail>
-"DATA",175.101,6,2,16,0)
-          <DrugFormularyDetail>
-"DATA",175.101,6,2,17,0)
-            <drugDetail xsi:nil="true" />
-"DATA",175.101,6,2,18,0)
-            <formularyCoverage>string</formularyCoverage>
-"DATA",175.101,6,2,19,0)
-          </DrugFormularyDetail>
-"DATA",175.101,6,2,20,0)
-        </drugFormularyDetailArray>
-"DATA",175.101,6,2,21,0)
-      </DrugsByDiagnosisWithFormularyResult>
-"DATA",175.101,6,2,22,0)
-    </DrugsByDiagnosisWithFormularyResponse>
-"DATA",175.101,7,0)
-ValidateNDCList^https://secure.newcropaccounts.com/V7/webservices/ValidateNDCList
-"DATA",175.101,7,1,0)
-^^13^13^3090303^
-"DATA",175.101,7,1,1,0)
-<ValidateNDCList 
-"DATA",175.101,7,1,2,0)
-xmlns="https://secure.newcropaccounts.com/V7/webservices">
-"DATA",175.101,7,1,3,0)
-      <credentials>
-"DATA",175.101,7,1,4,0)
-        <PartnerName>string</PartnerName>
-"DATA",175.101,7,1,5,0)
-        <Name>string</Name>
-"DATA",175.101,7,1,6,0)
-        <Password>string</Password>
-"DATA",175.101,7,1,7,0)
-      </credentials>
-"DATA",175.101,7,1,8,0)
-      <ndcList>
-"DATA",175.101,7,1,9,0)
-        <string>string</string>
-"DATA",175.101,7,1,10,0)
-        <string>string</string>
-"DATA",175.101,7,1,11,0)
-      </ndcList>
-"DATA",175.101,7,1,12,0)
-      <drugStandardType>string</drugStandardType>
-"DATA",175.101,7,1,13,0)
-    </ValidateNDCList>
-"DATA",175.101,7,2,0)
-^^22^22^3090303^
-"DATA",175.101,7,2,1,0)
-<ValidateNDCListResponse 
-"DATA",175.101,7,2,2,0)
-xmlns="https://secure.newcropaccounts.com/V7/webservices">
-"DATA",175.101,7,2,3,0)
-      <ValidateNDCListResult>
-"DATA",175.101,7,2,4,0)
-        <result>
-"DATA",175.101,7,2,5,0)
-          <Status>Unknown or OK or Fail or NotFound</Status>
-"DATA",175.101,7,2,6,0)
-          <Message>string</Message>
-"DATA",175.101,7,2,7,0)
-          <XmlResponse>string</XmlResponse>
-"DATA",175.101,7,2,8,0)
-          <RowCount>int</RowCount>
-"DATA",175.101,7,2,9,0)
-          <Timing>int</Timing>
-"DATA",175.101,7,2,10,0)
-        </result>
-"DATA",175.101,7,2,11,0)
-        <ndcValidationDetailArray>
-"DATA",175.101,7,2,12,0)
-          <NDCValidationDetail>
-"DATA",175.101,7,2,13,0)
-            <ndc>string</ndc>
-"DATA",175.101,7,2,14,0)
-            <ndcStatus>string</ndcStatus>
-"DATA",175.101,7,2,15,0)
-          </NDCValidationDetail>
-"DATA",175.101,7,2,16,0)
-          <NDCValidationDetail>
-"DATA",175.101,7,2,17,0)
-            <ndc>string</ndc>
-"DATA",175.101,7,2,18,0)
-            <ndcStatus>string</ndcStatus>
-"DATA",175.101,7,2,19,0)
-          </NDCValidationDetail>
-"DATA",175.101,7,2,20,0)
-        </ndcValidationDetailArray>
-"DATA",175.101,7,2,21,0)
-      </ValidateNDCListResult>
-"DATA",175.101,7,2,22,0)
-    </ValidateNDCListResponse>
-"DATA",175.201,2,0)
-EPRESCRIBING
-"DATA",175.201,2,1,0)
-^175.2011P^2^2
-"DATA",175.201,2,1,1,0)
-1^1
-"DATA",175.201,2,1,2,0)
-3^2
-"FIA",175.101)
-C0P APPLICATION STEPS
-"FIA",175.101,0)
-^C0PS(
-"FIA",175.101,0,0)
-175.101
-"FIA",175.101,0,1)
-y^y^f^^n^^y^o^n
-"FIA",175.101,0,10)
-
-"FIA",175.101,0,11)
-
-"FIA",175.101,0,"RLRO")
-
-"FIA",175.101,175.101)
-0
-"FIA",175.101,175.1012)
-0
-"FIA",175.101,175.1013)
-0
-"FIA",175.201)
-C0P WEB APPLICATIONS
-"FIA",175.201,0)
-^C0PAPP(
-"FIA",175.201,0,0)
-175.201
-"FIA",175.201,0,1)
-y^y^f^^n^^y^o^n
-"FIA",175.201,0,10)
-
-"FIA",175.201,0,11)
-
-"FIA",175.201,0,"RLRO")
-
-"FIA",175.201,175.201)
-0
-"FIA",175.201,175.2011)
-0
-"MBREQ")
-0
-"QUES","XPF1",0)
-Y
-"QUES","XPF1","??")
-^D REP^XPDH
-"QUES","XPF1","A")
-Shall I write over your |FLAG| File
-"QUES","XPF1","B")
-YES
-"QUES","XPF1","M")
-D XPF1^XPDIQ
-"QUES","XPF2",0)
-Y
-"QUES","XPF2","??")
-^D DTA^XPDH
-"QUES","XPF2","A")
-Want my data |FLAG| yours
-"QUES","XPF2","B")
-YES
-"QUES","XPF2","M")
-D XPF2^XPDIQ
-"QUES","XPI1",0)
-YO
-"QUES","XPI1","??")
-^D INHIBIT^XPDH
-"QUES","XPI1","A")
-Want KIDS to INHIBIT LOGONs during the install
-"QUES","XPI1","B")
-NO
-"QUES","XPI1","M")
-D XPI1^XPDIQ
-"QUES","XPM1",0)
-PO^VA(200,:EM
-"QUES","XPM1","??")
-^D MG^XPDH
-"QUES","XPM1","A")
-Enter the Coordinator for Mail Group '|FLAG|'
-"QUES","XPM1","B")
-
-"QUES","XPM1","M")
-D XPM1^XPDIQ
-"QUES","XPO1",0)
-Y
-"QUES","XPO1","??")
-^D MENU^XPDH
-"QUES","XPO1","A")
-Want KIDS to Rebuild Menu Trees Upon Completion of Install
-"QUES","XPO1","B")
-NO
-"QUES","XPO1","M")
-D XPO1^XPDIQ
-"QUES","XPZ1",0)
-Y
-"QUES","XPZ1","??")
-^D OPT^XPDH
-"QUES","XPZ1","A")
-Want to DISABLE Scheduled Options, Menu Options, and Protocols
-"QUES","XPZ1","B")
-NO
-"QUES","XPZ1","M")
-D XPZ1^XPDIQ
-"QUES","XPZ2",0)
-Y
-"QUES","XPZ2","??")
-^D RTN^XPDH
-"QUES","XPZ2","A")
-Want to MOVE routines to other CPUs
-"QUES","XPZ2","B")
-NO
-"QUES","XPZ2","M")
-D XPZ2^XPDIQ
-"RTN")
-2
-"RTN","C0PEWD1")
-0^1^B8658372
-"RTN","C0PEWD1",1,0)
-C0CEWD1   ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
-"RTN","C0PEWD1",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 1
-"RTN","C0PEWD1",3,0)
- ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-"RTN","C0PEWD1",4,0)
- ;General Public License See attached copy of the License.
-"RTN","C0PEWD1",5,0)
- ;
-"RTN","C0PEWD1",6,0)
- ;This program is free software; you can redistribute it and/or modify
-"RTN","C0PEWD1",7,0)
- ;it under the terms of the GNU General Public License as published by
-"RTN","C0PEWD1",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
-"RTN","C0PEWD1",9,0)
- ;(at your option) any later version.
-"RTN","C0PEWD1",10,0)
- ;
-"RTN","C0PEWD1",11,0)
- ;This program is distributed in the hope that it will be useful,
-"RTN","C0PEWD1",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","C0PEWD1",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","C0PEWD1",14,0)
- ;GNU General Public License for more details.
-"RTN","C0PEWD1",15,0)
- ;
-"RTN","C0PEWD1",16,0)
- ;You should have received a copy of the GNU General Public License along
-"RTN","C0PEWD1",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","C0PEWD1",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","C0PEWD1",19,0)
- ;
-"RTN","C0PEWD1",20,0)
- Q
-"RTN","C0PEWD1",21,0)
- ;TEST(filepath) ; filepath IS THE PATH/FILE TO BE READ IN
-"RTN","C0PEWD1",22,0)
- i $g(^%ZISH)["" d  ; if the VistA Kernal routine %ZISH exists
-"RTN","C0PEWD1",23,0)
- . n zfile,zpath,ztmp s (zfile,zpath,ztmp)=""
-"RTN","C0PEWD1",24,0)
- . s zfile=$re($p($re(filepath),"/",1)) ;file name
-"RTN","C0PEWD1",25,0)
- . s zpath=$p(filepath,zfile,1) ; file path
-"RTN","C0PEWD1",26,0)
- . s ztmp=$na(^CacheTempEWD($j,0))
-"RTN","C0PEWD1",27,0)
- . s ok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file incrementing subscr 2
-"RTN","C0PEWD1",28,0)
- q
-"RTN","C0PEWD1",29,0)
- ;
-"RTN","C0PEWD1",30,0)
-TEST2 ;
-"RTN","C0PEWD1",31,0)
- s zfilepath="/home/vademo2/CCR/PAT_780_CCR_V1_0_17.xml"
-"RTN","C0PEWD1",32,0)
- ;s ok=$$gtmImportFile^%zewdHTMLParser(zfilepath)
-"RTN","C0PEWD1",33,0)
- s ok=$$LOAD(zfilepath) ;load the XML file to the EWD global
-"RTN","C0PEWD1",34,0)
- s ok=$$parseDocument^%zewdHTMLParser("DerekDOM",0)
-"RTN","C0PEWD1",35,0)
- ;s ok=$$parseXMLFile^%zewdAPI(zfilepath,"fourthDOM")
-"RTN","C0PEWD1",36,0)
- w ok,!
-"RTN","C0PEWD1",37,0)
- q
-"RTN","C0PEWD1",38,0)
- ;
-"RTN","C0PEWD1",39,0)
-GPLTEST ;
-"RTN","C0PEWD1",40,0)
- ;s ok=$$httpGET^%zewdGTM("http://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml",.gpl)
-"RTN","C0PEWD1",41,0)
- s URL="https://trac.opensourcevista.net/CCD-CCR-Project/browser/ccr/tags/CCR_1_0_7/output"
-"RTN","C0PEWD1",42,0)
- s ok=$$httpGET^%zewdGTM(URL,.gpl)
-"RTN","C0PEWD1",43,0)
- S ZG=""
-"RTN","C0PEWD1",44,0)
- F  S ZG=$O(gpl(ZG)) Q:ZG=""  D  ;
-"RTN","C0PEWD1",45,0)
- . s gpl(ZG)=$$CLEAN^C0PEWDU(gpl(ZG)) ;
-"RTN","C0PEWD1",46,0)
- . ;w gpl(ZG)
-"RTN","C0PEWD1",47,0)
- m ^CacheTempEWD($j)=gpl
-"RTN","C0PEWD1",48,0)
- b
-"RTN","C0PEWD1",49,0)
- s ok=$$parseDocument^%zewdHTMLParser("gpl2",0)
-"RTN","C0PEWD1",50,0)
- s ok=$$outputDOM^%zewdDOM("gpl2",1,1)
-"RTN","C0PEWD1",51,0)
- Q
-"RTN","C0PEWD1",52,0)
- ;
-"RTN","C0PEWD1",53,0)
-CLEAN(INX) ;DELETE NON-PRINTING CHARACTER IN INX, PASSED BY VALUE
-"RTN","C0PEWD1",54,0)
- ;DON'T USE THIS -- IT DOESN'T WORK -- USE $$CLEAN^C0PEWDU
-"RTN","C0PEWD1",55,0)
- ;N ZT,ZI
-"RTN","C0PEWD1",56,0)
- S ZT=""
-"RTN","C0PEWD1",57,0)
- F ZI=32:1:126 S ZT=ZT_$CHAR(ZI)
-"RTN","C0PEWD1",58,0)
- S ZZ=$TR(INX,ZT)
-"RTN","C0PEWD1",59,0)
- Q ZZ
-"RTN","C0PEWD1",60,0)
- ;
-"RTN","C0PEWD1",61,0)
-LOAD(filepath) ; load an xml file into the EWD global for DOM processing
-"RTN","C0PEWD1",62,0)
- ; need to call s error=$$parseDocument^%zewdHTMLParser(docName,isHTML)
-"RTN","C0PEWD1",63,0)
- ; after to process it to the DOM - isHTML=0 for XML files
-"RTN","C0PEWD1",64,0)
- n i
-"RTN","C0PEWD1",65,0)
- i $g(^%ZISH)["" d  QUIT i ; if VistA Kernal routine %ZISH exists - gpl 2/23/09
-"RTN","C0PEWD1",66,0)
- . n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)=""
-"RTN","C0PEWD1",67,0)
- . s zfile=$re($p($re(filepath),"/",1)) ;file name
-"RTN","C0PEWD1",68,0)
- . s zpath=$p(filepath,zfile,1) ; file path
-"RTN","C0PEWD1",69,0)
- . s ztmp=$na(^CacheTempEWD($j,0))
-"RTN","C0PEWD1",70,0)
- . s zok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file increment subscr 2
-"RTN","C0PEWD1",71,0)
- . s i=$o(^CacheTempEWD($j,""),-1) ; highest line number
-"RTN","C0PEWD1",72,0)
- q i
-"RTN","C0PEWD1",73,0)
- ;
-"RTN","C0PEWD1",74,0)
-Q(ZQ,ZD) ; SEND QUERY ZQ TO DOM ZD AND DIPLAY NODES RETURNED
-"RTN","C0PEWD1",75,0)
- I '$D(ZD) S ZD="DerekDOM"
-"RTN","C0PEWD1",76,0)
- s error=$$select^%zewdXPath(ZQ,ZD,.nodes) ;
-"RTN","C0PEWD1",77,0)
- d displayNodes^%zewdXPath(.nodes)
-"RTN","C0PEWD1",78,0)
- q
-"RTN","C0PEWD1",79,0)
- ;
-"RTN","C0PEWDU")
-0^2^B1881609
-"RTN","C0PEWDU",1,0)
-C0PEWDU ; WV/SMH - E-prescription utilities; Mar 3 2009
-"RTN","C0PEWDU",2,0)
- ;;0.1;WV EPrescribing;;;Build 1
-"RTN","C0PEWDU",3,0)
- Q
-"RTN","C0PEWDU",4,0)
- ;
-"RTN","C0PEWDU",5,0)
-CLEAN(STR) ; extrinsic function; returns string
-"RTN","C0PEWDU",6,0)
- ;; Removes all non printable characters from a string.
-"RTN","C0PEWDU",7,0)
- ;; STR by Value
-"RTN","C0PEWDU",8,0)
- N TR,I
-"RTN","C0PEWDU",9,0)
- F I=0:1:31 S TR=$G(TR)_$C(I)
-"RTN","C0PEWDU",10,0)
- S TR=TR_$C(127)
-"RTN","C0PEWDU",11,0)
- QUIT $TR(STR,TR)
-"RTN","C0PEWDU",12,0)
- ;
-"RTN","C0PEWDU",13,0)
-GETSOAP(ENTRY,REQUEST,RESULT) ; XML SOAP Spec for NewCrop
-"RTN","C0PEWDU",14,0)
- ;; Gets world processing field from Fileman for Parsing
-"RTN","C0PEWDU",15,0)
- ;; ENTRY Input by Value
-"RTN","C0PEWDU",16,0)
- ;; REQUEST XML Output by Reference
-"RTN","C0PEWDU",17,0)
- ;; RESULT XML Output by Reference
-"RTN","C0PEWDU",18,0)
- ;; Example call: D GETSOAP^C0PEWDU("DrugAllergyInteraction",.REQ,.RES)
-"RTN","C0PEWDU",19,0)
- ;
-"RTN","C0PEWDU",20,0)
- N OK,ERR,IEN,F  ; if call is okay, Error, IEN, File
-"RTN","C0PEWDU",21,0)
- S F=175.101
-"RTN","C0PEWDU",22,0)
- S IEN=$$FIND1^DIC(F,"","",ENTRY,"B")
-"RTN","C0PEWDU",23,0)
- S OK=$$GET1^DIQ(F,IEN,2,"","REQUEST","ERR")
-"RTN","C0PEWDU",24,0)
- I OK=""!($D(ERR)) S REQUEST=""
-"RTN","C0PEWDU",25,0)
- ; M ^CacheTempEWD($j)=REQUEST
-"RTN","C0PEWDU",26,0)
- ; K REQUEST
-"RTN","C0PEWDU",27,0)
- ; S ok=$$parseDocument^%zewdHTMLParser("REQUEST",0)
-"RTN","C0PEWDU",28,0)
- ; S ok=$$outputDOM^%zewdDOM("REQUEST",1,1)
-"RTN","C0PEWDU",29,0)
- ; Q  ; remove later
-"RTN","C0PEWDU",30,0)
- K OK,ERR
-"RTN","C0PEWDU",31,0)
- S OK=$$GET1^DIQ(F,IEN,3,"","RESULT","ERR")
-"RTN","C0PEWDU",32,0)
- I OK=""!($D(ERR)) S RESULT=""
-"RTN","C0PEWDU",33,0)
- QUIT
-"RTN","C0PEWDU",34,0)
- ;
-"SEC","^DIC",175.101,175.101,0,"AUDIT")
-@
-"SEC","^DIC",175.101,175.101,0,"DD")
-@
-"SEC","^DIC",175.101,175.101,0,"DEL")
-@
-"SEC","^DIC",175.101,175.101,0,"LAYGO")
-@
-"SEC","^DIC",175.101,175.101,0,"RD")
-@
-"SEC","^DIC",175.101,175.101,0,"WR")
-@
-"SEC","^DIC",175.201,175.201,0,"AUDIT")
-@
-"SEC","^DIC",175.201,175.201,0,"DD")
-@
-"SEC","^DIC",175.201,175.201,0,"DEL")
-@
-"SEC","^DIC",175.201,175.201,0,"LAYGO")
-@
-"SEC","^DIC",175.201,175.201,0,"RD")
-@
-"SEC","^DIC",175.201,175.201,0,"WR")
-@
-"VER")
-8.0^22.0
-"^DD",175.101,175.101,0)
-FIELD^^.05^5
-"^DD",175.101,175.101,0,"DDA")
-N
-"^DD",175.101,175.101,0,"DT")
-3090303
-"^DD",175.101,175.101,0,"IX","B",175.101,.01)
-
-"^DD",175.101,175.101,0,"NM","C0P APPLICATION STEPS")
-
-"^DD",175.101,175.101,0,"PT",175.2011,.01)
-
-"^DD",175.101,175.101,.01,0)
-STEP NAME^RF^^0;1^K:$L(X)>30!(X?.N)!($L(X)<3)!'(X'?1P.E) X
-"^DD",175.101,175.101,.01,.1)
-APPLICATION STEP NAME
-"^DD",175.101,175.101,.01,1,0)
-^.1
-"^DD",175.101,175.101,.01,1,1,0)
-175.101^B
-"^DD",175.101,175.101,.01,1,1,1)
-S ^C0PS("B",$E(X,1,30),DA)=""
-"^DD",175.101,175.101,.01,1,1,2)
-K ^C0PS("B",$E(X,1,30),DA)
-"^DD",175.101,175.101,.01,3)
-APPLICATION STEP NAME
-"^DD",175.101,175.101,.01,"DT")
-3090303
-"^DD",175.101,175.101,.05,0)
-SEQUENCE^NJ9,0^^3;1^K:+X'=X!(X>999999999)!(X<1)!(X?.E1"."1.N) X
-"^DD",175.101,175.101,.05,.1)
-STEP SEQUENCE NUMBER
-"^DD",175.101,175.101,.05,3)
-STEP SEQUENCE NUMBER
-"^DD",175.101,175.101,.05,"DT")
-3090303
-"^DD",175.101,175.101,1,0)
-URL^F^^0;2^K:$L(X)>200!($L(X)<1) X
-"^DD",175.101,175.101,1,.1)
-URL OF WEB SERVICE
-"^DD",175.101,175.101,1,3)
-URL OF WEB SERVICE
-"^DD",175.101,175.101,1,"DT")
-3090303
-"^DD",175.101,175.101,2,0)
-REQUEST XML^175.1012^^1;0
-"^DD",175.101,175.101,3,0)
-RESPONSE XML^175.1013^^2;0
-"^DD",175.101,175.1012,0)
-REQUEST XML SUB-FIELD^^.01^1
-"^DD",175.101,175.1012,0,"DT")
-3090303
-"^DD",175.101,175.1012,0,"NM","REQUEST XML")
-
-"^DD",175.101,175.1012,0,"UP")
-175.101
-"^DD",175.101,175.1012,.01,0)
-REQUEST XML^Wx^^0;1
-"^DD",175.101,175.1012,.01,.1)
-REQUEST XML FOR THIS WEB SERVICE STEP
-"^DD",175.101,175.1012,.01,3)
-REQUEST XML FOR THIS WEB SERVICE STEP
-"^DD",175.101,175.1012,.01,"DT")
-3090303
-"^DD",175.101,175.1013,0)
-RESPONSE XML SUB-FIELD^^.01^1
-"^DD",175.101,175.1013,0,"DT")
-3090303
-"^DD",175.101,175.1013,0,"NM","RESPONSE XML")
-
-"^DD",175.101,175.1013,0,"UP")
-175.101
-"^DD",175.101,175.1013,.01,0)
-RESPONSE XML^Wx^^0;1
-"^DD",175.101,175.1013,.01,.1)
-RESPONSE XML FOR THIS APPLICATION STEP
-"^DD",175.101,175.1013,.01,3)
-RESPONSE XML FOR THIS APPLICATION STEP
-"^DD",175.101,175.1013,.01,"DT")
-3090303
-"^DD",175.201,175.201,0)
-FIELD^^1^2
-"^DD",175.201,175.201,0,"DDA")
-N
-"^DD",175.201,175.201,0,"DT")
-3090303
-"^DD",175.201,175.201,0,"IX","B",175.201,.01)
-
-"^DD",175.201,175.201,0,"NM","C0P WEB APPLICATIONS")
-
-"^DD",175.201,175.201,.01,0)
-APPLICATION NAME^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X
-"^DD",175.201,175.201,.01,.1)
-WEB APPLICATION NAME
-"^DD",175.201,175.201,.01,1,0)
-^.1
-"^DD",175.201,175.201,.01,1,1,0)
-175.201^B
-"^DD",175.201,175.201,.01,1,1,1)
-S ^C0PAPP("B",$E(X,1,30),DA)=""
-"^DD",175.201,175.201,.01,1,1,2)
-K ^C0PAPP("B",$E(X,1,30),DA)
-"^DD",175.201,175.201,.01,3)
-APPLICATION NAME
-"^DD",175.201,175.201,.01,"DT")
-3090303
-"^DD",175.201,175.201,1,0)
-STEPS^175.2011P^^1;0
-"^DD",175.201,175.2011,0)
-STEPS SUB-FIELD^^1^2
-"^DD",175.201,175.2011,0,"DT")
-3090303
-"^DD",175.201,175.2011,0,"IX","B",175.2011,.01)
-
-"^DD",175.201,175.2011,0,"NM","STEPS")
-
-"^DD",175.201,175.2011,0,"UP")
-175.201
-"^DD",175.201,175.2011,.01,0)
-STEPS^MP175.101^C0PS(^0;1^Q
-"^DD",175.201,175.2011,.01,.1)
-APPLICATION STEPS
-"^DD",175.201,175.2011,.01,1,0)
-^.1
-"^DD",175.201,175.2011,.01,1,1,0)
-175.2011^B
-"^DD",175.201,175.2011,.01,1,1,1)
-S ^C0PAPP(DA(1),1,"B",$E(X,1,30),DA)=""
-"^DD",175.201,175.2011,.01,1,1,2)
-K ^C0PAPP(DA(1),1,"B",$E(X,1,30),DA)
-"^DD",175.201,175.2011,.01,3)
-APPLICATIONS STEPS
-"^DD",175.201,175.2011,.01,"DT")
-3090303
-"^DD",175.201,175.2011,1,0)
-SEQUENCE^NJ8,0^^0;2^K:+X'=X!(X>99999999)!(X<1)!(X?.E1"."1.N) X
-"^DD",175.201,175.2011,1,.1)
-STEP SEQUENCE
-"^DD",175.201,175.2011,1,3)
-STEP SEQUENCE
-"^DD",175.201,175.2011,1,"DT")
-3090303
-"^DIC",175.101,175.101,0)
-C0P APPLICATION STEPS^175.101
-"^DIC",175.101,175.101,0,"GL")
-^C0PS(
-"^DIC",175.101,175.101,"%",0)
-^1.005^^
-"^DIC",175.101,175.101,"%D",0)
-^^10^10^3090303^
-"^DIC",175.101,175.101,"%D",1,0)
-This file is being built to support the ePrescribing project. It contains 
-"^DIC",175.101,175.101,"%D",2,0)
-application steps that are used in combination to retrieve information 
-"^DIC",175.101,175.101,"%D",3,0)
-from external web services, combine them, and store them in variables for 
-"^DIC",175.101,175.101,"%D",4,0)
-use in the Order Checking process. In addition, if external meds are 
-"^DIC",175.101,175.101,"%D",5,0)
-identified by the web services for a patient, they are saved to the CCR 
-"^DIC",175.101,175.101,"%D",6,0)
-ELEMENTS file and will be accessioned to the patient's record as "NON-VA" 
-"^DIC",175.101,175.101,"%D",7,0)
-meds.
-"^DIC",175.101,175.101,"%D",8,0)
- 
-"^DIC",175.101,175.101,"%D",9,0)
-This prototype file was created by George Lilly during the RMU VistA 
-"^DIC",175.101,175.101,"%D",10,0)
-sprint March 3, 2009
-"^DIC",175.101,"B","C0P APPLICATION STEPS",175.101)
-
-"^DIC",175.201,175.201,0)
-C0P WEB APPLICATIONS^175.201
-"^DIC",175.201,175.201,0,"GL")
-^C0PAPP(
-"^DIC",175.201,175.201,"%",0)
-^1.005^^
-"^DIC",175.201,175.201,"%D",0)
-^^6^6^3090303^
-"^DIC",175.201,175.201,"%D",1,0)
-This file is being created as part of the ePrescription RMU sprint by 
-"^DIC",175.201,175.201,"%D",2,0)
-George Lilly, Nancy Anthracite, Sam Habiel, and Greg Woodhouse. 
-"^DIC",175.201,175.201,"%D",3,0)
- 
-"^DIC",175.201,175.201,"%D",4,0)
-The Web Application file contains a sequence of processing steps for a 
-"^DIC",175.201,175.201,"%D",5,0)
-named application. The processing steps are pointers to the C0P 
-"^DIC",175.201,175.201,"%D",6,0)
-APPLICATION STEP file (175.101). 
-"^DIC",175.201,"B","C0P WEB APPLICATIONS",175.201)
-
-**END**
-**END**
Index: ePrescribing/trunk/p/_zewdAPI.m
===================================================================
--- ePrescribing/trunk/p/_zewdAPI.m	(revision 518)
+++ 	(revision )
@@ -1,1868 +1,0 @@
-%zewdAPI	; Enterprise Web Developer run-time functions and user APIs
- ;
- ; Product: Enterprise Web Developer version 4.0.755
- ; Build Date: Thu, 12 Feb 2009 09:53:12
- ; 
- ; ----------------------------------------------------------------------------
- ; | Enterprise Web Developer for GT.M and m_apache                           |
- ; | Copyright (c) 2004-9 M/Gateway Developments Ltd,                         |
- ; | Reigate, Surrey UK.                                                      |
- ; | All rights reserved.                                                     |
- ; |                                                                          |
- ; | http://www.mgateway.com                                                  |
- ; | Email: rtweed@mgateway.com                                               |
- ; |                                                                          |
- ; | This program is free software: you can redistribute it and/or modify     |
- ; | it under the terms of the GNU Affero General Public License as           |
- ; | published by the Free Software Foundation, either version 3 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 Affero General Public License for more details.                      |
- ; |                                                                          |
- ; | You should have received a copy of the GNU Affero General Public License |
- ; | along with this program.  If not, see <http://www.gnu.org/licenses/>.    |
- ; ----------------------------------------------------------------------------
- ;
- QUIT
- ;
- ;
-version() ;
- QUIT "Enterprise Web Developer (Build "_$$getVersion^%zewdCompiler()_")"
- ;
-date() ;
- QUIT $$getDate^%zewdCompiler()
- ;
-compilePage(app,page,mode,technology,outputPath,multilingual,maxLines)
- d compilePage^%zewdCompiler($g(app),$g(page),$g(mode),$g(technology),$g(outputPath),$g(multilingual),$g(maxLines))
- QUIT
- ;
-compileAll(app,mode,technology,outputPath,multilingual,templatePageName,maxLines)
- d compileAll^%zewdCompiler($g(app),$g(mode),$g(technology),$g(outputPath),$g(multilingual),$g(templatePageName),$g(maxLines))
- QUIT
- ;
-autoTranslate(app,language,verbose)
- d autoTranslate^%zewdMgr($g(app),$g(language),$g(verbose))
- ;
-startSession(page,requestArray,serverArray,sessionArray,filesArray) ;
- ;
- QUIT $$startSession^%zewdPHP(page,.requestArray,.serverArray,.sessionArray,.filesArray)
- ;
-closeSession(requestArray) ;
- ;
- QUIT $$closeSession^%zewdPHP(.requestArray)
- ;
-saveSession(sessionArray) ;
- ;
- d saveSession^%zewdPHP(.sessionArray)
- QUIT
- ;
-endOfPage(sessionArray)
- ;
- d endOfPage^%zewdPHP(.sessionArray)
- QUIT
- ;
-prePageScript(sessid)
- QUIT $$prePageScript^%zewdPHP(sessid)
- ;
-releaseLock(sessid)
- d releaseLock^%zewdPHP(sessid)
- QUIT
- ;
-tokeniseURL(url,sessid)
- QUIT $$tokeniseURL^%zewdCompiler16($g(url),$g(sessid))
- ;
-getSessid(token)
- ;
- i token="" QUIT ""
- i $$isTokenExpired(token) QUIT ""
- QUIT +^%zewdSession("tokens",token)
- ;
-initialiseSession(sessid)
- k ^%zewdSession("session",sessid)
- QUIT
- ;
-deleteSession(sessid)
- ;
- d deleteSession^%zewdPHP(sessid)
- ;
- QUIT
- ;
-setRedirect(toPage,sessid)
- d setJump(toPage,sessid)
- QUIT
- ;
-setJump(toPage,sessid)
- ;
- n token
- ;
- d setSessionValue("ewd_nextPage",toPage,sessid)
- d setSessionValue("ewd_jump",toPage,sessid)
- QUIT:$e(sessid,1,4)="csp:"
- s token=$$setNextPageToken(toPage,sessid)
- d setSessionValue("ewd_pageToken",token,sessid)
- QUIT
- ;
-setNextPageToken(nextPage,sessid)
- ;
- n token,length
- ;
- s length=$$getSessionValue("ewd_sessid_length",sessid)
- i length="" s length=30
- f  s token=$$makeTokenString(length) q:'$d(^%zewdSession("nextPageTokens",sessid,token))
- i $g(^zewd("trace"))=1 d trace^%zewdAPI("setNextPageToken^%zewdAPI: sessid="_sessid_"; token="_token_"; nextPage="_nextPage)
- s ^%zewdSession("nextPageTokens",sessid,token,$$zcvt(nextPage,"l"))=""
- QUIT token
- ; 
-isNextPageTokenValid(token,sessid,page)
- QUIT $$isNextPageTokenValid^%zewdCompiler13(token,sessid,page)
- ;
-isCSP(sessid)
- QUIT $e(sessid,1,4)="csp:"
- ;
-normaliseTextValue(text)
- s text=$$replaceAll(text,"&#39;","'")
- QUIT $$zcvt(text,"o","HTML")
- ;
-displayOptions(fieldName,listName,escape)
- ;d displayOptions^%zewdCompiler13($g(fieldName),$g(listName),$g(escape))
- n codeValue,%d,i,name,nnvp,nvp,pos,textValue,value
- ;
- s fieldName=$tr(fieldName,".","_")
- s listName=$tr(listName,".","_")
- i 0
- e  d
- . s escape=+$g(escape)
- . s pos=""
- . f  s pos=$o(^%zewdSession("session",sessid,"ewd_list",listName,pos)) q:pos=""  d
- . . k %d,textValue,codeValue,codeValueEsc,textValueEsc
- . . s %d=^%zewdSession("session",sessid,"ewd_list",listName,pos)
- . . s textValue=$p(%d,$c(1),1)
- . . ;
- . . s textValueEsc=textValue
- . . s textValueEsc=$$replaceAll(textValueEsc,"&#39;","'")
- . . i escape s textValueEsc=$$zcvt(textValue,"o","HTML")
- . . ;
- . . s codeValue=$p(%d,$c(1),2)
- . . i codeValue="" s codeValue=textValue
- . . s codeValueEsc=codeValue
- . . s codeValueEsc=$$replaceAll(codeValueEsc,"&#39;","'")
- . . i escape s codeValueEsc=$$zcvt(codeValue,"o","HTML")
- . . w "<option value='"_codeValueEsc_"'"
- . . i $e(fieldName,1)'="$" d
- . . . n fn
- . . . s fn=$tr(fieldName,"_",".")
- . . . i $$getSessionValue(fn,sessid)=codeValue w " selected='selected'" q
- . . . i $d(^%zewdSession("session",sessid,"ewd_selected",fieldName,codeValue)) w " selected='selected'" q
- . . i $e(fieldName,1)="$" d
- . . . n fieldValue
- . . . s fieldValue=$e(fieldName,2,$l(fieldName))
- . . . s fieldValue=$g(@fieldValue)
- . . . i fieldValue=codeValue w " selected='selected'"
- . . s nnvp=$l(%d,$c(1))
- . . f i=3:1:nnvp d
- . . . s nvp=$p(%d,$c(1),i)
- . . . i nvp="" q
- . . . s name=$p(nvp,$c(3),1)
- . . . s value=$p(nvp,$c(3),2)
- . . . w " "_name_"='"_value_"'"
- . . w ">"_textValueEsc_"</option>"_$c(13,10)
- QUIT
- ;
-displayTextArea(fieldName)
- d displayTextArea^%zewdCompiler13($g(fieldName))
- QUIT
- ;
-mCSPReq2(fields)
- ;
- n i,noOfFields,field,type
- s noOfFields=$l(fields,"`")
- f i=1:1:noOfFields d
- . s field=$p(fields,"`",i)
- . q:field=""
- . s type=$p(field,"|",2)
- . S field=$P(field,"|",1)
- . d mergeCSPRequestToSession(field,type)
- d mergeCSPRequestToSession("ewd_pressed","hidden")
- QUIT
- ;
-mCSPReq(fieldName,type)
- d mergeCSPRequestToSession(fieldName,type)
- QUIT
- ;
-mergeCSPRequestToSession(fieldName,type)
- d mergeCSPRequestToSession^%zewdCompiler16($g(fieldName),$g(type))
- QUIT
- ;
- ; note - textarea data storage can be queried using SQL with the following construct
- ; 
- ; listAttributeFL {type=%Library.String ; sqllisttype=subnode}
- ;
-displayText(textID,reviewMode,sessid)
-	QUIT $$displayText^%zewdCompiler13($g(textID),$g(reviewMode),$g(sessid))
-	;
-systemMessage(text,type,sessid,appName,langCode)
- n textid,fragments,outputText,error,technology,translationMode,typex
- ;
- ;d trace^%zewdAPI("systemMessage : text="_text_" ; type="_type_" ; sessid="_sessid)
- i $g(text)="" QUIT ""
- ; manual API or where sessid not known
- i $g(sessid)="" QUIT $$systemMessage^%zewdCompiler5(text,$g(type),$g(appName),$g(langCode))
- s translationMode=+$$getSessionValue^%zewdAPI("ewd_translationMode",sessid)
- ;d trace^%zewdAPI("ewd_translationMode="_translationMode)
- i 'translationMode QUIT text
- s appName=$$getSessionValue^%zewdAPI("ewd_appName",sessid)
- ;d trace^%zewdAPI("appName="_appName)
- s typex=type ; avoid Cache bug !
- i $$getPhraseIndex^%zewdCompiler5(text)="" QUIT ""
- i '$$isTextPreviouslyFound^%zewdCompiler5(text,appName,"","",.textid,,,type) d
- . s textid=$$addTextToIndex^%zewdCompiler5(text,appName,"","",.fragments,.outputText,typex)
- s error=$$displayText(textid,0,sessid)
- QUIT error
- ;
-errorMessage(text,sessid)
- QUIT $$systemMessage(text,"error",sessid)
- ;
- ; ============================================================================
- ;   User API Methods
- ; ============================================================================
- ;
-isCSPPage(docOID)
- ;
- n docName
- ;
- s docName=$$getDocumentName^%zewdDOM(docOID)
- QUIT $$bypassMode^%zewdCompiler(docName)
- ;
-getSessionValue(name,sessid)
- ;
- n %zt,return,value
- ;
- s name=$$stripSpaces(name)
- s %zt=$zt
- i $g(name)="" QUIT ""
- i $g(sessid)="" QUIT ""
- i name["." d  QUIT value
- . n np,obj,prop
- . i name["_" s name=$p(name,"_",1)_"."_$p(name,"_",2,200)
- . s np=$l(name,".")
- . s obj=$p(name,".",1,np-1)
- . s prop=$p(name,".",np)
- . s value=$$getSessionObject(obj,prop,sessid)
- ;s $zt="extcErr"
- ;i $r(100)<10 i '$$$licensed("DOM",,,,,,,,,,) d setWarning("You do not have a current eXtc License",sessid)
- ;i $$isTemp(name) d  QUIT value
- i $e(name,1,4)="tmp_" d  QUIT value
- . s value=$g(zewdSession(name))
- . i value="",$g(^%zewdSession("session",sessid,"ewd_technology"))="gtm" s value=$g(sessionArray(name))
- QUIT $g(^%zewdSession("session",sessid,name))
- ;
-setWLDSymbol(name,sessid)
- ;
- ;  ------------------------------------------------------
- ;  Duplicate copy for performance: see also %zewdPHP!
- ;  ------------------------------------------------------
- ;
- n wldAppName,wldName,wldSessid,%zzname
- ;
- QUIT:$zv["GT.M"
- QUIT
- ;
-extcErr
- ;
- n mess
- s mess="eXtc does not appear to have been installed or is unavailable in the "_$$namespace()_" namespace where your application is attempting to run.  Your application will be unable to run correctly"
- d setWarning(mess,sessid)
- s $zt=%zt
- QUIT ""
- ;
-valueErr ;
- s $zt=%zt
- QUIT ""
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-exportCustomTags(tagList,filepath)
- QUIT $$exportCustomTags^%zewdCompiler16(.tagList,$g(filepath))
- ;
-exportAllCustomTags(filepath)
- QUIT $$exportAllCustomTags^%zewdCompiler16($g(filepath))
- ;
-importCustomTags(filePath)
- QUIT $$importCustomTags^%zewdForm($g(filePath))
- ;
-setSessionValue(name,value,sessid)
- ;
- s name=$$stripSpaces(name)
- i $g(name)="" QUIT
- i $g(sessid)="" QUIT
- i name["." d  QUIT
- . n np,obj,prop
- . i name["_" s name=$p(name,"_",1)_"."_$p(name,"_",2,200)
- . s np=$l(name,".")
- . s obj=$p(name,".",1,np-1)
- . s prop=$p(name,".",np)
- . d setSessionObject(obj,prop,value,sessid)
- s value=$g(value)
- i $e(name,1,4)="tmp_" s zewdSession(name)=value QUIT
- s ^%zewdSession("session",sessid,name)=value
- QUIT
- ;
-allowJSONAccess(sessionName,access,sessid)
- ; access="r|rw"
- s ^%zewdSession("jsonAccess",sessid,sessionName)=access
- QUIT
- ;
-disallowJSONAccess(sessionName,sessid)
- k ^%zewdSession("jsonAccess",sessid,sessionName)
- QUIT
- ;
-JSONAccess(sessionName,sessid)
- QUIT $g(^%zewdSession("jsonAccess",sessid,sessionName))
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-isTemp(name)
- QUIT $e(name,1,4)="tmp_"
- ;
- ;
-existsInSession(name,sessid)
- QUIT $$existsInSession^%zewdCompiler13($g(name),$g(sessid))
- ;
-existsInSessionArray(name,p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11)
- QUIT $$existsInSessionArray^%zewdCompiler13($g(name),$g(p1),$g(p2),$g(p3),$g(p4),$g(p5),$g(p6),$g(p7),$g(p8),$g(p9),$g(p10),$g(p11))
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-clearSessionArray(arrayName,sessid)
- s arrayName=$$stripSpaces(arrayName)
- i $g(sessid)="" QUIT
- i $g(arrayName)="" QUIT
- s arrayName=$tr(arrayName,".","_")
- ;i $$isTemp(arrayName) k zewdSession(arrayName) QUIT
- i $e(arrayName,1,4)="tmp_" k zewdSession(arrayName) QUIT
- k ^%zewdSession("session",sessid,arrayName)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-setSessionArray(arrayName,itemName,itemValue,sessid)
- ;
- s arrayName=$$stripSpaces(arrayName)
- QUIT:$g(arrayName)=""
- QUIT:$g(itemName)=""
- QUIT:$g(sessid)=""
- s arrayName=$tr(arrayName,".","_")
- i $$isTemp(arrayName) s zewdSession(arrayName,itemName)=itemValue QUIT
- s ^%zewdSession("session",sessid,arrayName,itemName)=itemValue
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-getSessionArray(arrayName,sessid,array,clearArray)
- ;
- s arrayName=$$stripSpaces(arrayName)
- QUIT:$g(arrayName)=""
- s arrayName=$tr(arrayName,".","_")
- QUIT:$g(sessid)=""
- set $zt="getSessionArrayErr"
- i $g(clearArray)=1 k array
- i $$isTemp(arrayName) m array=zewdSession(arrayName) QUIT
- m array=^%zewdSession("session",sessid,arrayName)
- QUIT
- ;
-getSessionArrayErr ; --- Come here if error occurred in 'getSessionArray' ---
- set $zt=""
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-addToSession(name,sessid)
- s name=$$stripSpaces(name)
- QUIT:$g(sessid)=""
- QUIT:$g(name)=""
- s name=$tr(name,".","_")
- i $$isTemp(name) m zewdSession(name)=@name QUIT
- m ^%zewdSession("session",sessid,name)=@name
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-mergeToSession(name,sessid)
- QUIT:$g(sessid)=""
- QUIT:$g(name)=""
- d addToSession(name,sessid)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-mergeGlobalToSession(globalName,sessionName,sessid)
- d mergeGlobalToSession^%zewdCompiler13($g(globalName),$g(sessionName),$g(sessid))
- QUIT
- ;
-mergeGlobalFromSession(globalName,sessionName,sessid)
- d mergeGlobalFromSession^%zewdCompiler13($g(globalName),$g(sessionName),$g(sessid))
- QUIT
- ;
-mergeArrayToSession(array,sessionName,sessid)
- QUIT:$g(sessid)=""
- QUIT:$g(sessionName)=""
- s sessionName=$tr(sessionName,".","_")
- ;i $$isTemp(sessionName) m zewdSession(sessionName)=array QUIT
- i $e(sessionName,1,4)="tmp_" m zewdSession(sessionName)=array QUIT
- m ^%zewdSession("session",sessid,sessionName)=array
- QUIT
- ;
-mergeArrayToSessionObject(array,sessionName,sessid)
- d mergeArrayToSessionObject^%zewdCompiler16(.array,$g(sessionName),$g(sessid))
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-mergeArrayFromSession(array,sessionName,sessid)
- QUIT:$g(sessid)=""
- QUIT:$g(sessionName)=""
- s sessionName=$tr(sessionName,".","_")
- ;i $$isTemp(sessionName) m array=zewdSession(sessionName) QUIT
- i $e(sessionName,1,4)="tmp_" m array=zewdSession(sessionName) QUIT
- m array=^%zewdSession("session",sessid,sessionName)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-mergeFromSession(name,sessid)
- QUIT:$g(sessid)=""
- QUIT:$g(name)=""
- s name=$tr(name,".","_")
- i $$isTemp(name) m @name=zewdSession(name)
- m @name=^%zewdSession("session",sessid,name)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-deleteFromSession(name,sessid)
- QUIT:$g(sessid)=""
- QUIT:$g(name)=""
- i name["." d  QUIT
- . n np,obj,prop
- . s np=$l(name,".")
- . s obj=$p(name,".",1,np-1)
- . s prop=$p(name,".",np)
- . d deleteFromSessionObject(obj,prop,sessid)
- ;i $$isTemp(name) k zewdSession(name) QUIT
- i $e(name,1,4)="tmp_" k zewdSession(name) QUIT
- k ^%zewdSession("session",sessid,name)
- QUIT
- ;
-sessionNameExists(name,sessid)
- QUIT:$g(sessid)=""
- QUIT:$g(name)=""
- s name=$tr(name,".","_")
- i $$isTemp(name) QUIT $d(zewdSession(name))
- QUIT $d(^%zewdSession("session",sessid,name))
- ;
-getSessionArrayValue(arrayName,subscript,sessid,exists)
- QUIT $$getSessionArrayValue^%zewdCompiler13($g(arrayName),$g(subscript),$g(sessid),.exists)
- ;
-sessionArrayValueExists(arrayName,subscript,sessid)
- QUIT $$sessionArrayValueExists^%zewdCompiler13($g(arrayName),$g(subscript),$g(sessid))
- ;
-deleteSessionArrayValue(arrayName,subscript,sessid)
- d deleteSessionArrayValue^%zewdCompiler13($g(arrayName),$g(subscript),$g(sessid))
- QUIT
- ;
- ; Objects
- ;
-setSessionObject(objectName,propertyName,propertyValue,sessid)
- ;d setSessionObject^%zewdCompiler13($g(objectName),$g(propertyName),$g(propertyValue),$g(sessid))
- ;QUIT
-	;
-	n comma,i,np,p,sessionArray,x
-	;
-	i $g(objectName)="" QUIT
-	i $g(propertyName)="" QUIT
-	;i $g(propertyValue)="" QUIT
-	i $g(sessid)="" QUIT
-    s np=$l(objectName,".")
-    ;s objectName=$$replace(objectName,".","_")
-    i objectName["." s objectName=$p(objectName,".",1)_"_"_$p(objectName,".",2,2000)
-    i np=1 d  QUIT
-	. i $e(objectName,1,3)="tmp" s zewdSession(objectName_"_"_propertyName)=propertyValue  q
-	. s ^%zewdSession("session",sessid,(objectName_"_"_propertyName))=propertyValue
-    ;
-    f i=1:1:np-1 s p(i)=$p(objectName,".",i)
-    s comma=","
-    i $e(objectName,1,4)="tmp_" d
-    . s x="s zewdSession(",comma=""
-	e  d
-    . s x="s ^%zewdSession(""session"","_sessid
-    f i=1:1:np-1 s x=x_comma_""""_p(i)_"""",comma=","
-    s x=x_","""_propertyName_""")="""_propertyValue_""""
-    x x
-    QUIT
- ;
-getSessionObject(objectName,propertyName,sessid)
-    ;
-    n i,np,p,value,x
-    ;
-    i $g(sessid)="" QUIT ""
-    s value=""
-    s np=$l(objectName,".")
-    i objectName[".",objectName'["_" s objectName=$p(objectName,".",1)_"_"_$p(objectName,".",2,2000)
-    ;s objectName=$$replace(objectName,".","_")
-    i np=1 QUIT $g(^%zewdSession("session",sessid,(objectName_"_"_propertyName)))
-    ;
-    f i=1:1:np-1 s p(i)=$p(objectName,".",i)
-    s x="s value=$g(^%zewdSession(""session"","_sessid
-    f i=1:1:np-1 s x=x_","""_p(i)_""""
-    s x=x_","""_propertyName_"""))"
-    x x
-    QUIT value
-    ;
-deleteFromSessionObject(objectName,propertyName,sessid)
- d deleteFromSessionObject^%zewdCompiler13($g(objectName),$g(propertyName),$g(sessid))
- QUIT
- ;
-sessionObjectPropertyExists(objectName,propertyName,sessid)
- QUIT $$sessionObjectPropertyExists^%zewdCompiler13($g(objectName),$g(propertyName),$g(sessid))
- ;
-deleteSessionObject(objectName,sessid)
- n obj
- s obj=objectName
- i obj["." s obj=$tr(obj,".","_")
- i obj'["_" s obj=obj_"_"
- d clearSessionByPrefix(obj,$g(sessid))
- ;d deleteSessionObject^%zewdCompiler13($g(objectName),$g(sessid))
- QUIT
- ;
-copyObjectToSession(oref,objectName,sessid)
- d copyObjectToSession^%zewdCompiler13($g(oref),$g(objectName),$g(sessid))
- QUIT
- ;
-copyResultSetToSession(oref,objectName,sessid)
- d copyResultSetToSession^%zewdCompiler13($g(oref),$g(objectName),$g(sessid))
- QUIT
- ;
-getResultSetValue(resultSetName,index,propertyName,sessid)
- QUIT $$getResultSetValue^%zewdCompiler13($g(resultSetName),$g(index),$g(propertyName),$g(sessid))
- ;
-addToResultSet(sessionName,propertyName,value,sessid)
- d addToResultSet^%zewdCompiler13($g(sessionName),$g(propertyName),$g(value),$g(sessid))
- QUIT
- ;
-mergeRecordArrayToResultSet(sessionName,recordArray,sessid)
- d mergeRecordArrayToResultSet^%zewdCompiler13($g(sessionName),.recordArray,$g(sessid))
- QUIT
- ;
-JSONToSessionObject(objectName,jsonString,sessid)
- d JSONToSessionObject^%zewdCompiler13($g(objectName),$g(jsonString),$g(sessid))
- QUIT
- ;
-sessionObjectToJSON(objectName,sessid)
- QUIT $$sessionObjectToJSON^%zewdCompiler13($g(objectName),$g(sessid))
- ;
-objectGlobalToJSON(objectName)
- QUIT $$objectGlobalToJSON^%zewdCompiler13($g(objectName))
- ;
-saveJSON(objectName,jsonString)
- QUIT $$saveJSON^%zewdCompiler13($g(objectName),$g(jsonString))
- ;
-getJSON(objectName,addRefCol)
- QUIT $$getJSON^%zewdCompiler13($g(objectName),$g(addRefCol))
- ;
-setJSONValue(JSONName,objectName,sessid)
- d setJSONValue^%zewdCompiler16($g(JSONName),$g(objectName),$g(sessid))
- d allowJSONAccess(objectName,"r",sessid)
- QUIT
- ;
-convertToJSON(arrayName,isExtJS)
- n dojo
- i '$d(@arrayName) QUIT ""
- s dojo=""
- i $g(isExtJS)=1 s dojo=2
- QUIT $$walkArray^%zewdCompiler13("",arrayName,dojo)
- ;
-mergeToJSObject(sessionObject,JSObject)
- QUIT $$mergeToJSObject^%zewdCompiler13($g(sessionObject),$g(JSObject),$g(sessid))
- ;
- ; Javascript objects
- ;
-getJavascriptObjectBlock(objectName,docName,textArray)
- QUIT $$getJavascriptObjectBlock^%zewdCompiler13($g(objectName),$g(docName),.textArray)
- ;
-replaceJavascriptObject(objectName,newFunctionText,docName)
- QUIT $$replaceJavascriptObject^%zewdCompiler13($g(objectName),$g(newFunctionText),$g(docName))
- ;
-replaceJavascriptObjectBody(functionName,newBody,docName)
- QUIT $$replaceJavascriptObjectBody^%zewdCompiler13($g(functionName),$g(newBody),$g(docName))
- ;
-getJavascriptObjectBody(functionName,docName)
- QUIT $$getJavascriptObjectBody^%zewdCompiler13($g(functionName),$g(docName))
- ;
-getJavascriptObject(objectName,docName,eOID)
- QUIT $$getJavascriptObject^%zewdCompiler13($g(objectName),$g(docName),$g(eOID))
- ;
-javascriptObjectExists(objectName,docName)
- QUIT $$javascriptObjectExists^%zewdCompiler13($g(objectName),$g(docName))
- ;
-getLastJavascriptTag(docName,textArray)
- QUIT $$getLastJavascriptTag^%zewdCompiler13($g(docName),.textArray)
- ;
-addJavascriptObject(docName,jsText)
- QUIT $$addJavascriptObject^%zewdCompiler13($g(docName),.jsText)
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-setSessionValues(nvArray,sessid)
- ;
- QUIT:$g(sessid)=""
- n name,no,value
- s name=""
- f  s name=$o(nvArray(name)) q:name=""  d
- . d deleteFromSession(name,sessid)
- . d clearSelected(name,sessid)
- . s value=$g(nvArray(name))
- . d setSessionValue(name,value,sessid)
- . s no=""
- . f  s no=$o(nvArray(name,no)) q:no=""  d
- . . s value=nvArray(name,no)
- . . d addToSelected(name,value,sessid)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-getSessionValues(prefix,nvArray,sessid)
- ;
- n len,name,no,value
- QUIT:$g(sessid)=""
- QUIT:$g(prefix)=""
- set $zt="getSessionValuesErr"
- s len=$l(prefix)
- k nvArray
- s name=prefix
- f  s name=$o(^%zewdSession("session",sessid,name)) q:name=""  q:$e(name,1,len)'=prefix  d
- . d setNVArray(name,.nvArray,sessid)
- s name=prefix,no=0
- f  s name=$o(^%zewdSession("session",sessid,"ewd_selected",name)) q:name=""  q:$e(name,1,len)'=prefix  d
- . s value=""
- . f  s value=$o(^%zewdSession("session",sessid,"ewd_selected",name,value)) q:value=""  d
- . . s no=no+1
- . . s nvArray(name,no)=value
- QUIT
- ;
-getSessionValuesErr ; --- Come here if error occurred in 'getSessionValues' ---
- set $zt=""
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-getSessionValuesByPrefix(prefix,sessid)
- ;
- n len,name
- QUIT:$g(sessid)=""
- QUIT:$g(prefix)=""
- s prefix=$tr(prefix,".","_")
- set $zt="getSessionValuesByPrefixErr"
- s len=$l(prefix)
- s name=prefix
- f  s name=$o(^%zewdSession("session",sessid,name)) q:name=""  q:$e(name,1,len)'=prefix  d
- . i name?1A.AN m @name=^%zewdSession("session",sessid,name)
- QUIT
- ;
-getSessionValuesByPrefixErr
- set $zt=""
- QUIT
- ;
-setNVArray(name,nvArray,sessid)
- n selected,value,no
- s nvArray(name)=$$getSessionValue(name,sessid)
- QUIT
- ;
-clearSessionByPrefix(prefix,sessid)
- ;
- n len,name
- QUIT:$g(sessid)=""
- QUIT:$g(prefix)=""
- s prefix=$tr(prefix,".","_")
- s len=$l(prefix)
- ;
- s name=prefix
- f  s name=$o(^%zewdSession("session",sessid,name)) q:name=""  q:$e(name,1,len)'=prefix  d
- . i $e(name,1,4)="ewd_" q
- . d deleteFromSession(name,sessid) 
- s name=prefix
- f  s name=$o(^%zewdSession("session",sessid,"ewd_selected",name)) q:name=""  q:$e(name,1,len)'=prefix  d
- . d clearSelected(name,sessid)
- s name=prefix
- f  s name=$o(^%zewdSession("session",sessid,"ewd_list",name)) q:name=""  q:$e(name,1,len)'=prefix  d
- . d clearList(name,sessid)
- s name=prefix
- f  s name=$o(^%zewdSession("session",sessid,"ewd_textarea",name)) q:name=""  q:$e(name,1,len)'=prefix  d
- . d clearTextArea(name,sessid)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
- ; HTML Form-specific APIs
- ;
-getTextValue(fieldName,sessid)
- QUIT $$getSessionValue(fieldName,sessid)
- ;
-setTextValue(fieldName,value,sessid)
- d setSessionValue(fieldName,value,sessid)
- QUIT
- ;
-getPasswordValue(fieldName,sessid)
- QUIT $$getSessionValue(fieldName,sessid)
- ;
-getHiddenValue(fieldName,sessid)
- QUIT $$getSessionValue(fieldName,sessid)
- ;
-setHiddenValue(fieldName,value,sessid)
- d setSessionValue(fieldName,value,sessid)
- ;
-getRadioValue(fieldName,sessid)
- QUIT $$getSessionValue(fieldName,sessid)
- ;
-setRadioOn(fieldName,value,sessid)
- d setSessionValue(fieldName,value,sessid)
- QUIT
- ;
-isRadionOn(fieldName,value,sessid)
- QUIT $$getRadioValue(fieldName,sessid)=value
- ;
-isCheckboxOn(fieldName,value,sessid)
- QUIT $$isSelected(fieldName,value,sessid)
- ;
-getCheckboxValues(fieldName,selectedValueArray,sessid)
- d mergeFromSelected(fieldName,.selectedValueArray,sessid)
- QUIT
- ;
-initialiseCheckbox(fieldName,sessid)
- d clearSelected(fieldName,sessid)
- QUIT
- ;
-setCheckboxOn(fieldName,value,sessid)
- d addToSelected(fieldName,value,sessid)
- QUIT
- ;
-setCheckboxOff(fieldName,value,sessid)
- d removeFromSelected(fieldName,value,sessid)
- ;
-setCheckboxValues(fieldName,selectedValueArray,sessid)
- ;
- ; array format : array(checkboxValue)=checkboxValue
- ; eg selected("red")="red"
- ;
- d mergeToSelected(fieldName,.selectedValueArray,sessid)
- QUIT
- ;
-getSelectValue(fieldName,sessid,nullify)
- ;
- n value
- ;
- s value=$$getSessionValue(fieldName,sessid)
- i $a(value)=160 s value=""
- QUIT value
- ;
-setSelectValue(fieldName,value,sessid)
- d setSessionValue(fieldName,value,sessid)
- ;
-isSelectOn(fieldName,value,sessid)
- QUIT $$getSelectValue(fieldName,sessid)=value
- ;
-isMultipleSelectOn(fieldName,value,sessid)
- QUIT $$isSelected(fieldName,value,sessid)
- ;
-getMultipleSelectValues(fieldName,selectedValueArray,sessid)
- d mergeFromSelected(fieldName,.selectedValueArray,sessid)
- QUIT
- ;
-initialiseMultipleSelect(fieldName,sessid)
- d clearSelected(fieldName,sessid)
- QUIT
- ;
-setMultipleSelectOn(fieldName,value,sessid)
- d addToSelected(fieldName,value,sessid)
- QUIT
- ;
-setMultipleSelectOff(fieldName,value,sessid)
- d removeFromSelected(fieldName,value,sessid)
- ;
-setMultipleSelectValues(fieldName,selectedValueArray,sessid)
- ;
- ; array format : array(checkboxValue)=checkboxValue
- ; eg selected("red")="red"
- ;
- d mergeToSelected(fieldName,.selectedValueArray,sessid)
- QUIT
- ;
-getTextArea(fieldName,textArray,sessid)
- d mergeFromTextArea(fieldName,.textArray,sessid)
- QUIT
- ;
-setFieldError(fieldName,sessid)
- ;
- n errors
- s errors(fieldName)=$$getSessionValue("ewd_errorClass",sessid)
- d mergeArrayToSession^%zewdAPI(.errors,"ewd_errorFields",sessid)
- d setSessionValue^%zewdAPI("ewd_hasErrors",1,sessid)
- QUIT
- ;
-setErrorClasses()
- QUIT $$setErrorClasses^%zewdUtilities()
- ;
-getRequestValue(fieldName,sessid)
- set $zt="getRequestValueErr"
- s sessid=$g(sessid)
- i $g(fieldName)="" QUIT ""
- QUIT $g(requestArray(fieldName))
- ;
-getRequestValueErr
- set $zt=""
- QUIT ""
- ;
-mergeFromRequest(array,fieldName,sessid)
- QUIT:fieldName=""
- m array=requestArray(fieldName)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-copyRequestValueToSession(fieldName,sessid)
- ;
- QUIT:$g(sessid)=""
- QUIT:$g(fieldName)=""
- i $$isTemp(fieldName) m zewdSession(fieldName)=requestArray(fieldName)
- m ^%zewdSession("session",sessid,fieldName)=requestArray(fieldName)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-getCookieValue(cookieName,sessid)
- QUIT:$g(cookieName)=""
- set $zt="getCookieValueErr"
- QUIT $g(requestArray(cookieName))
- ;
-getCookieValueErr ; --- Come here if error occurred in 'getCookieValue' ---
- set $zt=""
- QUIT ""
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-deleteCookie(cookieName,sessid)
- d setCookieValue(cookieName,"",-3600,sessid)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-convertDaysToSeconds(days)
- QUIT days*86400
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-parseHTMLFile(filepath,docName)
- QUIT $$parseHTMLFile^%zewdCompiler16($g(filepath),$g(docName))
- ;
-parseXMLFile(filepath,docName)
- QUIT $$parseXMLFile^%zewdCompiler16($g(filepath),$g(docName))
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-parseStream(streamName,docName,error,isHTML)
- d parseStream^%zewdCompiler16($g(streamName),$g(docName),.error,$g(isHTML))
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-parseHTMLStream(streamName,docName)
- QUIT $$parseHTMLStream^%zewdCompiler16($g(streamName),$g(docName))
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-parseURL(server,getPath,docName,port,isHTML,responseTime,browserType,post)
- ;
- QUIT $$parseURL^%zewdHTMLParser($g(server),$g(getPath),$g(docName),$g(port),$g(isHTML),.responseTime,$g(browserType),$g(post))
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-setCookieValue(cookieName,value,expiryDuration,sessid)
- ;
- ; expiryDuration is no of seconds
- ;
- n expires
- s expires=expiryDuration
- i $$isCSP(sessid) d
- . s expires=$$convertDateToSeconds($h)+expires
- . s expires=$$convertSecondsToDate(expires)
- . s expires=$$inetDate(expires)
- s value=value_$c(1)_expires
- d setSessionArray("ewd_cookie",cookieName,value,sessid)
- ;
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-setResponseHeader(headerName,headerValue,sessid)
- d setSessionArray^%zewdAPI("ewd_header",$g(headerName),$g(headerValue),$g(sessid))
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-suppressResponseHeader(headerName,sessid)
- i $$isCSP(sessid) d setResponseHeader(headerName,"",sessid)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-addServerToSession(sessid,serverArray)
- d addServerToSession^%zewdCompiler13($g(sessid),.serverArray)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-getServerValue(serverFieldName,sessid)
- ;
- s sessid=$g(sessid)
- set $zt="getServerValueErr"
- s $zt="g "_$zt
- i $g(serverFieldName)="" QUIT ""
- ;
- s $zt=""
- QUIT $g(serverArray(serverFieldName))
- ;
-getServerValueErr ; --- Come here if error occurred in 'getServerValue' ---
- set $zt=""
- QUIT ""
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-deleteWarning(sessid)
- QUIT:$g(sessid)=""
- d deleteFromSession("ewd_warning",sessid)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-setWarning(warningMessage,sessid)
- QUIT:$g(sessid)=""
- QUIT:$g(warningMessage)=""
- s warningMessage=$$systemMessage(warningMessage,"warning",sessid)
- i '$$isCSP(sessid) s warningMessage=$$zcvt(warningMessage,"o","JS")
- d setSessionValue("ewd_warning",warningMessage,sessid)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-clearAllSelected(sessid)
- k ^%zewdSession("session",sessid,"ewd_selected")
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-clearSelected(fieldName,sessid)
- QUIT:$g(fieldName)=""
- QUIT:$g(sessid)=""
- s fieldName=$tr(fieldName,".","_")
- k ^%zewdSession("session",sessid,"ewd_selected",fieldName)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-addToSelected(fieldName,fieldValue,sessid)
- ;
- n shortFieldValue
- QUIT:$g(fieldName)=""
- QUIT:$g(sessid)=""
- QUIT:$g(fieldValue)=""
- s fieldName=$tr(fieldName,".","_")
- s shortFieldValue=$e(fieldValue,1,200)
- s ^%zewdSession("session",sessid,"ewd_selected",fieldName,shortFieldValue)=fieldValue
- QUIT
- ;
-removeFromSelected(fieldName,fieldValue,sessid)
- ;
- n shortFieldValue
- QUIT:$g(fieldName)=""
- QUIT:$g(sessid)=""
- QUIT:$g(fieldValue)=""
- s fieldName=$tr(fieldName,".","_")
- s shortFieldValue=$e(fieldValue,1,200)
- k ^%zewdSession("session",sessid,"ewd_selected",fieldName,shortFieldValue)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-mergeFromSelected(fieldName,selected,sessid)
- ;
- k selected
- s fieldName=$tr(fieldName,".","_")
- m selected=^%zewdSession("session",sessid,"ewd_selected",fieldName)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-mergeToSelected(fieldName,selected,sessid)
- ;
- s fieldName=$tr(fieldName,".","_")
- ;
- k ^%zewdSession("session",sessid,"ewd_selected",fieldName)
- m ^%zewdSession("session",sessid,"ewd_selected",fieldName)=selected
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-isSelected(fieldName,fieldValue,sessid)
- n shortFieldValue
- i $g(fieldName)="" QUIT 0
- i $g(sessid)="" QUIT 0
- i $g(fieldValue)="" QUIT 0
- s fieldName=$tr(fieldName,".","_")
- set $zt="isSelectedErr"
- s shortFieldValue=$e(fieldValue,1,200)
- QUIT $d(^%zewdSession("session",sessid,"ewd_selected",fieldName,shortFieldValue))
- ;
-isSelectedErr ; --- Come here if error occurred in 'isSelected' ---
- set $zt=""
- QUIT 0
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-clearTextArea(fieldName,sessid)
- QUIT:$g(fieldName)=""
- QUIT:$g(sessid)=""
- s fieldName=$tr(fieldName,".","_")
- k ^%zewdSession("session",sessid,"ewd_textarea",fieldName)
- s ^%zewdSession("session",sessid,"ewd_textarea",fieldName,1)=""
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-createTextArea(fieldName,textArray,sessid)
- ;
- QUIT:$g(fieldName)=""
- QUIT:$g(sessid)=""
- s fieldName=$tr(fieldName,".","_")
- m ^%zewdSession("session",sessid,"ewd_textarea",fieldName)=textArray
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-mergeTextAreaFromRequest(fieldName,requestArray,sessid)
- ;
- q:$g(sessid)=""
- s fieldName=$tr(fieldName,".","_")
- ;
- q:'$d(^%zewdSession("session",sessid,"ewd_textarea",fieldName))
- d clearTextArea(fieldName,sessid)
- m ^%zewdSession("session",sessid,"ewd_textarea",fieldName)=requestArray(fieldName)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-appendToTextArea(fieldName,lineOfText,sessid)
- ;
- n position
- ;
- QUIT:$g(fieldName)=""
- QUIT:$g(sessid)=""
- s fieldName=$tr(fieldName,".","_")
- ;
- s position=$o(^%zewdSession("session",sessid,"ewd_textarea",fieldName,""),-1)+1
- s ^%zewdSession("session",sessid,"ewd_textarea",fieldName,position)=lineOfText 
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-mergeFromTextArea(fieldName,textArray,sessid)
- ;
- s fieldName=$tr(fieldName,".","_")
- m textArray=^%zewdSession("session",sessid,"ewd_textarea",fieldName)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-mergeToTextArea(fieldName,textArray,sessid)
- ;
- s fieldName=$tr(fieldName,".","_")
- m ^%zewdSession("session",sessid,"ewd_textarea",fieldName)=textArray
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-clearList(listName,sessid)
- QUIT:$g(listName)=""
- QUIT:$g(sessid)=""
- s listName=$tr(listName,".","_")
- k ^%zewdSession("session",sessid,"ewd_list",listName)
- k ^%zewdSession("session",sessid,"ewd_listIndex",listName)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-isListDefined(listName,sessid)
- QUIT $d(^%zewdSession("session",sessid,"ewd_list",listName))
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-countList(listName,sessid)
- QUIT $$countList^%zewdCompiler16($g(listName),$g(sessid))
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-appendToList(listName,textValue,codeValue,sessid,otherAttrs)
- ;
- n position
- ;
- QUIT:$g(listName)=""
- QUIT:$g(sessid)=""
- ;QUIT:$g(textValue)=""
- ;QUIT:$g(codeValue)=""
- s listName=$tr(listName,".","_")
- ;
- s position=$o(^%zewdSession("session",sessid,"ewd_list",listName,""),-1)+1
- d addToList(listName,textValue,codeValue,position,sessid,.otherAttrs)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-addToList(listName,textValue,codeValue,position,sessid,otherAttrs)
- ;d addToList^%zewdCompiler16($g(listName),$g(textValue),$g(codeValue),$g(position),$g(sessid),.otherAttrs)
- ;
- n attrList,attrName
- ;
- QUIT:$g(listName)=""
- QUIT:$g(sessid)=""
- QUIT:$g(position)=""
- i $g(codeValue)="",$g(textValue)="" QUIT
- s position=+position
- d removeFromList(listName,codeValue,sessid) ; just in case
- s attrName="",attrList=""
- f  s attrName=$o(otherAttrs(attrName)) q:attrName=""  d
- . s attrList=attrList_attrName_$c(3)_otherAttrs(attrName)_$c(1)
- ;
- s codeValue=$g(codeValue) i codeValue="" s codeValue=textValue
- s ^%zewdSession("session",sessid,"ewd_list",listName,position)=textValue_$c(1)_codeValue_$c(1)_attrList
- s ^%zewdSession("session",sessid,"ewd_listIndex",listName,codeValue)=position
- k otherAttrs
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-mergeToList(listName,listArray,sessid)
- ;
- d mergeToList^%zewdCompiler7(listName,.listArray,sessid)
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-removeFromList(listName,codeValue,sessid)
- ;
- ;d removeFromList^%zewdCompiler7(listName,codeValue,sessid)
- n position
- ;
- QUIT:$g(listName)=""
- QUIT:$g(sessid)=""
- QUIT:$g(codeValue)=""
- ;
- s position=$g(^%zewdSession("session",sessid,"ewd_listIndex",listName,codeValue))
- QUIT:position=""
- k ^%zewdSession("session",sessid,"ewd_list",listName,position)
- k ^%zewdSession("session",sessid,"ewd_listIndex",listName,codeValue)
- d setWLDSymbol("ewd_list",sessid)
- d setWLDSymbol("ewd_listIndex",sessid)
- QUIT
- ;
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-copyList(fromListName,toListName,sessid)
- ;
- d copyList^%zewdCompiler7($g(fromListName),$g(toListName),$g(sessid))
- QUIT
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-getTextFromList(listName,codeValue,sessid)
- ;
- QUIT $$getTextFromList^%zewdCompiler7(listName,codeValue,sessid)
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-replaceOptionsByFieldName(formName,fieldName,listName,sessid)
- ;
- QUIT $$replaceOptionsByFieldName^%zewdCompiler7(formName,fieldName,listName,sessid)
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
-replaceOptionsByID(fieldID,listName,sessid)
- ;
- QUIT $$replaceOptionsByID^%zewdCompiler7(fieldID,listName,sessid)
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-getUploadedFileName(fieldName,sessid)
- ;
- n filename,technology
- s technology=$$getSessionValue^%zewdAPI("ewd_technology",sessid)
- QUIT 0
- ;
-getUploadedFileNameErr
- set $zt=""
- QUIT ""
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-getUploadedFileSize(fieldName,sessid)
- ;
- set $zt="getUploadedFileSizeErr"
- QUIT 0
- ;
-getUploadedFileSizeErr ;
- set $zt=""
- QUIT ""
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-getUploadedFileType(fieldName,sessid)
- ;
- set $zt="getUploadedFileTypeErr"
- QUIT 0
- ;
-getUploadedFileTypeErr
- set $zt=""
- QUIT ""
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-errorOccurred(sessid)
- ;
- n warning
- ;
- i $g(Error)="" QUIT 0
- s warning=$$getSessionValue("ewd_warning",sessid)
- QUIT Error'=warning
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-removeQuotes(string)
- ;
- n quoted,c1,quote
- s quote=""
- s c1=$e(string,1)
- s quoted=0
- i c1=""""!(c1="'") s quoted=1,quote=c1
- i 'quoted QUIT string
- i $e(string,$l(string))'=quote QUIT string
- QUIT $e(string,2,$l(string)-1)
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-escapeQuotes(text)
- ;
- s text=$$replaceAll(text,"'",$c(4))
- s text=$$replaceAll(text,$c(4),"\'")
- s text=$$replaceAll(text,"""",$c(4))
- s text=$$replaceAll(text,$c(4),"\""")
- ;
- QUIT text
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-getAttrValue(attrName,attrValues,technology)
- QUIT $$getAttrValue^%zewdCompiler4(attrName,.attrValues,technology)
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-replaceAll(InText,FromStr,ToStr) ; Replace all occurrences of a substring
- ;
- n %p
- ;
- s %p=InText
- i ToStr[FromStr d  QUIT %p
- . n i,stop,tempText,tempTo
- . s stop=0
- . f i=0:1:255 d  q:stop
- . . q:InText[$c(i)
- . . q:FromStr[$c(i)
- . . q:ToStr[$c(i)
- . . s stop=1
- . s tempTo=$c(i)
- . s tempText=$$replaceAll(InText,FromStr,tempTo)
- . s %p=$$replaceAll(tempText,tempTo,ToStr)
- f  q:%p'[FromStr  S %p=$$replace(%p,FromStr,ToStr)
- QUIT %p
- ;
-replace(InText,FromStr,ToStr) ; replace old with new in string
- ;
- n %p1,%p2
- ;
- i InText'[FromStr q InText
- s %p1=$p(InText,FromStr,1),%p2=$p(InText,FromStr,2,255)
- QUIT %p1_ToStr_%p2
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-addImmediateOneOffTask(executeCode,startTime,namespace,rc,rm)
- QUIT $$addImmediateOneOffTask^%zewdScheduler($g(executeCode),$g(startTime),$g(namespace),.rc,.rm)
- ;
- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ;
-getDataTypeErrors(errorArray,sessid)
- k errorArray
- d mergeArrayFromSession(.errorArray,"ewd_DataTypeError",sessid)
- QUIT
- ;
-clearSchemaFormErrors(sessid)
- d deleteFromSession("ewd_SchemaFormError",sessid)
- QUIT
- ;
-getSchemaFormErrors(errorArray,sessid)
- QUIT $$getSchemaFormErrors^%zewdCompiler13(.errorArray,$g(sessid))
- ;
-setSchemaFormErrors(errorArray,sessid)
- ;
- n sessionName
- ;
- s sessionName="ewd_SchemaFormError"
- d deleteFromSession(sessionName,sessid)
- d mergeArrayToSession(.errorArray,sessionName,sessid)
- QUIT
- ;
-removeInstanceDocument(instanceName)
- ;
- n ok
- s ok=$$openDOM
- i ok'="" QUIT ok 
- s ok=$$removeDocument^%zewdDOM(instanceName,"","")
- d clearXMLIndex^%zewdSchemaForm(instanceName)
- s ok=$$closeDOM^%zewdDOM()
- QUIT ""
- ;
- ;
-makeTokenString(length)
- ;
- n string,token,i
- ;
- s string="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890"
- s token=""
- f i=1:1:length s token=token_$e(string,($r($l(string))+1))
- QUIT token
- ;
-makeString(%char,%len) ; create a string of len characters
- ;
- n %str
- ;
- s %str="",$p(%str,%char,%len+1)=""
- QUIT %str
- ;
-convertDateToSeconds(hdate)
- ;
- Q (hdate*86400)+$p(hdate,",",2)
- ;
-convertSecondsToDate(secs)
- ;
- QUIT (secs\86400)_","_(secs#86400)
- ;
-getTokenExpiry(token)
- ;
- n sessid
- ;
- i $g(token)="" QUIT 0
- s sessid=+$g(^%zewdSession("tokens",token))
- i sessid="" QUIT 0
- QUIT $$getSessionValue("ewd_sessionExpiry",sessid)
- ;
-isTokenExpired(token)
- ;
- ;QUIT $$getTokenExpiry(token)'>$$convertDateToSeconds($h)
- QUIT $$getTokenExpiry(token)'>(($h*86400)+$p($h,",",2))
- ;
-randChar()
- ;
- n string
- ;
- s string="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890"
- QUIT $e(string,($R($l(string))+1))
- ;
-lowerCase(string)
- QUIT $tr(string,"ABCDEFGHIJKLMNOPQRSTUVQXYZ","abcdefghijklmnopqrstuvwxyz")
- ;
-stripSpaces(string)
- s string=$$stripLeadingSpaces(string)
- QUIT $$stripTrailingSpaces(string)
- ;
-stripLeadingSpaces(string)
- n i
- ;
- f i=1:1:$l(string) QUIT:$e(string,i)'=" "
- QUIT $e(string,i,$l(string))
- ;
-stripTrailingSpaces(string)
- n i,spaces,new
- ;
- s spaces=$$makeString(" ",100)
- s new=string_spaces
- QUIT $p(new,spaces,1)
- ;
-parseMethod(methodString,class,method)
- ;
- n %p1,%p2,meth
- ;
- s %p1=$p(methodString,"##class(",2)
- s class=$p(%p1,")",1)
- s %p2=$p(%p1,")",2,500)
- s method=$p(%p2,".",2)
- s method=$p(method,"(",1)
- QUIT
- ;
-event(requestArray)
- QUIT $$event^%zewdPHP(.requestArray)
- ;
-clearURLNVP(urlNo)
- ;
- QUIT
- ;
-setURLNVP(urlNo,name)
- ;
- QUIT
- ;
-decodeDataType(name,dataType,sessid)
- ;
- n value,inputMethod,x,decodedValue
- ;
- q:$g(name)=""
- q:$g(dataType)=""
- s value=$$getSessionValue(name,sessid)
- s inputMethod=$$getInputMethod^%zewdCompiler(dataType)
- q:inputMethod=""
- s x="s decodedValue=$$"_inputMethod_"("""_value_""",sessid)"
- x x
- d setSessionValue(name,decodedValue,sessid)
- QUIT
- ;
-encodeDataType(name,dataType,sessid)
- QUIT $$encodeDataType^%zewdCompiler13($g(name),$g(dataType),$g(sessid))
- ;
-copyURLNVPsToSession(urlNo)
- ;
- n name
- ;
- QUIT
- ;
-doubleQuotes(string)
- ;
- s string=$$replaceAll(string,"""",$c(1,1))
- s string=$tr(string,$c(1),"""")
- QUIT string
- ;
- ;  ==========================================================================
- ;     Error Trap Functions
- ;  ==========================================================================
- ;
-copySessionToSymbolTable(sessid)
- d copySessionToSymbolTable^%zewdCompiler16($g(sessid))
- QUIT
- ;
-saveSymbolTable(sessid)
- ;
- n ok
- ;s sessid=0
- k ^%zewdError(sessid)
- n %zzv
- k ^%zewdError(sessid)
- s %zzv="%"
- f  s %zzv=$o(@%zzv) Q:%zzv=""  m ^%zewdError(sessid,%zzv)=@%zzv
- QUIT
- ;
-recoverSymbolTable(sessid,web)
- n (sessid,web)
- n %zzv
- s %zzv=""
- f  s %zzv=$o(^%zewdError(sessid,%zzv)) QUIT:%zzv=""  d
- . m @%zzv=^%zewdError(sessid,%zzv)
- d writeSymbolTable(web)
- QUIT
- ;
-writeSymbolTable(web)
- i $g(web) w "<pre>"
- zwrite
- i $g(web) w "</pre>"
- QUIT 
- ;
-loadErrorSymbols(sessid)
- d loadErrorSymbols^%zewdCompiler19($g(sessid))
- QUIT
- ;
-deleteErrorLog(sessid)
- k ^%zewdError(sessid)
- QUIT
- ;
-deleteAllErrorLogs
- k ^%zewdError
- QUIT
- ;
-fileSize(path)
- QUIT $$fileSize^%zewdCompiler13($g(path))
- ;
-fileExists(path)
- QUIT $$fileExists^%zewdCompiler13($g(path))
- ;
-fileInfo(path,info)
- d fileInfo^%zewdCompiler13($g(path),.info)
- QUIT
- ;
-directoryExists(path)
- QUIT $$directoryExists^%zewdCompiler13($g(path))
- ;
-deleteFile(filepath)
- QUIT $$deleteFile^%zewdCompiler13($g(filepath))
- ;
-renameFile(filepath,newpath)
- QUIT $$renameFile^%zewdCompiler13($g(filepath),$g(newpath))
- ;
-createDirectory(path)
- QUIT $$createDirectory^%zewdCompiler13($g(path))
- ;
-removeCR(string)
- i $e(string,$l(string))=$c(13) s string=$e(string,1,$l(string)-1)
- QUIT string
- ;
-setApplicationRootPath(path)
- d setApplicationRootPath^%zewdCompiler(path)
- QUIT
- ;
-applicationRootPath()
- QUIT $$applicationRootPath^%zewdCompiler()
- ;
-getApplicationRootPath()
- QUIT $$getApplicationRootPath^%zewdCompiler()
- ;
-setOutputRootPath(path,technology)
- d setOutputRootPath^%zewdCompiler(path,technology)
- QUIT
- ;
-getRootURL(technology)
- QUIT $$getRootURL^%zewdCompiler(technology)
- ;
-setRootURL(cspURL,technology)
- d setRootURL^%zewdCompiler(cspURL,technology)
- QUIT
- ;
-getDefaultTechnology()
- QUIT $$getDefaultTechnology^%zewdCompiler()
- ;
-getDefaultMultiLingual()
- QUIT $$getDefaultMultiLingual^%zewdCompiler()
- ;
-getOutputRootPath(technology)
- QUIT $$getOutputRootPath^%zewdCompiler(technology)
- ;
-getJSScriptsPath(app,technology)
- QUIT $$getJSScriptsPath^%zewdCompiler8(app,technology)
- ;
-getJSScriptsPathMode(technology)
- QUIT $$getJSScriptsPathMode^%zewdCompiler8(technology)
-	;
-setJSScriptsPathMode(technology,mode)
- d setJSScriptsPathMode^%zewdCompiler8(technology,mode)
- QUIT
-	;
-getJSScriptsRootPath(technology)
- QUIT $$getJSScriptsRootPath^%zewdCompiler8(technology)
-	;
-setJSScriptsRootPath(technology,path)
- d setJSScriptsRootPath^%zewdCompiler8(technology,path)
- QUIT
- ;
-getHomePage()
- QUIT $$getHomePage^%zewdCompiler()
- ;
-setHomePage(homePage)
- d setHomePage^%zewdCompiler($g(homePage))
- QUIT
- ;
-getApplications(appList)
- QUIT $$getApplications^%zewdCompiler16(.appList)
- ;
-getPages(application,pageList)
- QUIT $$getPages^%zewdCompiler16($g(application),.pageList)
- ;
-getDefaultFormat()
- QUIT $$getDefaultFormat^%zewdCompiler()
- ;
-getNextChild(parentOID,childOID)
- i $g(parentOID)="" QUIT ""
- i childOID="" QUIT $$getFirstChild^%zewdDOM(parentOID)
- QUIT $$getNextSibling^%zewdDOM(childOID)
- ;
-addCSPServerScript(parentOID,text)
- QUIT $$addCSPServerScript^%zewdCompiler4(parentOID,text)
- ;
-createPHPCommand(data,docOID)
- QUIT $$createPHPCommand^%zewdCompiler4(data,docOID)
- ;
-createJSPCommand(data,docOID)
- QUIT $$createJSPCommand^%zewdCompiler4(data,docOID)
- ;
-instantiateJSPVar(var,type,docOID,arraySize,initialValue)
- d instantiateJSPVar^%zewdCompiler4(var,type,docOID,arraySize,initialValue)
- QUIT
- ;
-removeIntermediateNode(inOID)
- d removeIntermediateNode^%zewdCompiler4(inOID)
- QUIT
- ;
-getNormalisedAttributeValue(attrName,nodeOID,technology)
- QUIT $$getNormalAttributeValue^%zewdCompiler($g(attrName),$g(nodeOID),$g(technology))
- ;
-getNormalAttributeValue(attrName,nodeOID,technology)
- QUIT $$getNormalAttributeValue^%zewdCompiler($g(attrName),$g(nodeOID),$g(technology))
- ;
-getTagOID(tagName,docName,lowerCase)
- QUIT $$getTagOID^%zewdCompiler($g(tagName),$g(docName),$g(lowerCase))
- ;
-getTagByNameAndAttr(tagName,attrName,attrValue,matchCase,docName)
- QUIT $$getTagByNameAndAttr^%zewdCompiler3($g(tagName),$g(attrName),$g(attrValue),$g(matchCase),$g(docName))
- ;
-javascriptFunctionExists(functionName,docName)
- QUIT $$javascriptFunctionExists^%zewdCompiler7($g(functionName),$g(docName))
- ;
-addJavascriptFunction(docName,jsTextArray)
- QUIT $$addJavascriptFunction^%zewdCompiler7($g(docName),.jsTextArray)
- ;
-getJavascriptFunctionBody(functionName,docName)
- QUIT $$getJavascriptFunctionBody^%zewdCompiler7($g(functionName),docName)
- ;
-replaceJavascriptFunctionBody(functionName,jsText,docName)
- QUIT $$replaceJavascriptFunctionBody^%zewdCompiler7($g(functionName),$g(jsText),$g(docName))
- ;
-getDelim()
- QUIT $$getDelim^%zewdCompiler()
- ;
- ; ===========================================================================
- ;    WLD conversion utilities
- ; ===========================================================================
- ;
-configureWebLink(webserver,mode,alias,path)
- QUIT $$configure^%zewdWLD($g(webserver),$g(mode),$g(alias),$g(path))
- ;
-mergeListToSession(fieldName,sessid)
- d mergeListToSession^%zewdCompiler16($g(fieldName),$g(sessid))
- QUIT
- ;
-getPREVPAGE(sessid) ;
- QUIT $$getPREVPAGE^%zewdCompiler19($g(sessid)) ;
- ;
-copyToWLDSymbolTable(sessid)
- d copyToWLDSymbolTable^%zewdCompiler16($g(sessid))
- ;
-getPRESSED(sessid)
- QUIT $$getSessionValue("ewd_pressed",sessid)
- ;
-copyToLIST(listName,sessid)
- ;
- k LIST(listName)
- m LIST(listName)=^%zewdSession("session",sessid,"ewd_list",listName)
- QUIT
- ;
-copyToSELECTED(fieldName,sessid)
- ;
- k SELECTED(fieldName)
- m SELECTED(fieldName)=^%zewdSession("session",sessid,"ewd_selected",fieldName)
- QUIT
- ;
-traceModeOn
- s ^zewd("trace")=1
- QUIT
- ;
-traceModeOff
- k ^zewd("trace")
- QUIT
- ;
-getTraceMode()
- i $g(^zewd("trace"))=1 QUIT 1
- QUIT 0
- ;
-trace(text,clear) ; trace  ;
- n i
- s text=$g(text)
- i $g(clear)=1 k ^%zewdTrace
- s i=$increment(^%zewdTrace)
- s ^%zewdTrace(i)=text
- QUIT
- ;
-inetDate(hdate) ; Decode $H date and time to Internet format
- ;
- N %d,%day,%time,%date
- ;
- S %time=$P(hdate,",",2)
- I %time>86400 D
- .S %time=%time-86400
- .S hdate=(hdate+1)_","_%time
- ;
- S %d="Thu,Fri,Sat,Sun,Mon,Tue,Wed"
- S %day=(hdate#7)+1
- S %day=$P(%d,",",%day)
- ;
- S %date=$$decDate(hdate)
- ;S %date=$TR(%date," ","-")
- S %time=$$inetTime(hdate)
- S %date=%day_", "_%date_" "_%time
- Q %date
-decDate(hdate) ; Decode a date from $H format
- ;
- n %yy,%mm,%dd,%d1,%d
- i $zv'["GT.M" d
- . s %d1=$zd(hdate,5)
- . s %yy=$p(%d1,", ",2)
- . s %dd=+$p(%d1," ",2) I %dd<10 S %dd="0"_%dd
- . s %mm=$p(%d1," ",1)
- e  d
- . n p1,p2
- . s %d1=$zd(hdate,2) 
- . s %dd=$p(%d1,"-",1)
- . s %mm=$p(%d1,"-",2)
- . s p1=$e(%mm,1),p2=$e(%mm,2,$l(%mm))
- . s %mm=p1_$$lowerCase(p2)
- . s %yy=$p(%d1,"-",3)
- . i hdate>58073 s %yy="20"_%yy
- s %d=%dd_" "_%mm_" "_%yy
- QUIT %d
- ;
-inetTime(hdate) ; Decode Internet Format Time from $H format
- ; Offset is relative to GMT, eg -0500
- ;
- n hh,mm,ss,time
- s time=$p(hdate,",",2)
- s hh=time\3600 i hh<10 s hh="0"_hh
- s time=time#3600
- s mm=time\60 i mm<10 s mm="0"_mm
- s ss=time#60 i ss<10 s ss="0"_ss
- QUIT hh_":"_mm_":"_ss
- ;
-openNewFile(filepath)
- QUIT $$openNewFile^%zewdCompiler($g(filepath))
- ;
-openFile(filepath)
- QUIT $$openFile^%zewdCompiler($g(filepath))
- ;
-openDOM()
- ;
- n i,ok
- ;
- f i=1:1:20 s ok=$$openDOM^%zewdDOM(0,,,,,,,,,,,,,,,,,) q:$$zcvt(ok,"l")["licensing violation"  q:ok=""  h 1
- i ok'="" s ok="No eXtc Licenses available!"
- QUIT ok
- ;
-removeChild(nodeOID,removeFromDOM)
- ;
- n ver
- ;
- s ver="" 
- QUIT $$removeChild^%zewdDOM(nodeOID,$g(removeFromDOM))
- ;
-removeAttribute(attrName,nodeOID,removeFromDOM)
- ;
- n ver
- ;
- s ver="" 
- d removeAttribute^%zewdDOM(attrName,nodeOID,$g(removeFromDOM)) QUIT
- ;
-removeAttributeNS(ns,attrName,nodeOID,removeFromDOM)
- ;
- n ver
- ;
- s ver="" 
- d removeAttributeNS^%zewdDOM(ns,attrName,nodeOID,$g(removeFromDOM)) QUIT
- ;
-removeIntermediateNodeeXtc(nodeOID,removeFromDOM)
- ;
- n ver
- ;
- d removeIntermediateNode^%zewdDOM(nodeOID,$g(removeFromDOM))
- QUIT
- ;
-export(fileName,prefix,extension)
- d export^%zewdCompiler16($g(fileName),$g(prefix),$g(extension))
- QUIT
- ;
-import(fileName)
- ;
- i $g(fileName)="" s fileName="zewd.xml"
- QUIT
- ;
-listDOMsByPrefix(prefix)
-	d listDOMsByPrefix^%zewdCompiler19($g(prefix))
-	QUIT
- ;
-removeDOMsByPrefix(prefix)
-	d removeDOMsByPrefix^%zewdCompiler19($g(prefix))
-	QUIT
-	;
-dumpDOM(docName)
- ;
- d dumpDOM^%zewdCompiler20($g(docName))
- QUIT
- ;
-namespace()
- QUIT $zdir
- ;
-setNamespace(namespace)
- s $zdir=namespace
- QUIT
- ;
-zcvt(string,param,param2)
- ;
- i $g(param)="" s param="l"
- i param="l"!(param="L") QUIT $tr(string,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
- i param="u"!(param="U") QUIT $tr(string,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- QUIT string
- ;
-getIP() ; Get own IP address
- ;
- n ip,ipInfo
- ;
- QUIT $g(ip)
- ;
-ajaxErrorRedirect(sessid)
- ;
- n errorPage
- ;
- s errorPage=$$getSessionValue^%zewdAPI("ewd.errorPage",sessid)
- d setRedirect^%zewdAPI(errorPage,sessid)
- ;
- QUIT ""
- ;
-classExport(className,methods,filepath)
- ;
- QUIT $$classExport^%zewdCompiler16($g(className),.methods,$g(filepath))
- ;
-strx(string)
- n i,c,a,ok
- f i=1:1:$l(string) s c=$e(string,i),a=$a(c) w i_": "_c_" : "_a,! r ok
- QUIT
- ;
-disableEwdMgr
- s ^%zewd("disabled")=1
- QUIT
- ;
-enableEwdMgr
- k ^%zewd("disabled")
- QUIT
- ;
-enableWLDAccess(app,page)
- i $g(^zewd("allowWLDAccess",$$zcvt(app,"l"),$$zcvt(page,"l")))'=1 s ^zewd("allowWLDAccess",$$zcvt(app,"l"),$$zcvt(page,"l"))=1
- QUIT
- ;
-disableWLDAccess(app,page)
- k ^zewd("allowWLDAccess",$$zcvt(app,"l"),$$zcvt(page,"l"))
- QUIT
-isSSOValid(sso,username,password,sessid)
- QUIT $$isSSOValid^%zewdMgrAjax2($g(sso),$g(username),$g(password),$g(sessid))
- ;
-uniqueId(nodeOID,filename)
- QUIT $p(filename,".ewd",1)_$p(nodeOID,"-",2)
- ;
-exportToGTM(routine)
Index: ePrescribing/trunk/p/_zewdCompiler13.m
===================================================================
--- ePrescribing/trunk/p/_zewdCompiler13.m	(revision 518)
+++ 	(revision )
@@ -1,1164 +1,0 @@
-%zewdCompiler13	; Enterprise Web Developer Compiler Functions
- ;
- ; Product: Enterprise Web Developer version 4.0.755
- ; Build Date: Thu, 12 Feb 2009 09:53:12
- ; 
- ; ----------------------------------------------------------------------------
- ; | Enterprise Web Developer for GT.M and m_apache                           |
- ; | Copyright (c) 2004-9 M/Gateway Developments Ltd,                         |
- ; | Reigate, Surrey UK.                                                      |
- ; | All rights reserved.                                                     |
- ; |                                                                          |
- ; | http://www.mgateway.com                                                  |
- ; | Email: rtweed@mgateway.com                                               |
- ; |                                                                          |
- ; | This program is free software: you can redistribute it and/or modify     |
- ; | it under the terms of the GNU Affero General Public License as           |
- ; | published by the Free Software Foundation, either version 3 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 Affero General Public License for more details.                      |
- ; |                                                                          |
- ; | You should have received a copy of the GNU Affero General Public License |
- ; | along with this program.  If not, see <http://www.gnu.org/licenses/>.    |
- ; ----------------------------------------------------------------------------
- ;
- QUIT
- ;
- ;
-ifArrayExists(nodeOID,attrValues,docOID,technology)
-	;
-	; <ewd:ifArrayExists arrayName="$myArray" param1="xxx" param2="$yyy" param3="#zzz">
-	;
-	n arrayName,comma,param,subs,pval
-	set arrayName=$$getAttrValue^%zewdAPI("arrayname",.attrValues,technology)
-	s param="param",subs="",comma=""
-	f  s param=$o(attrValues(param)) q:param=""  q:param'["param"  d
-	. s pval=attrValues(param)
-	. d
-	. . s pval=$$replaceAll^%zewdHTMLParser(pval,"""","&quot;")
-	. . s subs=subs_comma_pval,comma=","
-	d
-	. ;
-	. n cwOID,attr
-	. ;
-	. s cwOID=$$addIntermediateNode^%zewdCompiler4("csp:if",nodeOID)
-	. ;
-	. ; <csp:if condition="$d(%ewdVar(&quote;ewdTabMenu&quote;,&quote;5&quote;))">
-	. ; 
-	. s arrayName=$$removeQuotes^%zewdAPI(arrayName)
-	. i arrayName="" s arrayName="%ewdVar"
-	. i subs="" s attr="$d("_arrayName_")"
-	. e  s attr="$d("_arrayName_"("_subs_"))"
-	. d setAttribute^%zewdDOM("condition",attr,cwOID)
-	;
-	d removeIntermediateNode^%zewdCompiler4(nodeOID)
-	;
-	QUIT
-	;
-url(nodeOID,attrValues,docOID,technology)
-	;
-	; <ewd:url return="$fullUrl" url="$url" />
-	;
-	n return,url
-	;
-	set url=$$getAttrValue^%zewdAPI("url",.attrValues,technology)
-	set return=$$getAttrValue^%zewdAPI("return",.attrValues,technology)
-	;
-	d
-	. n page,serverOID,text
-	. s page=url,text=""
-	. s url=$$getRootURL^%zewdCompiler("gtm")_app_"/"_url_".mgwsi?"
-	. s url=url_"ewd_token=""_$g(^%zewdSession(""session"",sessid,""ewd_token""))_""&n=""_tokens("_$tr(page,"'","")_")"
-	. s text=text_" s "_return_"="""_url
-	. s serverOID=$$addCSPServerScript^%zewdCompiler4(nodeOID,text)
-	;
-	d removeIntermediateNode^%zewdCompiler4(nodeOID)
-	;
-	QUIT
-	;
-tabMenuOption(nodeOID,attrValues,docOID,technology)
-	;
-	; <ewd:tabMenuOption position="1" text="Configuration" nextpage="config" defaultSelected="true" help="This is some help" greyIf="grey^%zewdMgr">
-	;
-	n attr,decOID,defaultSelected,docName,greyIf,help,newOID,nextpage
-	n position,text,value
-	;
-	set position=$$getAttrValue^%zewdAPI("position",.attrValues,technology)
-	s position=$$removeQuotes^%zewdAPI(position)
-	set text=$$getAttrValue^%zewdAPI("text",.attrValues,technology)
-	s text=$$removeQuotes^%zewdAPI(text)
-	set nextpage=$$getAttrValue^%zewdAPI("nextpage",.attrValues,technology)
-	s nextpage=$$removeQuotes^%zewdAPI(nextpage)
-	set defaultSelected=$$getAttrValue^%zewdAPI("defaultselected",.attrValues,technology)
-	s defaultSelected=$$removeQuotes^%zewdAPI(defaultSelected)
-	set help=$$getAttrValue^%zewdAPI("help",.attrValues,technology)
-	s help=$$removeQuotes^%zewdAPI(help)
-	set greyIf=$$getAttrValue^%zewdAPI("greyif",.attrValues,technology)
-	s greyIf=$$removeQuotes^%zewdAPI(greyIf)
-	; 
-	; Map to
-	; <ewd:setArrayValue arrayName="ewdTabMenu" param1="1" value="$menuInfo">
-	; and place just after <body> tag
-	; 
-	s docName=$$getDocumentName^%zewdDOM(docOID)
-	s value=text_"|"_nextpage_"|"_defaultSelected_"|"_help_"|"_greyIf
-	s newOID=$$getFirstElementByTagName^%zewdDOM("ewd:tabmenuarray",docName,"")
-	i $$getParentNode^%zewdDOM(newOID)="" s newOID=""
-	i newOID="" d
-	. n parentOID,xOID
-	. s parentOID=$$getFirstElementByTagName^%zewdDOM("head",docName,"")
-	. s newOID=$$getFirstElementByTagName^%zewdDOM("ewd:new","",parentOID)
-	. i newOID="" d
-	. . s newOID=$$addNewFirstChild^%zewdCompiler4("ewd:tabmenuarray",docOID,parentOID)
-	. e  d
-	. . n fcOID,nextOID,tagOID
-	. . s nextOID=$$getNextSibling^%zewdDOM(newOID)
-	. . s tagOID=$$createElement^%zewdDOM("ewd:tabmenuarray",docOID)
- 	. . s newOID=$$insertBefore^%zewdDOM(tagOID,nextOID)
-	s attr("arrayname")="$ewdTabMenu"
-	s attr("param1")=position
-	s attr("value")=value
-	s decOID=$$addElementToDOM^%zewdDOM("ewd:setarrayvalue",newOID,,.attr,"")
-	;
-	i nextpage'="" d
-	. d
-	. . n phpString
-	. . s phpString=" s tokens("""_nextpage_""")=$$setNextPageToken^%zewdCompiler20("""_nextpage_""")"
-	. . d addVBHeaderPreCache^%zewdCompiler8(phpString) 
-	;
-	; $tokens['run'] = setNextPageToken('run', $ewd_session) ;
-	d removeIntermediateNode^%zewdCompiler4(nodeOID)
-	;
-	QUIT
-	;
-xhtml(nodeOID,attrValues,docOID,technology)
-	;
-	n dtOID,fcOID,htmlOID
-	;
-	s dtOID=$$createDocumentType^%zewdDOM("html","-//W3C//DTD XHTML 1.0 Strict//EN","http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd",docOID)
-	;<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
-	s dtOID=$$insertBefore^%zewdDOM(dtOID,nodeOID)
-	;<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
-	s fcOID=$$getFirstChild^%zewdDOM(nodeOID)
-	s htmlOID=$$insertNewIntermediateElement^%zewdDOM(nodeOID,"html",docOID)
-	d setAttribute^%zewdDOM("xmlns","http://www.w3.org/1999/xhtml",htmlOID)
-	d setAttribute^%zewdDOM("xml:lang","en",htmlOID)
-	do removeIntermediateNode^%zewdDOM(nodeOID)
-	QUIT
-	;
-getSessionArrayValue(arrayName,subscript,sessid,exists)
-	;
-	n value
-	;
-	i $g(subscript)="" QUIT ""
-	i $g(arrayName)="" QUIT ""
-	;
-	s arrayName=$tr(arrayName,".","_")
-	s exists=1
-	i $$isTemp^%zewdAPI(arrayName) d  QUIT $g(value)
-	. m value=zewdSession(arrayName,subscript)
-	. i '$d(value) s exists=0
-	m value=^%zewdSession("session",sessid,arrayName,subscript)
-	i '$d(value) s exists=0
-	QUIT $g(value)
- ;
-sessionArrayValueExists(arrayName,subscript,sessid)
- ;
- n exists,value
- ;
- s value=$$getSessionArrayValue(arrayName,subscript,sessid,.exists)
- QUIT exists
- ;
-deleteSessionArrayValue(arrayName,subscript,sessid)
-	;
-	i $g(subscript)="" QUIT ""
-	i $g(arrayName)="" QUIT ""
-	s arrayName=$tr(arrayName,".","_")
-	;
-	i $$isTemp^%zewdAPI(arrayName) k zewdSession(arrayName,subscript) QUIT
-	k ^%zewdSession("session",sessid,arrayName,subscript)
-	d setWLDSymbol^%zewdAPI(arrayName,sessid)
-	QUIT
- ;
-setSessionObject(objectName,propertyName,propertyValue,sessid)
-	;
-	n comma,i,np,p,sessionArray,x
-	;
-	i $g(objectName)="" QUIT
-	i $g(propertyName)="" QUIT
-	;i $g(propertyValue)="" QUIT
-	i $g(sessid)="" QUIT
-    s np=$l(objectName,".")
-    s objectName=$$replace^%zewdAPI(objectName,".","_")
-    i np=1 d  QUIT
-	. i $$isTemp^%zewdAPI(objectName) s zewdSession(objectName_"_"_propertyName)=propertyValue  q
-	. s ^%zewdSession("session",sessid,(objectName_"_"_propertyName))=propertyValue
-    ;
-    f i=1:1:np-1 s p(i)=$p(objectName,".",i)
-    s comma=","
-    i $$isTemp^%zewdAPI(objectName) d
-    . s x="s zewdSession(",comma=""
-	e  d
-    . s x="s ^%zewdSession(""session"","_sessid
-    f i=1:1:np-1 s x=x_comma_""""_p(i)_"""",comma=","
-    s x=x_","""_propertyName_""")="""_propertyValue_""""
-    x x
-    QUIT
-	;
-deleteFromSessionObject(objectName,propertyName,sessid)
-	;
-	d deleteSessionArrayValue(objectName,propertyName,sessid)
-	QUIT
-	;
-sessionObjectPropertyExists(objectName,propertyName,sessid)
-	QUIT $$sessionArrayValueExists(objectName,propertyName,sessid)
-	;
-deleteSessionObject(objectName,sessid)
-	d deleteFromSession^%zewdAPI(objectName,sessid)
-	QUIT
-	;
-	;
-countResultSetRecords(sessionName,sessid)
-	i $$isTemp^%zewdAPI(sessionName) QUIT $o(zewdSession(sessionName,""),-1)
-	QUIT $o(^%zewdSession("session",sessid,sessionName,""),-1)
-	;
-addToResultSet(sessionName,propertyName,value,sessid)
-	;
-	n array,recNo
-	;
-	s recNo=$$countResultSetRecords(sessionName,sessid)+1
-	s array(recNo,propertyName)=value
-	d mergeArrayToSession^%zewdAPI(.array,sessionName,sessid)
-	QUIT
-	;
-mergeRecordArrayToResultSet(sessionName,array,sessid)
-	;
-	n recArray,recNo
-	;
-	s recNo=$$countResultSetRecords(sessionName,sessid)+1
-	m recArray(recNo)=array
-	d mergeArrayToSession^%zewdAPI(.recArray,sessionName,sessid)
-	QUIT
-	;
-getResultSetValue(resultSetName,index,propertyName,sessid)
-	;
-	n exists,value
-	;
-	i $g(resultSetName)="" QUIT ""
-	i $g(index)="" QUIT ""
-	i $g(propertyName)="" QUIT ""
-	i $g(sessid)="" QUIT ""
-	;
-	i $$isTemp^%zewdAPI(resultSetName) d  QUIT $g(value)
-	. m value=zewdSession(resultSetName,index,propertyName)
-	. i '$d(value) s exists=0
-	m value=^%zewdSession("session",sessid,resultSetName,index,propertyName)
-	i '$d(value) s exists=0
-	QUIT $g(value)
-	;
-saveJSON(objectName,jsonString)
- i objectName="ewd" QUIT "alert(""Invalid request"")"
- i $$JSONAccess^%zewdAPI(objectName,sessid)'="rw" QUIT "alert(""Invalid request"")"
- i jsonString["\""" s jsonString=$$replaceAll^%zewdAPI(jsonString,"\""","""")
- i jsonString["\'" s jsonString=$$replaceAll^%zewdAPI(jsonString,"\'","""")
- d JSONToSessionObject(objectName,jsonString,sessid)
- QUIT ""
- ;
-getJSON(objectName,addRefCol)
- i objectName="ewd" QUIT "alert(""Invalid request"")"
- ;d trace^%zewdAPI("*** sessid="_sessid_"; JSONAccess="_$$JSONAccess^%zewdAPI(objectName,sessid))
- i $$JSONAccess^%zewdAPI(objectName,sessid)="" QUIT "alert(""Invalid request"")"
- QUIT $$sessionObjectToJSON($g(objectName),sessid,$g(addRefCol))
- ;
-JSONToSessionObject(objectName,jsonString,sessid) ;
- ;
- n array,obj,prop
- ;
- ;d parseJSON(jsonString,.array)
- d parseJSON^%zewdCompiler19(jsonString,.array)
- d deleteSessionObject^%zewdAPI(objectName,sessid)
- d mergeArrayToSessionObject^%zewdAPI(.array,objectName,sessid)
- ;s prop=""
- ;f  s prop=$o(array(prop)) q:prop=""  d
- ;. s obj=objectName_"."_prop
- ;. d trace^%zewdAPI("obj="_obj_"; "_$g(array(prop)))
- ;. d setSessionValue^%zewdAPI(obj,$g(array(prop)),sessid)
- ;;d deleteFromSession^%zewdAPI(objectName,sessid)
- ;;d mergeArrayToSession^%zewdAPI(.array,objectName,sessid)
- QUIT
- ;
-parseJSON(jsonString,propertiesArray)
- ;
- n c,i,len,name,processing,started,type,value
- ;
- k propertiesArray
- s jsonString=$g(jsonString)
- s started=0
- s processing=""
- s name="",value="",type=""
- s len=$l(jsonString)
- ;
- f i=1:1:len d
- . s c=$e(jsonString,i)
- . i 'started,c="{" s started=1,processing="name" q
- . i processing="",c="""" s processing="name",name="" q
- . i processing="",c=":" s processing="value",value="",type="" q
- . i processing="name" d  q
- . . i c=",",name="" q
- . . i c="""" s processing="" q
- . . i c=":" s processing="value" q
- . . s name=name_c
- . i processing="value" d
- . . i value="" d  q
- . . . i c="""" s type="literal"
- . . . i c?1N s type="number"
- . . . i c="-" s type="number"
- . . . i c="f" s type="boolean"
- . . . i c="t" s type="boolean"
- . . . i c="n" s type="null"
- . . . i c="[" d  q
- . . . . n arr,no,j,val
- . . . . s no=0,val=""
- . . . . f j=i+1:1 d  q:c="]"
- . . . . . s c=$e(jsonString,j)
- . . . . . i c="]" s no=$$saveSubArray(no,.val,.arr) q 
- . . . . . i c="," s no=$$saveSubArray(no,.val,.arr) q
- . . . . . s val=val_c
- . . . . m propertiesArray(name)=arr
- . . . . s i=j,name="",value="",processing="name"
- . . . s value=value_c
- . . ;i c="]" break  s name="",value="",processing="name",i=j q
- . . i type="literal",c="""" s type="literalComplete",value=value_c q
- . . i ((c=",")!(c="}")),type'="literal" d  q
- . . . i type="literalComplete" s value=$e(value,2,$l(value)-1)
- . . . s processing="name"
- . . . s propertiesArray(name)=value
- . . . s name="",value=""
- . . s value=value_c
- QUIT
- ;
-saveSubArray(no,value,arr)
- i $e(value,1)=""""!($e(value,1)="'") s value=$e(value,2,$l(value)-1)
- s no=no+1
- s arr(no)=value
- s value=""
- QUIT no
- ;
-sessionObjectToJSON(objectName,sessid,addRefCol)
- ;
- n object,poropName,sub
- ;
- s sub=objectName_"_"
- i $$isTemp^%zewdAPI(objectName) d
- . f  s sub=$o(zewdSession(sub)) q:sub=""  q:sub'[(objectName_"_")  d
- . . s propName=$p(sub,(objectName_"_"),2)
- . . m object(propName)=zewdSession(sub)
- . i '$d(object) m object=zewdSession(objectName)
- e  d
- . f  s sub=$o(^%zewdSession("session",sessid,sub)) q:sub=""  q:sub'[(objectName_"_")  d
- . . s propName=$p(sub,(objectName_"_"),2)
- . . m object(propName)=^%zewdSession("session",sessid,sub)
- . i '$d(object) m object=^%zewdSession("session",sessid,objectName)
- QUIT $$createJSONString(objectName,.object,,$g(addRefCol))
- ;
-mergeToJSObject(sessionObjRef,JSObjRef,sessid)
- ;
- ; eg sessionObjRef = wld.%User.bridge
- ;    JSObjRef      = EZBRIDGE.Config
- ;
- n i,json,nsub,objName,ref,sessRef
- ;
- s sessRef=$$replace^%zewdAPI(sessionObjRef,".","_")
- s nsub=$l(sessRef,".")
- ;
- s objName=$p(sessionObjRef,".",1)
- i objName="ewd" QUIT "alert(""Invalid request"")"
- i $$JSONAccess^%zewdAPI(objName,sessid)="" QUIT "alert(""Invalid request"")"
- ;
- s ref="",comma=""
- f i=1:1:nsub s ref=ref_comma_""""_$p(sessRef,".",i)_"""",comma=","
- i $$isTemp^%zewdAPI(sessRef) d
- . s ref="m jsArray=zewdSession("_ref_")"
- e  d
- . s ref="m jsArray=^%zewdSession(""session"",sessid,"_ref_")"
- x ref
- s json=$$createJSONString(JSObjRef,.jsArray)
- QUIT json
- ;
-objectGlobalToJSON(objectName)
- ;
- QUIT $g(^zewd("jsObject",objectName))
- ;
-createJSONString(objectName,objectArray,isDojo,addRefCol,directOutput)
- ;
- n comma,dd,json,name,object,type
- ;
- s directOutput=+$g(directOutput)
- s isDojo=$g(isDojo)
- i isDojo=1 s directOutput=0
- i '$d(objectArray) QUIT ""
- s name=""
- s json=""
- i isDojo'=1 d
- . i directOutput w objectName_"=" q
- . s json=objectName_"="
- i $g(addRefCol)=1 d
- . n rowNo
- . s rowNo=""
- . f  s rowNo=$o(objectArray(rowNo)) q:rowNo=""  d
- . . s objectArray(rowNo,0)=rowNo-1
- s json=$$walkArray(json,$name(objectArray),isDojo)
- ;
- ;s json=$e(json,1,$l(json)-1)_"}"
- i isDojo=1 s json="{identifier:'id',"_$e(json,2,$l(json))
- i isDojo'=1 d
- . i directOutput w ";" q
- . s json=json_" ;"
- i $g(^zewd("trace"))=1 d trace^%zewdAPI("json="_json)
- QUIT json
- ;
-walkArray(json,name,dojo,subscripts,isObject,mixed)
- ;
- n arrComma,brace,comma,cr,dd,i,no,numsub,dblquot,quot,ref,sub,subNo,subscripts1,type,valquot,value,xref,zobj
- ;
- s cr=$c(13,10),comma=","
- s mixed=+$g(mixed)
- s (dblquot,valquot)=""""
- s dojo=+$g(dojo)
- i dojo=1 s dblquot="",valquot="'"
- i $g(isObject) d
- . s json=json_"("
- s dd=$d(@name)
- i dd=1!(dd=11) d  i dd=1 QUIT json
- . s value=@name
- . i value'[">" q
- . i dojo=2,value="<mixed>" d  q
- . . i $d(subscripts) q
- . . s mixed=1
- . i dojo=2,$e(value,1)="<",$e(value,$l(value))=">" q
- . i dojo=2 d
- . . s json=json_$p(value,">",1) ;_"("_cr
- . i dojo=2 d
- . . s json=$$walkArray(json,$p(value,">",2),$g(dojo),,1)
- . e  d
- . . s json=$$walkArray(json,value,$g(dojo),,1)
- . ;s json=json_cr_")"
- i 'mixed d
- . s json=json_"{"
- s ref=name_"("
- s no=$o(subscripts(""),-1)
- i no>0 f i=1:1:no d
- . s quot=""""
- . i subscripts(i)?."-"1N.N s quot=""
- . s ref=ref_quot_subscripts(i)_quot_","
- ;i no>0 f i=1:1:no s ref=ref_dblquot_subscripts(i)_dblquot_","
- s ref=ref_"sub)"
- s sub="",numsub=0,subNo=0
- f  s sub=$o(@ref) q:sub=""  d
- . s subscripts(no+1)=sub
- . s subNo=subNo+1
- . i 'mixed,subNo=1,sub?1N.N d
- . . s numsub=1
- . . s json=$e(json,1,$l(json)-1)_"["
- . s dd=$d(@ref)
- . i dd=1 d
- . . ;w ref_"="_@ref,!
- . . s value=@ref 
- . . ;i sub'?1N.N s json=json_dblquot_sub_dblquot_":"
- . . i sub'?1N.N d
- . . . s json=json_sub_":"
- . . s type="literal"
- . . i dojo=2,value[">",value'["?>" d
- . . . i $e(value,$l(value))=">" q
- . . . d
- . . . . s json=json_$p(value,">",1) ;_"("_cr
- . . . s json=$$walkArray(json,$p(value,">",2),$g(dojo),,1)
- . . . s type="object"
- . . . s value=""
- . . i value?1N.N s type="numeric"
- . . i value?1"-"1N.N s type="numeric"
- . . i value?1N.N1"."1N.N s type="numeric"
- . . i value?1"-"1N.N1"."1N.N s type="numeric"
- . . i value="true"!(value="false") s type="boolean"
- . . i $e(value,1)="{",$e(value,$l(value))="}" s type="variable"
- . . i dojo=2,value["<?=",value["?>" d
- . . . s value=$p(value,"<?=",2)
- . . . s value=$p(value,"?>",1)
- . . . s value=$$stripSpaces^%zewdAPI(value)
- . . . s type="variable"
- . . ;i type="literal" s value=""""_value_""""
- . . i type="literal" s value=valquot_value_valquot
- . . i dojo=1,type="numeric" s value=valquot_value_valquot
- . . d
- . . . s json=json_value_","
- . k subscripts1
- . m subscripts1=subscripts
- . i dd>9 d
- . . i sub?1N.N d
- . . . i 'mixed,subNo=1 d
- . . . . s numsub=1
- . . . . s json=$e(json,1,$l(json)-1)_"["
- . . e  d
- . . . ;s json=json_dblquot_sub_dblquot_":"
- . . . i $e(sub,1,4)'="zobj" d
- . . . . s json=json_sub_":"
- . . . i $e(sub,1,4)="zobj" d
- . . . . i $e(json,$l(json))'="," d
- . . . . . s json=$e(json,1,$l(json)-1),zobj=1 ; remove { at end
- . . s json=$$walkArray(json,name,dojo,.subscripts1)
- . . i dojo=1,numsub d
- . . . s json=$e(json,1,$l(json)-1)
- . . . s json=json_",id:'"_sub_"'}"
- . . d
- . . . s json=json_","
- ;
- s json=$e(json,1,$l(json)-1)
- s brace="}"
- i mixed s brace=""
- i $g(isObject) s brace=brace_")"
- i numsub s brace="]"
- i $g(zobj)'=1 d
- . s json=json_brace
- QUIT json ; exit!
- ;
-createRef(name,subscripts)
- ;
- n no,ref
- ;
- s ref=name_"("
- s no=$o(subscripts(""),-1)
- i no>0 f i=1:1:no d
- . s quot=""""
- . i subscripts(i)?."-"1N.N s quot=""
- . s ref=ref_quot_subscripts(i)_quot_","
- s ref=ref_""""")"
- QUIT ref
- ;
-test
- k array
- s array("label")="name"
- s array("items",1,"name")="Fruit"
- s array("items",1,"type")="category"
- s array("items",2,"name")="Cinammon"
- s array("items",2,"type")="category"
- s array("items",2,"children",1,"name")="Cinnamon Lozenge"
- s array("items",2,"children",1,"type")="category"
- s array("items",2,"children",2,"name")="Cinnamon Toast"
- s array("items",2,"children",2,"type")="category"
- s array("items",2,"children",3,"name")="Cinnamon Spread"
- s array("items",2,"children",3,"type")="category"
- s array("items",3,"name")="Apple"
- s array("items",3,"type")="category"
- w $$createJSONString("myTest",.array,1)
- QUIT
- ;
-addJavascriptObject(docName,jsText)
- ;
- n childOID,lastLineNo,line,lineNo,OIDArray,scriptOID,text,textArray,textOID
- ;
- s scriptOID=$$getLastJavascriptTag(docName,.textArray)
- s lastLineNo=$o(textArray(""),-1)
- s lineNo="",text=""
- f  s lineNo=$o(jsText(lineNo)) q:lineNo=""  d
- . i jsText(lineNo)["<?="!(jsText(lineNo)["<%") d
- . . k ^CacheTempEWD($j)
- . . s ^CacheTempEWD($j,1)=jsText(lineNo)
- . . d tokenisePHPVariables^%zewdHTMLParser(.phpVars)
- . . s jsText(lineNo)=^CacheTempEWD($j,1)
- . . k ^CacheTempEWD($j)
- . i $l(text)+$l(jsText(lineNo))<30000 s text=text_jsText(lineNo)_$c(13,10) q
- . s lastLineNo=lastLineNo+1
- . s textArray(lastLineNo)=text
- . s text=jsText(lineNo)_$c(13,10)
- s lastLineNo=lastLineNo+1
- s textArray(lastLineNo)=text
- f  q:$$hasChildNodes^%zewdDOM(scriptOID)="false"  d
- . s childOID=$$getFirstChild^%zewdDOM(scriptOID)
- . s childOID=$$removeChild^%zewdAPI(childOID)
- ;
- s lineNo=""
- f  s lineNo=$o(textArray(lineNo)) q:lineNo=""  d
- . s text=textArray(lineNo)
- . q:text=""
- . s textOID=$$createTextNode^%zewdDOM(text,docOID)
- . s textOID=$$appendChild^%zewdDOM(textOID,scriptOID)
- QUIT scriptOID 
- ;
-getLastJavascriptTag(docName,textArray)
- ;
- n attr,childNodes,eArray,headOID,jsText,language,nodeNo,nodeOID,ntags
- n OIDArray,scriptOID,src,stop,tagName
- ;
- s headOID=$$getTagOID^%zewdAPI("head",docName)
- i headOID="" s headOID=$$addElementToDOM^%zewdDOM("head",docOID,,,,1)
- d getChildrenInOrder^%zewdDOM(headOID,.childNodes)
- s nodeNo="",scriptOID="",stop=0
- f  s nodeNo=$o(childNodes(nodeNo),-1) q:nodeNo=""  d  q:stop
- . s scriptOID=childNodes(nodeNo)
- . s tagName=$$getTagName^%zewdDOM(scriptOID)
- . i tagName'="script" q
- . s language=$$getAttribute^%zewdDOM("language",scriptOID)
- . q:$$zcvt^%zewdAPI(language,"l")'="javascript"
- . s src=$$getAttribute^%zewdDOM("src",scriptOID)
- . q:src'=""
- . s stop=1
- i scriptOID="" d
- . n attr
- . s attr("language")="javascript"
- . set scriptOID=$$addElementToDOM^%zewdDOM("script",headOID,,.attr,"")
- k textArray
- s jsText=$$getElementValueByOID^%zewdDOM(scriptOID,"textArray",1)
- i '$d(textArray) s textArray(1)=jsText
- QUIT scriptOID
- ;
-javascriptObjectExists(objectName,docName)
- ;
- QUIT $$getJavascriptObject(objectName,docName)'=""
- ;
-getJavascriptObject(objectName,docName,eOID) ;
- ;
- n c,comm,dqlvl,eArray,slcomm,language,lc,line,lineNo,lvl
- n mlcomm,ntags,OIDArray,%p1,%p2,pos,refString,sqlvl,stop,stop2,text,textArr
- n textArray
- ;
- s text="",eOID=""
- s refString=objectName_"="
- s ntags=$$getElementsArrayByTagName^%zewdDOM("script",docName,,.eArray)
- s eOID="",stop=0
- f  s eOID=$o(eArray(eOID)) q:eOID=""  d  q:stop
- . s language=$$getAttribute^%zewdDOM("language",eOID)
- . q:$$zcvt^%zewdAPI(language,"l")'["javascript"
- . k textArray
- . s text=$$getElementValueByOID^%zewdDOM(eOID,"textArr",1)
- . i '$d(textArr) s textArr(1)=text
- . s lineNo="",text=""
- . f  s lineNo=$o(textArr(lineNo)) q:lineNo=""  d  q:stop
- . . s stop2=0
- . . s textArr(lineNo)=$$replaceAll^%zewdAPI(textArr(lineNo)," =","=")
- . . i textArr(lineNo)[refString f  d  q:textArr(lineNo)'[refString  q:stop2
- . . . s %p1=$p(textArr(lineNo),refString,1)
- . . . s %p1=$re(%p1)
- . . . s %p1=$p(%p1,$c(10,13),1)
- . . . s %p1=$re(%p1)
- . . . i %p1["//"!(%p1["/*") d  q
- . . . . s textArr(lineNo)=$p(textArr(lineNo),refString,2,1000)
- . . . s stop2=1
- . . q:textArr(lineNo)'[refString
- . . s text=refString_$p(textArr(lineNo),refString,2,1000)
- . . s %p1=$p(text,"{",1),%p2=$p(text,"{",2,1000)
- . . s text=%p1_"{",lvl=1,c="",dqlvl=0,sqlvl=0,slcomm=0,mlcomm=0
- . . f pos=1:1:$l(%p2) d  q:stop
- . . . s lc=c
- . . . s c=$e(%p2,pos)
- . . . i lc="\",c="{" s text=text_c q
- . . . i lc="\",c="}" s text=text_c q
- . . . i lc="\",c="""" s text=text_c q
- . . . i lc="\",c="'" s text=text_c q
- . . . i lc="/",c="/" s slcomm=1,text=text_c q
- . . . i lc="/",c="*" s mlcomm=1,text=text_c q
- . . . i lc="*",c="/" s mlcomm=0,text=text_c q
- . . . i slcomm,c=$c(10) s slcomm=0,text=text_c q
- . . . i c="""",dqlvl=0,'slcomm,'mlcomm s dqlvl=1
- . . . i c="""",dqlvl=1,'slcomm,'mlcomm s dqlvl=0
- . . . i c="'",sqlvl=0,'slcomm,'mlcomm s sqlvl=1
- . . . i c="'",sqlvl=1,'slcomm,'mlcomm s sqlvl=0
- . . . i slcomm!mlcomm s text=text_c q
- . . . i c="{",dqlvl=1 s text=text_c q
- . . . i c="}",dqlvl=1 s text=text_c q
- . . . i c="{",sqlvl=1 s text=text_c q
- . . . i c="}",sqlvl=1 s text=text_c q
- . . . i c="{" s lvl=lvl+1
- . . . i c="}" s lvl=lvl-1 i lvl=0 s stop=1 q
- . . . s text=text_c
- . . s text=text_"}"
- QUIT text
- ;
-getJavascriptObjectBody(functionName,docName)
- ;
- n body,crlf,eOID,jsText,nLines
- ;
- s jsText=$$getJavascriptObject(functionName,docName,.eOID)
- s crlf=$c(13,10)
- s nLines=$l(jsText,crlf)
- s body=$p(jsText,crlf,2,nLines-1)
- QUIT body
- ;
-replaceJavascriptObjectBody(functionName,newBody,docName)
- ;
- n body,call,crlf,eOID,jsText
- ;
- s jsText=$$getJavascriptObject(functionName,docName,.eOID)
- s crlf=$c(13,10)
- s call=$p(jsText,crlf,1)
- s body=call_crlf_newBody_crlf_"   }"
- s ok=$$replaceJavascriptObject(functionName,body,docName)
- QUIT 1
- ;
-replaceJavascriptObject(objectName,newFunctionText,docName)
- ;
- n childOID,eOID,docOID,found,funcText,lineNo,stop,text,textArray,textOID
- ;
- s docOID=$$getDocumentNode^%zewdDOM(docName)
- s found=$$getJavascriptObjectBlock(objectName,docName,.textArray)
- i 'found QUIT 0
- ;
- s funcText=$$getJavascriptObject(objectName,docName,.eOID)
- s lineNo="",stop=0
- f  s lineNo=$o(textArray(lineNo)) q:lineNo=""  d  q:stop
- . s text=textArray(lineNo)
- . i text[funcText s textArray(lineNo)=$$replace^%zewdAPI(text,funcText,newFunctionText),stop=1
- i 'stop QUIT 0
- f  q:$$hasChildNodes^%zewdDOM(eOID)="false"  d
- . s childOID=$$getFirstChild^%zewdDOM(eOID)
- . s childOID=$$removeChild^%zewdAPI(childOID)
- ;
- s lineNo=""
- f  s lineNo=$o(textArray(lineNo)) q:lineNo=""  d
- . s text=textArray(lineNo)
- . s textOID=$$createTextNode^%zewdDOM(text,docOID)
- . s textOID=$$appendChild^%zewdDOM(textOID,eOID)
- QUIT 1
- ;
-getJavascriptObjectBlock(objectName,docName,textArr) ;
- ;
- n eArray,eOID,language,lineNo,ntags,OIDArray,refString,stop,text,textArray
- ;
- s text="",eOID="" k textArr
- s refString=objectName_"="
- s ntags=$$getElementsArrayByTagName^%zewdDOM("script",docName,,.eArray)
- s eOID="",stop=0
- f  s eOID=$o(eArray(eOID)) q:eOID=""  d  q:stop
- . s language=$$getAttribute^%zewdDOM("language",eOID)
- . q:$$zcvt^%zewdAPI(language,"l")'="javascript"
- . s text=$$getElementValueByOID^%zewdDOM(eOID,"textArr",1)
- . i '$d(textArr) s textArr(1)=text
- . s lineNo="",text=""
- . f  s lineNo=$o(textArr(lineNo)) q:lineNo=""  d  q:stop
- . . s textArr(lineNo)=$$replaceAll^%zewdAPI(textArr(lineNo)," =","=")
- . . i textArr(lineNo)[refString s stop=1 q
- QUIT stop
- ;
- ;
-createDirectory(path)
- zsystem "mkdir "_path
- QUIT 1
- ;
-renameFile(filepath,newpath)
- zsystem "mv "_filepath_" "_newpath
- QUIT 1
- ;
-deleteFile(filepath)
- n status
- d gtmDeleteFile
- QUIT status
- ;
-gtmDeleteFile
- s status=1
- o filepath:(readonly:exception="g deleteNotExists") 
- c filepath:DELETE
- QUIT
-deleteNotExists
- s status=0
- QUIT
- ;
-fileExists(path)
- o path:(readonly:exception="g fileNotExists") 
- c path
- QUIT 1
-fileNotExists
- i $p($zs,",",1)=2 QUIT 0
- QUIT 1
- ;
-fileInfo(path,info)
-	d fileInfo^%zewdGTM(path,.info)
-	QUIT
-	;n line,results
-	;k info
-	;i '$$fileExists(path) QUIT
-	;d shellCommand^%zewdGTM("ls -l """_path_"""",.results)
-	;s line=$g(results(1))
-	;s info("date")=$p(line," ",6,7)
-	;s info("size")=$p(line," ",5)
-	;QUIT
- ;
-directoryExists(path)
- n line,temp
- s temp="temp"_$p($h,",",2)_".txt"
- zsystem "test -d "_path_" && echo ""1"">"_temp_" || echo ""0"">"_temp
- o temp:(readonly:exception="g dirFileNotExists") 
- u temp
- r line
- c temp
- s ok=$$deleteFile(temp)
- QUIT line
-dirFileNotExists
- i $p($zs,",",1)=2 QUIT 0
- QUIT 0
- ;
-fileSize(path)
- n line,temp
- i '$$fileExists(path) QUIT 0
- d shellCommand^%zewdGTM("ls -s """_path_"""",.results)
- s line=$g(results(1))
- s line=$$stripLeadingSpaces^%zewdAPI(line)
- s line=$p(line," ",1)
- QUIT +line
- ;
-displayText(textID,reviewMode,sessid)
-	;
-	i $g(textID)="" QUIT ""
-	s reviewMode=+$g(reviewMode)
-	n text,language,phraseType,appName
-	s language=$$getSessionValue^%zewdAPI("ewd_Language",sessid)
-	i $g(language)="" d
-	. n appName
-	. s appName=$$getTextAppName^%zewdCompiler5(textID)
-	. s language=$$getDefaultLanguage^%zewdCompiler5(appName)
-	i '$d(^ewdTranslation("textid",textID)) QUIT "textid "_textID_" : text missing"
-	s text=$g(^ewdTranslation("textid",textID,language))
-	i text="" s text=$g(^ewdTranslation("textid",textID,$$getDefaultLanguage^%zewdCompiler5($$getTextAppName^%zewdCompiler5(textID))))
-	i language="xx" s text=textID_" ("_text_")"
-	i reviewMode d
-	. s text=text_" {textid="_textID_" : "_$g(^ewdTranslation("textid",textID,$$getDefaultLanguage^%zewdCompiler5($$getTextAppName^%zewdCompiler5(textID))))_"}"
-	s phraseType=$$getTextPhraseType^%zewdCompiler5(textID)
-	;d trace^%zewdAPI("phraseType="_phraseType_" ; text="_text)
-	i phraseType'="error" d
-	. s text=$$replaceAll^%zewdAPI(text,"\'","'")
-	. s text=$$replaceAll^%zewdAPI(text,"\""","""")
-	. s text=$$replaceAll^%zewdAPI(text,"'","&#39;")
-	e  d
-	. s text=$$replaceAll^%zewdAPI(text,"'",$c(5))
-	. s text=$$replaceAll^%zewdAPI(text,$c(5),"\'")
-	QUIT text
- ;
-mergeGlobalToSession(globalName,sessionName,sessid)
- s globalName=$$stripSpaces^%zewdAPI(globalName)
- QUIT:$g(sessid)=""
- QUIT:$g(sessionName)=""
- s sessionName=$tr(sessionName,".","_")
- i $$isTemp^%zewdAPI(sessionName) m zewdSession(sessionName)=@globalName QUIT
- m ^%zewdSession("session",sessid,sessionName)=@globalName
- QUIT
- ;
- ;
-mergeGlobalFromSession(globalName,sessionName,sessid)
- ;
- n x
- ;
- s globalName=$$stripSpaces^%zewdAPI(globalName)
- QUIT:$g(sessid)=""
- QUIT:$g(sessionName)=""
- s sessionName=$tr(sessionName,".","_")
- i $$isTemp^%zewdAPI(sessionName) s x="m "_globalName_"=zewdSession(sessionName)" x x QUIT
- s x="m "_globalName_"=^%zewdSession(""session"",sessid,sessionName)" x x
- QUIT
- ;
-createCSSFile(outputPath,mode,verbose,technology) ;
-	;
-	n filePath,label,line,lineNo,no,stop,x
-	;
-	i $d(^zewd("config","jsScriptPath",technology,"outputPath")) d
-	. n dlim
-	. s dlim=$$getDelim^%zewdAPI()
-	. s outputPath=^zewd("config","jsScriptPath",technology,"outputPath")
-	. i $e(outputPath,$l(outputPath))'=dlim s outputPath=outputPath_dlim
-	s filePath=outputPath_"ewd.css"
-	i '$$openNewFile^%zewdCompiler(filePath) QUIT
-	u filePath
-	f label="ewdStyles" d
-	. s stop=0
-	. f lineNo=1:1 d  q:stop
-	. . s x="s line=$t("_label_"+lineNo^%zewdCompiler18)"
-	. . x x
-	. . i line["***END***" s stop=1 q
-	. . i line[";;*php*",technology'="php" q
-	. . i line[";;*csp*",((technology'="csp")!(technology="wl")!(technology="gtm")) q
-	. . i line[";;*jsp*",technology'="jsp" q
-	. . i line[";;*vb.net*",technology'="vb.net" q
-	. . i line["left(up)" d
-	. . . ;   left(up):-4px
-	. . . s line=$$replace^%zewdAPI(line,"(up)","")
-	. . . i mode="collapse" s line=";;   left:0px;"
-	. . i line["left(down)" d
-	. . . ;;   left(down):-33px ;
-	. . . s line=$$replace^%zewdAPI(line,"(down)","")
-	. . . i mode="collapse" s line=";;   left:-25px;"
-	. . s line=$$replace^%zewdHTMLParser(line,"*php*","     ")
-	. . s line=$$replace^%zewdHTMLParser(line,"*csp*","     ")
-	. . s line=$$replace^%zewdHTMLParser(line,"*jsp*","     ")
-	. . s line=$$replace^%zewdHTMLParser(line,"*vb.net*","     ")
-	. . w $p(line,";;",2,250),!
-	c filePath
-	QUIT
- ;
-spinner(nodeOID,attrValues,docOID,technology)
-	;
-	n attr,attrName,elOID,imagePath,increment,max,min,name,onBlur
-	n onDown,onUp,onUpOrDown,size,value,width
-	;
-	s name=$$getAttrValue^%zewdAPI("name",.attrValues,technology)
-	s name=$$removeQuotes^%zewdAPI(name)
-	i name="" s name="spinner"_$p(nodeOID,"-",2)
-	s size=$$getAttrValue^%zewdAPI("size",.attrValues,technology)
-	s size=$$removeQuotes^%zewdAPI(size)
-	i size="" s size=2
-	s width=size*8
-	s value=$$getAttrValue^%zewdAPI("value",.attrValues,technology)
-	s value=$$removeQuotes^%zewdAPI(value)
-	i value="" s value="*"
-	s max=$$getAttrValue^%zewdAPI("max",.attrValues,technology)
-	s max=$$removeQuotes^%zewdAPI(max)
-	i max="" s max="9999999999"	
-	s min=$$getAttrValue^%zewdAPI("min",.attrValues,technology)
-	s min=$$removeQuotes^%zewdAPI(min)
-	i min="" s min="0"
-	s increment=$$getAttrValue^%zewdAPI("increment",.attrValues,technology)
-	s increment=$$removeQuotes^%zewdAPI(increment)
-	i increment="" s increment="100"
-	s imagePath=$$getAttrValue^%zewdAPI("imagepath",.attrValues,technology)
-	s imagePath=$$removeQuotes^%zewdAPI(imagePath)
-	s onUp=$$getAttrValue^%zewdAPI("onup",.attrValues,technology)
-	s onUp=$$removeQuotes^%zewdAPI(onUp)
-	s onDown=$$getAttrValue^%zewdAPI("ondown",.attrValues,technology)
-	s onDown=$$removeQuotes^%zewdAPI(onDown)
-	s onBlur=$$getAttrValue^%zewdAPI("onblur",.attrValues,technology)
-	s onBlur=$$removeQuotes^%zewdAPI(onBlur)
-	s onUpOrDown=$$getAttrValue^%zewdAPI("onupordown",.attrValues,technology)
-	s onUpOrDown=$$removeQuotes^%zewdAPI(onUpOrDown)
-	s attrName=""
-	f  s attrName=$o(attrValues(attrName)) q:attrName=""  d
-	. i "|name|size|value|max|min|increment|onup|ondown|onupordown|"[("|"_attrName_"|") q
-	. s attr(attrName)=$$removeQuotes^%zewdAPI(attrValues(attrName))
-	s attr("type")="text"
-	s attr("name")=name
-	s attr("value")=value
-	s attr("class")="ewdSpinnerText"
-	s attr("style")="width:"_width_"px"
-	s attr("onKeyDown")="EWD.page.spinnerControl(event,'"_name_"',"_min_","_max_")"
-	i onBlur="" d
-	. s attr("onBlur")="EWD.page.spinnerValueCheck(this.value,'"_name_"',"_min_","_max_")"
-	e  d
-	. s attr("onBlur")=onBlur
-	s elOID=$$addElementToDOM^%zewdDOM("input",nodeOID,,.attr)
-	i onUp'="" s attr("onClick")=onUp
-	i onUpOrDown'="" d
-	. i onUp'="" s onUpOrDown=onUp_" ; "_onUpOrDown
-	. s attr("onClick")=onUpOrDown
-	s attr("type")="button"
-	s attr("name")=name_"Up"
-	s attr("tabIndex")="-1"
-	s attr("class")="ewdSpinnerButtonUp"
-	i imagePath'="" s attr("style")="background: url("_imagePath_"spinnerUp.gif) no-repeat;"
-	s attr("onMouseDown")="EWD.page.spinnerKeyDown = true ;EWD.page.incrementSpinner('"_name_"',"_max_","_increment_")"
-	s attr("onMouseUp")="EWD.page.spinnerKeyDown=false"
-	s elOID=$$addElementToDOM^%zewdDOM("input",nodeOID,,.attr)
-	i onDown'="" s attr("onClick")=onDown
-	i onUpOrDown'="" d
-	. i onDown'="" s onUpOrDown=onDown_" ; "_onUpOrDown
-	. s attr("onClick")=onUpOrDown
-	s attr("type")="button"
-	s attr("name")=name_"Down"
-	s attr("tabIndex")="-1"
-	s attr("class")="ewdSpinnerButtonDown"
-	i imagePath'="" s attr("style")="background: url("_imagePath_"spinnerDown.gif) no-repeat;"
-	s attr("onMouseDown")="EWD.page.spinnerKeyDown = true ;EWD.page.decrementSpinner('"_name_"',"_min_","_increment_")"
-	s attr("onMouseUp")="EWD.page.spinnerKeyDown=false"
-	s elOID=$$addElementToDOM^%zewdDOM("input",nodeOID,,.attr)
-	;
-	do removeIntermediateNode^%zewdDOM(nodeOID)
-	;
-	QUIT
-	;
-popups(allArray,docOID,jsOID,nextPageList,urlNameList,technology)
-	;
-	; Process pop-up directives
-	;
-	n attr,eh,ehx,ehy,ehz,event,found,jsName,jsParams,nextPage
-	n nodeOID,nodeType,nvp,properties,props,tagName,url,useCurrentPosition
-	n winHandle,winName
-	;
-	;d getAllNodes^%zewdCompiler(docOID,.allArray)
-	s nodeOID="",found=0
-	f  s nodeOID=$o(allArray(0,nodeOID)) q:nodeOID=""  d
-	. ;
-	. ; popup="eHelpWindow" page="sysConfigHelp" event="OnClick" x=50 y=50 height=400 width=600
-	. ; ewdOpenWindow(url,winName,x,y,height,width,toolbar,location,directories,status,menubar,scrollbars,resizable)
-	. ; toolbar=no,location=no,directories=no,status=no,menubar=no,scrollbars=yes,resizable=yes
-	. ; 
-	. s nodeType=$$getNodeType^%zewdDOM(nodeOID)
-	. i nodeType'=1 q
-	. s winHandle=$$getAttributeValue^%zewdDOM("popup",1,nodeOID)
-	. if winHandle="" quit
-	. s winName=winHandle
-	. i winHandle["[]" d
-	. . n attr,headOID,jsOID,jsText
-	. . s winName=$$getAttributeValue^%zewdDOM("windowname",1,nodeOID)
-	. . s jsOID=$$getTagByNameAndAttr^%zewdAPI("script","id","ewdWinNames",1,docName)
-	. . i jsOID="" d
-	. . . s attr("language")="javascript"
-	. . . s attr("id")="ewdWinNames"
-	. . . s headOID=$$getTagOID^%zewdAPI("head",docName)
-	. . . s jsText=$p(winHandle,"[",1)_" = new Array() ;"
-	. . . s jsOID=$$addElementToDOM^%zewdDOM("script",headOID,,.attr,jsText)
-	. . e  d
-	. . . n refStr,textOID
-	. . . s textOID=$$getFirstChild^%zewdDOM(jsOID)
-	. . . s jsText=$$getData^%zewdDOM(textOID)
-	. . . s refStr=$p(winHandle,"[",1)_" = new Array() ;"
-	. . . i jsText'[refStr s jsText=jsText_$c(13,10)_refStr
-	. . . s textOID=$$modifyTextData^%zewdDOM(jsText,textOID)
-	. ;
-	. s found=1
-	. s event=$$zcvt^%zewdAPI($$getAttributeValue^%zewdDOM("event",1,nodeOID),"L")
-	. i event="" set event="onclick"
-	. s nextPage=$$getAttributeValue^%zewdDOM("page",0,nodeOID)
-	. s props("x")=+$$getAttributeValue^%zewdDOM("x",1,nodeOID)
-	. s props("y")=+$$getAttributeValue^%zewdDOM("y",1,nodeOID)
-	. s useCurrentPosition=$$getAttributeValue^%zewdDOM("usecurrentposition",1,nodeOID)
-	. i $$zcvt^%zewdAPI(useCurrentPosition,"l")="true" d
-	. . s props("x")="EWD.utils.findPosX(this)+"_props("x")
-	. . s props("y")="EWD.utils.findPosY(this)+"_props("y")
-	. e  d
-	. . s props("x")="'"_props("x")_"'"
-	. . s props("y")="'"_props("y")_"'"
-	. s props("width")=$$getAttributeValue^%zewdDOM("width",1,nodeOID) if props("width")="" set props("width")=100
-	. s props("height")=$$getAttributeValue^%zewdDOM("height",1,nodeOID) if props("height")="" set props("height")=100
-	. s props("toolbar")=$$getAttributeValue^%zewdDOM("toolbar",1,nodeOID) if props("toolbar")="" set props("toolbar")="no"
-	. s props("location")=$$getAttributeValue^%zewdDOM("location",1,nodeOID) if props("location")="" set props("location")="no"
-	. s props("directories")=$$getAttributeValue^%zewdDOM("directories",1,nodeOID) if props("directories")="" set props("directories")="no"
-	. s props("status")=$$getAttributeValue^%zewdDOM("status",1,nodeOID) if props("status")="" set props("status")="no"
-	. s props("menubar")=$$getAttributeValue^%zewdDOM("menubar",1,nodeOID) if props("menubar")="" set props("menubar")="no"
-	. s props("scrollbars")=$$getAttributeValue^%zewdDOM("scrollbars",1,nodeOID) if props("scrollbars")="" set props("scrollbars")="yes"
-	. s props("resizable")=$$getAttributeValue^%zewdDOM("resizable",1,nodeOID) if props("resizable")="" set props("resizable")="yes"
-	. f attr="useCurrentPosition","popup","event","page","x","y","width","height","toolbar","location","directories","status","menubar","scrollbars","resizable" do
-	. . d removeAttribute^%zewdAPI(attr,nodeOID,1)
-	. ;
-	. s ehx=$$getAttributeValue^%zewdDOM(event,1,nodeOID)
-	. s ehy=$$getAttributeValue^%zewdDOM("onclickpre",1,nodeOID)
-	. s ehz=$$getAttributeValue^%zewdDOM("onclickpost",1,nodeOID)
-	. d removeAttribute^%zewdAPI("onclickpre",nodeOID,1)
-	. d removeAttribute^%zewdAPI("onclickpost",nodeOID,1)
-	. s url=$$expandPageName^%zewdCompiler8(nextPage,.nextPageList,.urlNameList,technology,.jsParams)
-	. ; allow popup names defined in JS reference - ie use unquoted
-	. s winHandle=$s($e($$zcvt^%zewdAPI($tr(winHandle,"",""),"L"),1,9)="document.":winHandle,1:"'"_winHandle_"'")
-	. s winName=$s($e($$zcvt^%zewdAPI($tr(winName,"",""),"L"),1,9)="document.":winName,1:"'"_winName_"'")
-	. set eh="EWD.page.openWindow('"_url_"',"_winHandle_","_winName
-	. for attr="x","y","height","width","toolbar","location","directories","status","menubar","scrollbars","resizable" do
-	. . i attr'="x",attr'="y" d
-	. . . set eh=eh_",'"_props(attr)_"'"
-	. . e  d
-	. . . set eh=eh_","_props(attr)
-	. set jsName=""
-	. for  set jsName=$order(jsParams(jsName)) quit:jsName=""  do
-	. . set eh=eh_","_jsParams(jsName)
-	. set eh=eh_")"
-	. if ehx'="" set eh=eh_" ; "_ehx
-	. if ehz'="" set eh=eh_" ; "_ehz
-	. if ehy'="" set eh=ehy_" ; "_eh
-	. do setAttribute^%zewdDOM(event,eh,nodeOID)
-	;
-	QUIT
-	;
-addServerToSession(sessid,serverArray)
- QUIT:$g(sessid)=""
- ;
- k ^%zewdSession("session",sessid,"ewd_Server")
- m ^%zewdSession("session",sessid,"ewd_Server")=serverArray
- d setWLDSymbol^%zewdAPI("ewd_Server",sessid)
- QUIT
- ;
-displayTextArea(fieldName)
- n lineNo,text,lastLineNo
- ;
- s fieldName=$tr(fieldName,".","_")
- d
- . s lastLineNo=$o(^%zewdSession("session",sessid,"ewd_textarea",fieldName,""),-1)
- . s lineNo=0
- . f  s lineNo=$o(^%zewdSession("session",sessid,"ewd_textarea",fieldName,lineNo)) q:lineNo=""  d
- . . k text
- . . s text=^%zewdSession("session",sessid,"ewd_textarea",fieldName,lineNo)
- . . s text=$$replaceAll^%zewdHTMLParser(text,"&#39;","'")
- . . w $$zcvt^%zewdAPI(text,"o","HTML")
- . . i lineNo'=lastLineNo w $c(13,10)
- QUIT
- ;
-isNextPageTokenValid(token,sessid,page)
- ;
- n allowedFrom,expectedPage,fromPage
- ;
- s expectedPage=$p($g(^%zewdSession("nextPageTokens",sessid,token)),"~",1)
- ;s allowedFrom=$p($g(^%zewdSession("nextPageTokens",sessid,token)),"~",2)
- i expectedPage="" QUIT 0
- ;d trace^%zewdAPI("token="_token_" ; allowedFrom="_allowedFrom_" ; actual from page="_fromPage)
- ;i allowedFrom'=fromPage QUIT 0
- i page[".php" d
- . s page=$p(page,"/",$l(page,"/"))
- . s page=$p(page,".php",1)
- QUIT $$zcvt^%zewdAPI(expectedPage,"L")=$$zcvt^%zewdAPI(page,"L")
- ;
-existsInSessionArray(name,p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11)
- ;
- n exists,i,nparams,param,ref,sessid,stop,technology,value
- ;
- s stop=0
- f i=11:-1:1 d  q:stop
- . s param="p"_i
- . i $g(@param)'="" s stop=1
- s sessid=@("p"_i)
- s technology=$$getSessionValue^%zewdAPI("ewd_technology",sessid)
- s nparams=i-1
- s name=$tr($g(name),".","_")
- i $$isTemp^%zewdAPI(name) d
- . s ref="s exists=$d(zewdSession("""_name_""""
- . s ref="s exists=$d(sessionArray("""_name_""""
- e  s ref="s exists=$d(^%zewdSession(""session"","""_sessid_""","""_name_""""
- i nparams>0 d
- . f i=1:1:nparams s ref=ref_","""_$g(@("p"_i))_""""
- s ref=ref_"))"
- ;d trace^%zewdAPI("ref="_$g(ref))
- x ref
- ;d trace^%zewdAPI("ref="_ref_" ; exists="_exists)
- QUIT exists
- ;
-getSchemaFormErrors(errorArray,sessid)
- ;
- n error,num
- ;
- k errorArray
- d mergeArrayFromSession^%zewdAPI(.errorArray,"ewd_SchemaFormError",sessid)
- s error=""
- s num=""
- f  s num=$o(errorArray("list",num)) q:num=""  d
- . s error=error_errorArray("list",num)_$c(13,10)
- QUIT error
- ;
-existsInSession(name,sessid)
- n result,technology
- ;
- s name=$$stripSpaces^%zewdAPI(name)
- i $g(name)="" QUIT 0
- s name=$tr(name,".","_")
- i $g(sessid)="" QUIT 0
- s technology=$$getSessionValue^%zewdAPI("ewd_technology",sessid)
- i $$isTemp^%zewdAPI(name) QUIT $d(sessionArray(name))
- QUIT $d(^%zewdSession("session",sessid,name))
- ;
-encodeDataType(name,dataType,sessid)
- ;
- n value,outputMethod,x,encodedValue,Error
- ;
- i $g(name)="" QUIT "Data Type encoding attempted but field name was not specified"
- i $g(dataType)="" QUIT "Data Type encoding attempted for the "_name_" field, but no data type was defined"
- s value=$$getSessionValue^%zewdAPI(name,sessid)
- s outputMethod=$$getOutputMethod^%zewdCompiler(dataType)
- i outputMethod="" QUIT ""
- s x="s encodedValue=$$"_outputMethod_"("""_value_""",.Error,sessid)"
- x x
- i $g(Error)="" d setSessionValue^%zewdAPI(name,encodedValue,sessid)
- ;i Error'="" s Error=name_" : "_Error
- QUIT Error
- ;
Index: ePrescribing/trunk/p/_zewdGTM.m
===================================================================
--- ePrescribing/trunk/p/_zewdGTM.m	(revision 518)
+++ 	(revision )
@@ -1,863 +1,0 @@
-%zewdGTM	;Enterprise Web Developer GT.M/ Virtual Appliance Functions
- ;
- ; Product: Enterprise Web Developer version 4.0.755
- ; Build Date: Thu, 12 Feb 2009 09:53:12
-	;
- ; ----------------------------------------------------------------------------
- ; | Enterprise Web Developer for GT.M and m_apache                           |
- ; | Copyright (c) 2004-9 M/Gateway Developments Ltd,                         |
- ; | Reigate, Surrey UK.                                                      |
- ; | All rights reserved.                                                     |
- ; |                                                                          |
- ; | http://www.mgateway.com                                                  |
- ; | Email: rtweed@mgateway.com                                               |
- ; |                                                                          |
- ; | This program is free software: you can redistribute it and/or modify     |
- ; | it under the terms of the GNU Affero General Public License as           |
- ; | published by the Free Software Foundation, either version 3 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 Affero General Public License for more details.                      |
- ; |                                                                          |
- ; | You should have received a copy of the GNU Affero General Public License |
- ; | along with this program.  If not, see <http://www.gnu.org/licenses/>.    |
- ; ----------------------------------------------------------------------------
-	;
-	;
-	QUIT
-	;
-	; EWD Virtual Appliance Version/Build
-version()	
-	QUIT "6.0"
-	;
-buildDate()	
-	QUIT "29 January 2009"
-	;
-config	;
-	d setApplicationRootPath^%zewdAPI("/usr/ewd/apps")
-	d setOutputRootPath^%zewdAPI("/usr/php","php")
-	;s ^%eXtc("system","license")="2vxuxs3qzqxuyuvtynezvm8yy5Wrz4i7wwwrzmsvqwwtr"
-	QUIT
-	;
-getMGWSIPid()	
-	;
-	n io,ok,line,stop,temp
-	s io=$io
-	s temp="temp"_$p($h,",",2)_".txt"
-	zsystem "ps -A|grep mgwsi > "_temp
-	o temp:(readonly:exception="g nsFileNotExists") 
-	u temp
-	r line
-	c temp
-	u io
-	s ok=$$deleteFile^%zewdAPI(temp)
-	s line=$$stripSpaces^%zewdAPI(line)
-	QUIT +line
-startMGWSI	;
-	k ^%zewd("mgwsis")
-	d START^%ZMGWSI(0)
-	;s ^%zewd("mgwsi","job")=$zjob
-	QUIT
-	;
-stopMGWSI	;
-	n pid
-	;s pid=$g(^%zewd("mgwsi","job"))
-	;s pid=$$getMGWSIPid()
-	;i pid'="" d
-	;. k ^%zewd("mgwsi","job")
-	;. i $$pidExists(pid) zsystem "kill -TERM "_pid
-	s pid=""
-	f  s pid=$o(^%zewd("mgwsis",pid)) q:pid=""  d
-	. k ^%zewd("mgwsis",pid)
-	. i $$pidExists(pid) zsystem "kill -TERM "_pid
-	QUIT
-	;
-restartMGWSI	
-	d stopMGWSI
-	d startMGWSI
-	QUIT
-	;
-closeMGWSI(server)
-	; eg server=the MGWSI "server" to be closed, eg ewd, LOCAL, etc
-	n ok,html,url
-	s url="http://127.0.0.1:7040/cgi-bin/nph-mgwsic?mgwsidef=Default_CloseDown_Server&mgwsiSYS=2&mgwsiCDN="_server_"&mgwsiSYSbOK=Close+Connections(s)"
-	s ok=$$httpGET(url,.html)
-	QUIT
-	;
-closeMGWSIConnections	
-	n pid
-	s pid=""
-	f  s pid=$o(^%zewd("mgwsis",pid)) q:pid=""  d
-	. k ^%zewd("mgwsis",pid)
-	. i $$pidExists(pid) zsystem "kill -TERM "_pid
-	QUIT
-	;
-shutdown	
-	zsystem "shutdown -h now"
-	QUIT
-	;
-restart	
-	zsystem "shutdown -r now"
-	QUIT
-	;
-pidExists(pid)	;
-	n io,line,ok,temp
-	s io=$io
-	s temp="temp"_$p($h,",",2)_".txt"
-	zsystem "ps --no-heading "_pid_" > "_temp
-	c temp
-	o temp:(readonly:exception="g pidFileNotExists")
-	u temp r line
-	c temp
-	u io
-	s ok=$$deleteFile^%zewdAPI(temp)
-	i line'[pid QUIT 0
-	QUIT 1
-pidFileNotExists	
-	c temp
-	s ok=$$deleteFile^%zewdAPI(temp)
-	u io
-	i $p($zs,",",1)=2 QUIT 0
-	QUIT 0
-	;
-validDomain(domain)	
-	;
-	n exists,io,ok,line,stop,temp
-	s io=$io
-	s temp="temp"_$p($h,",",2)_".txt"
-	zsystem "nslookup "_domain_" >"_temp
-	o temp:(readonly:exception="g nsFileNotExists") 
-	u temp
-	s stop=0,exists=0
-	f  r line d  q:stop 
-	. i line["authoritative answer" s stop=1,exists=1 q
-	. i line["server can't find" s stop=1,exists=0 q
-	c temp
-	u io
-	s ok=$$deleteFile^%zewdAPI(temp)
-	QUIT exists
-nsFileNotExists	
-	u io
-	i $p($zs,",",1)=2 QUIT -1
-	QUIT -1
-	;
-getIP(info)	
-	;
-	n exists,io,ip,ok,line,stop,temp,value
-	s io=$io
-	s temp="temp"_$p($h,",",2)_".txt"
-	zsystem "ifconfig eth0 >"_temp
-	o temp:(readonly:exception="g ipFileNotExists") 
-	u temp
-	s stop=0,ok=0,ip=""
-	f  r line d  q:stop
-	. i line["HWaddr" d
-	. . s value=$p(line,"HWaddr ",2)
-	. . s info("mac")=$$stripSpaces^%zewdAPI(value)
-	. i line["inet addr:" d
-	. . s value=$p(line,"inet addr:",2)
-	. . s ip=$p(value," ",1)
-	. . s info("ip")=ip
-	. . i ip="127.0.0.1" s stop=1
-	. i line["Bcast:" d
-	. . s value=$p(line,"Bcast:",2)
-	. . s value=$p(value," ",1)
-	. . s info("broadcast")=value
-	. i line["Mask:" d
-	. . s value=$p(line,"Mask:",2)
-	. . s value=$p(value," ",1)
-	. . s info("mask")=value
-	. i line["inet6 addr" s stop=1 q
-	. i line["Local Lookback" s stop=1 q
-	c temp
-	u io
-	s ok=$$deleteFile^%zewdAPI(temp)
-	QUIT ip
-ipFileNotExists	
-	s $zt=""
-	u io
-	i $p($zs,",",1)=2 QUIT -1
-	QUIT ""
-	;
-openTCP(host,port,timeout)	
-	n delim,dev
-	i host'?1N.N1"."1N.N1"."1N.N1"."1N.N,'$$validDomain(host) QUIT 0
-	i $g(host)="" QUIT 0
-	i $g(port)="" QUIT 0
-	i $g(timeout)="" s timeout=20
-	s delim=$c(13)
-	s dev="client$"_$p($h,",",2)
-	o dev:(connect=host_":"_port_":TCP":attach="client":exception="g tcperr"):timeout:"SOCKET"
-	QUIT dev
-	;
-tcperr	;
-	QUIT 0
-	;
-resetSecurity	
-	;
-	k ^%zewd("config","security","validSubnet")
-	QUIT
-	;
-resetVM	
-	n files
-	d resetSecurity
-	k ^%zewdSession
-	s ^%zewd("nextSessid")=1
-	k ^%zewd("mgwsi")
-	k ^%zewd("mgwsis")
-	k ^%zewd("emailQueue")
-	k ^%zewd("daemon","email")
-	k ^%zewd("relink")
-	k ^%eXtc
-	k ^%zewdLog
-	k ^%zewdError
-	k ^CacheTempUserNode
-	k ^CacheTempEWD
-	k ^%zewdTrace
-	k ^zewd("trace")
-	k ^%MGW,^%MGWSI
-	k ^rob,^robdata,^robcgi
-	k ^CacheTempWLD
-	k ^ewdDemo
-	d removeDOMsByPrefix^%zewdAPI()
-	;d getFilesInPath^%zewdHTMLParser("/usr/local/gtm/ewd",".m",.files)
-	;f lineNo=1:1 s line=$t(leaveAsM+lineNo) q:line["***END***"  d
-	;. s leaveFiles($p(line,";;",2))=""
-	; s file=""
-	;f  s file=$o(files(file)) q:file=""  d
-	;. i $d(leaveFiles(file)) q
-	;. i file'["_zewd" q
-	;. s path="/usr/local/gtm/ewd/"_file
-	;   . s ok=$$deleteFile^%zewdAPI(path)
-	;   s ok=$$deleteFile^%zewdAPI("/usr/local/gtm/ewd/MDB.m")
-	;   s ok=$$deleteFile^%zewdAPI("/usr/local/gtm/ewd/MDBMgr.m")
-       ;s ok=$$deleteFile^%zewdAPI("/usr/local/gtm/ewd/MDBConfig.m")
-       s ok=$$deleteFile^%zewdAPI("/usr/MDB/MDB.conf")
-	k ^MDB,^MDBUAF
-	zsystem "rm -f ~/.bash_history"
-	zsystem "history -c"
-	;echo " "> /var/log/apache2/access.log
-	;echo " "> /var/log/apache2/error.log
-	;echo " "> /var/log/apache2/access.log.1"
-	;echo " "> /var/log/apache2/error.log.1"
-	;zsystem "rm /usr/php/tutorial/*.*"
-	; Now clear down history for root
-	; Shutdown Apache and clear down Apache Log files - use above commented commands
-	; Delete all ewdapps directories and files
-	; Delete all PHP directories and files
-	; zero-space all empty content: cat /dev/zero > zero.fill;sync;sleep 1;sync;rm -f zero.fill
-	; Compress the virtual drives: 
-	; G:\virtual_machines\mdb_1_0_master>"C:\Program Files\VMware\VMware Server\vmware-vdiskmanager.exe" -k Ubuntu-cl1.vmdk
-	QUIT
-	;
-setClock	
-	zsystem "ntpdate ntp.ubuntu.com"
-	QUIT
-	;
-startVM	
-	;
-	n cr,ip
-    s cr=$c(13)
-	d startMGWSI
-	w cr,!
-	d setClock
-	s ip=$$getIP()
-	w cr,!
-	w "======================================================="_cr,!
-	w "  Welcome to the EWD Virtual Appliance       "_cr,!
-	w "      -- Version "_$$version()_": "_$$buildDate()_" --"_cr,!
-	;
-	i ip=""!(ip="127.0.0.1") g startVMFail
-	w !
-	w "   System clock set to "_$$inetDate^%zewdAPI($h)_cr,!!
-	w "   The EWD Virtual Appliance is now ready for use!"_cr,!
-	w " To run the EWD Management Portal, point your browser at http://"_ip_cr,!!
-	g startVMFin
-startVMFail	
-	w "Unfortunately the Virtual Appliance was unable to acquire an IP"_cr,!
-	w "address.  Please consult the readme file for what to do next"_cr,!
-startVMFin	
-	w "======================================================="_cr,!
-	QUIT
-	;
-startMDBVM	
-	;
-	n cr,ip
-	s cr=$c(13)
-	d startMGWSI
-	w cr,!
-	d setClock
-	s ip=$$getIP()
-	w cr,!
-	w "======================================================="_cr,!
-	w "  Welcome to the M/DB Virtual Appliance       "_cr,!
-	w "      -- Version "_$$version()_": "_$$buildDate()_" --"_cr,!
-	;
-	i ip=""!(ip="127.0.0.1") g startVMFail
-	w !
-	w "   System clock set to "_$$inetDate^%zewdAPI($h)_cr,!!
-	w "   The M/DB Virtual Appliance is now ready for use!"_cr,!
-	w " To run the M/DB Management Portal, point your browser at http://"_ip_cr,!!
-	g startVMFin
-	;
-httpGET(url,html,headerArray,timeout,test,rawResponse,respHeaders,sslHost,sslPort)	
-	;
-	n dev,host,HTTPVersion,io,port,rawURL,ssl,urllc
-	;
-	k rawResponse,html
-	s HTTPVersion="1.0"
-	s rawURL=url
-	s ssl=0
-	s port=80
-	s urllc=$$zcvt^%zewdAPI(url,"l")
-	i $e(urllc,1,7)="http://" d
-	. s url=$e(url,8,$l(url))
-	. s sslHost=$p(url,"/",1)
-	. s sslPort=80
-	. i sslHost[":" d
-	. . s sslPort=$p(sslHost,":",2)
-	. . s sslHost=$p(sslHost,":",1)
-	e  i $e(urllc,1,8)="https://" d
-	. s url=$e(url,9,$l(url))
-	. s ssl=1
-	. s sslHost=$g(sslHost)
-	. i sslHost="" s sslHost="127.0.0.1"
-	. s sslPort=$g(sslPort)
-	. i sslPort="" s sslPort=89
-	e  QUIT "Invalid URL"
-	s host=$p(url,"/",1)
-	i host[":" d
-	. s port=$p(host,":",2)
-	. s host=$p(host,":",1)
-	s url="/"_$p(url,"/",2,5000)
-	i $g(timeout)="" s timeout=20
-	;
-	s io=$io
-	i $g(test)'=1 d
-	. s dev=$$openTCP(sslHost,sslPort,timeout)
-	. u dev
-	i ssl d
-	. w "GET "_rawURL_" HTTP/"_HTTPVersion_$c(13,10)
-	e  d
-	. w "GET "_url_" HTTP/"_HTTPVersion_$c(13,10)
-	w "Host: "_host
-	i port'=80 w ":"_port
-	w $c(13,10)
-	w "Accept: */*"_$c(13,10)
-	;
-	i $d(headerArray) d
-	. n n
-	. s n=""
-	. f  s n=$o(headerArray(n)) q:n=""  d
-	. . w headerArray(n)_$c(13,10)
-	; 
-	w $c(13,10),!
-	;
-	; That's the request sent !
-	;
-httpResponse	;
-	;
-	i $g(test)=1 QUIT ""
-	n c,dlim,header,i,no,pos,rlen,stop,str
-	;
-	k respHeaders
-	s stop=0,no=1
-	f i=1:1 d  q:stop
-	. i i=1
-	. r c#1
-	. i c=$c(13) q 
-	. i c'=$c(10) s respHeaders(no)=$g(respHeaders(no))_c
-	. i c=$c(10),$g(respHeaders(no))="" s stop=1 q
-	. i c=$c(10) s no=no+1
-	;
-	s rlen=999999
-	f i=1:1:(no-1) d
-	. s header=$$zcvt^%zewdAPI(respHeaders(i),"l")
-	. i header["content-length" d
-	. . s rlen=$p(header,":",2)
-	. . s rlen=$$stripSpaces^%zewdAPI(rlen)
-	;
-	i rlen<999999 d
-	. r str#rlen
-	e  d 
-	. s str=""
-	. f pos=1:1 r str#rlen:timeout g:'$t httpTimeout  q:str=""  s str(pos)=str q:($l(str)<999999)
-	i $g(test)'=1 c dev
-	s dlim=$c(10)
-	i str[$c(13,10) s dlim=$c(13,10)
-	s rlen=$l(str,dlim)
-	f i=1:1:rlen s html(i)=$p(str,dlim,i)
-	s rawResponse=""
-	f i=1:1:(no-1) s rawResponse=rawResponse_respHeaders(i)_dlim
-	s rawResponse=rawResponse_dlim_str
-	;
-	u io
-	QUIT ""
-	;
-httpTimeout	
-	QUIT "Timed out waiting for response"
-	;
-httpPOST(url,payload,mimeType,html,headerArray,timeout,test,rawResponse,respHeaders,sslHost,sslPort)	
-	;
-	n contentLength,dev,host,HTTPVersion,io,port,rawURL,ssl,urllc
-	;
-	k rawResponse,html
-	s HTTPVersion="1.0"
-	s rawURL=url
-	s ssl=0
-	s port=80
-	s urllc=$$zcvt^%zewdAPI(url,"l")
-	i $e(urllc,1,7)="http://" d
-	. s url=$e(url,8,$l(url))
-	. s sslHost=$p(url,"/",1)
-	. s sslPort=80
-	e  i $e(urllc,1,8)="https://" d
-	. s url=$e(url,9,$l(url))
-	. s ssl=1
-	. s sslHost=$g(sslHost)
-	. i sslHost="" s sslHost="127.0.0.1"
-	. s sslPort=$g(sslPort)
-	. i sslPort="" s sslPort=89
-	e  QUIT "Invalid URL"
-	s host=$p(url,"/",1)
-	i host[":" d
-	. s port=$p(host,":",2)
-	. s host=$p(host,":",1)
-	s url="/"_$p(url,"/",2,5000)
-	i $g(timeout)="" s timeout=20
-	;
-	s io=$io
-	i $g(test)'=1 d
-	. s dev=$$openTCP(sslHost,sslPort,timeout)
-	. u dev
-	i ssl d
-	. w "POST "_rawURL_" HTTP/"_HTTPVersion_$c(13,10)
-	e  d
-	. w "POST "_url_" HTTP/"_HTTPVersion_$c(13,10)
-	w "Host: "_host
-	i port'=80 w ":"_port
-	w $c(13,10)
-	w "Accept: */*"_$c(13,10)
-	;
-	i $d(headerArray) d
-	. n n
-	. s n=""
-	. f  s n=$o(headerArray(n)) q:n=""  d
-	. . w headerArray(n)_$c(13,10)
-	;
-	s mimeType=$g(mimeType)
-	i mimeType="" s mimeType="application/x-www-form-urlencoded"
-	s contentLength=0
-	i $d(payload) d
-	. n no
-	. s no=""
-	. f  s no=$O(payload(no)) q:no=""  D
-	. . s contentLength=contentLength+$l(payload(no))
-	. s contentLength=contentLength
-	. w "Content-Type: ",mimeType
-	. i $g(charset)'="" w "; charset=""",charset,""""
-	. w $c(13,10)
-	. w "Content-Length: ",contentLength,$c(13,10)
-	;
-	w $c(13,10)
-	i $D(payload) d
-	. n no
-	. s no=""
-	. f  s no=$O(payload(no)) q:no=""  d
-	. . w payload(no)
-	; 
-	w $c(13,10),!
-	;
-	; That's the request sent !
-	;
-	g httpResponse
-	;
-parseURL(url,docName)	
-	;
-	n getPath,ok,server
-	;
-	i url["http://" s url=$p(url,"http://",2)
-	s server=$p(url,"/",1)
-	s getPath=$p(url,"/",2,1000)
-	s ok=$$parseURL^%zewdHTMLParser(server,getPath,docName)
-	QUIT ok
-	;
-smtpSend(domain,from,displayFrom,to,displayTo,ccList,subject,message,dialog,authType,username,password,timeout,gmtOffset,port)	
-	;
-	n attach,boundary,crlf,date,dev,error,io,mess,rcpt,resp,sent,toList
-	;
-	s timeout=$g(timeout) i timeout="" s timeout=10
-	s domain=$g(domain)
-	s port=$g(port) i port="" s port=25
-	s from=$g(from)
-	s to=$g(to)
-	s subject=$g(subject)
-	s gmtOffset=$g(gmtOffset) i gmtOffset="" s gmtOffset="GMT"
-	;
-	s error=""
-	i domain="" QUIT "No SMTP Domain specified"
-	i from="" QUIT "No sender's email address specified"
-	i to="" QUIT "No recipient's email address specified"
-	i '$d(message) QUIT "No Email content specified"
-	;
-	s date=$$inetDate^%zewdAPI($h)_" "_gmtOffset
-	s mess($increment(mess))="Date: "_date
-	i $g(displayFrom)'="" d
-	. s mess($increment(mess))="From: """_displayFrom_"""<"_from_">"
-	e  d
-	. s mess($increment(mess))="From: "_from
-	i $g(displayTo)'="" d
-	. s mess($increment(mess))="To: """_displayTo_"""<"_to_">"
-	e  d
-	. s mess($increment(mess))="To: "_to
-	s toList(to)=""
-	i $d(ccList) d
-	. n name
-	. s mess($increment(mess))="Cc: "
-	. i $g(ccList)'="" d
-	. . s toList(ccList)=""
-	. . s mess(mess)=mess(mess)_ccList
-	. s name=""
-	. f  s name=$o(ccList(name)) q:name=""  d
-	. . i mess(mess)'="Cc: " s mess(mess)=mess(mess)_", "
-	. . s mess(mess)=mess(mess)_name
-	. . s toList(name)=""
-	s mess($increment(mess))="Subject: "_subject
-	s mess($increment(mess))="X-Priority: 3 (Normal)"
-	s mess($increment(mess))="X-MSMail-Priority: Normal"
-	s mess($increment(mess))="X-Mailer: "_$$version^%zewdAPI()
-	s mess($increment(mess))="MIME-Version: 1.0"
-	s mess($increment(mess))="Content-Type: text/plain; charset=""us-ascii"""
-	s mess($increment(mess))="Content-Transfer-Encoding: 7bit"
-	s mess($increment(mess))=""
-	;
-	s message=$g(message)
-	i message'="" d
-	. s mess($increment(mess))=message
-	e  d
-	. n mlno
-	. s mlno=""
-	. f  s mlno=$o(message(mlno)) q:mlno=""  d
-	. . s mess($increment(mess))=message(mlno)
-	;
-	k dialog
-	s io=$io
-	s crlf=$c(13,10)
-	s dev=$$openTCP(server,port,timeout)
-	i dev=0 QUIT "Unable to connect to SMTP server: "_server
-	u dev
-	r resp:timeout e  d close QUIT "Unable to initiate connection with SMTP server"
-	s resp=$p(resp,crlf,1)
-	s dialog($increment(dialog))=resp
-	s error=""
-	s authType=$g(authType)
-	i authType="LOGIN PLAIN"!(authType="LOGIN") d  i error'="" d close QUIT error
-	. n context,decode,passB64,str,userB64
-	. s context=1
-	. i $d(^zewd("config","MGWSI")) s context=0
-	. u dev w "EHLO "_domain_crlf,! s resp=$$read(.dialog)
-	. i resp'["250",resp'["AUTH",resp'["LOGIN" s error="Authentication type LOGIN/LOGIN PLAIN not supported on this server" q
-	. u dev w "AUTH LOGIN"_crlf,! s resp=$$read(.dialog)
-	. i resp'["334" s error="No username authentication challenge from server" q
-	. s str=$p(resp," ",2,1000)
-	. s decode=$$DB64^%ZMGWSIS(str,context)
-	. s resp="(decoded as : "_decode_")"
-	. s dialog($increment(dialog))=resp
-	. s userB64=$$B64^%ZMGWSIS(username,context)
-	. u dev w userB64_crlf,! s resp=$$read(.dialog)
-	. i resp'["334" s error="No password authentication challenge from server" q
-	. s str=$p(resp," ",2,1000)
-	. s decode=$$DB64^%ZMGWSIS(str,context)
-	. s resp="(decoded as : "_decode_")"
-	. s dialog($increment(dialog))=resp
-	. s passB64=$$B64^%ZMGWSIS(password,context)
-	. u dev w passB64_crlf,! s resp=$$read(.dialog)
-	. i resp'["235 " s error=resp q
-	e  d  i error'="" d close QUIT error
-	. u dev w "HELO "_domain_crlf,! s resp=$$read(.dialog)
-	. i resp'["250" s error=resp
-	;
-	u dev w "MAIL FROM: "_from_crlf,! s resp=$$read(.dialog)
-	i resp'["250" d close QUIT resp
-	;
-	s rcpt=""
-	f  s rcpt=$o(toList(rcpt)) q:rcpt=""  d  i resp'[250 q
-	. u dev w "RCPT TO: <"_rcpt_">"_$c(13,10),! 
-	. s resp=$$read(.dialog)
-	i resp'[250 d close QUIT resp
-	;
-	u dev w "DATA",crlf,! s resp=$$read(.dialog)
-	i resp'["250",resp'["354" d close QUIT resp
-	;
-	s message=$g(message)
-	i message'="" d message(message,dev)
-	e  d
-	. n line,lineNo
-	. s lineNo=""
-	. f  s lineNo=$o(mess(lineNo)) q:lineNo=""  d
-	. . s line=mess(lineNo)
-	. . d message(line,dev)
-	u dev w crlf,".",crlf,! s resp=$$read(.dialog)
-	i resp'["250" d close QUIT resp
-	u dev w "QUIT",crlf,! s resp=$$read(.dialog)
-	d close
-	QUIT ""
-	;
-read(dialog)	
-	n resp
-	r resp
-	s resp=$p(resp,$c(13,10),1)
-	s dialog($increment(dialog))=resp
-	QUIT resp
-close	;
-	c dev
-	u io
-	QUIT
-	;
-message(line,dev)	
-	n buf,p1
-	s buf=$g(line)
-	i buf="" u dev w $c(13,10),! QUIT
-	f  q:buf=""  d
-	. s p1=$e(buf,1,254),buf=$e(buf,255,$l(buf))
-	. i $e(p1)="." s p1="."_p1
-	. i $l(p1) u dev w p1,!
-	u dev w $c(13,10),!
-	QUIT
-	;
-smtpTest	
-	s server="relay.xxxx.net"
-	s from="rtweed@xxxxx.com"
-	s displayFrom="Rob Tweed"
-	s displayTo=displayFrom
-	s to="rtweed@xxxx.co.uk"
-	s ccList("rtweed@yyyy.co.uk")=""
-	s ccList("rtweed@zzzz.com")=""
-	s message(1)="Test Message"
-	s message(2)="This is line 2"
-	s message(3)="And here is line 3"
-	s authType="LOGIN PLAIN"
-	s user="xxxxxxxxx"
-	s pass="yyyyyyyyy"
-	s subject="Test email 2"
-	s ok=$$smtpSend(server,from,displayFrom,to,displayTo,.ccList,subject,.message,.dialog,authType,user,pass)
-	QUIT
-	;
-getFileInfo(path,ext,info)	; Get list of files with specified extension
-	;
-	n date,dlim,%file,%io,lineNo,ok,os,%p1,result,time,%x,%y
-	;
-	k info
-	s dlim="/"
-	i $e(ext,1)'="." s ext="."_ext
-	i $e(path,$l(path))=dlim s path=$e(path,1,$l(path)-1)
-	;
-	d shellCommand("ls -l """_path_"""",.result)
-	;
-	; we now have directory listing in result array
-	s lineNo=""
-	f  s lineNo=$o(result(lineNo)) q:lineNo=""  d
-	. s %file=result(lineNo)
-	. s %p1=$P(%file," ",1)
-	. i $e(%p1,1)'="d" d
-	. . n %e1,%e2,%rfile,%p9,%len,%name,size
-	. . s %rfile=$re(%file)
-	. . s %rfile=$$replaceAll^%zewdAPI(%rfile,"  "," ")
-	. . s %p9=$p(%rfile," ",1)
-	. . s time=$p(%rfile," ",2)
-	. . s date=$p(%rfile," ",3,4)
-	. . s size=$p(%rfile," ",5)
-	. . s %p9=$re(%p9)
-	. . s time=$re(time)
-	. . s date=$re(date)
-	. . ;i $$zcvt^%zewdAPI(%p9,"l")=$$zcvt^%zewdAPI(%tofile,"l") q  ; ignore temp file
-	. . i ext=".*" s info(%p9)=date_$c(1)_time_$c(1)_size q
-	. . s %e1="."_$$getFileExtension^%zewdHTMLParser(%p9)
-	. . i %e1'=ext q
-	. . s info(%p9)=date_$c(1)_time_$c(1)_size
-	QUIT
-	;
-shellPipe	; Pipe output from shell commands to scratch global
-	;
-	n i,x
-	;
-	k ^%mgwPipe
-	f i=1:1:200 r x q:((i>20)&(x=""))  s ^%mgwPipe(i)=x
-	QUIT
-	;
-deletePipe	
-	k ^%mgwPipe
-	QUIT
-	;
-lockPipe	
-	l +^%mgwPipe
-	QUIT
-	;
-unlockPipe	
-	l -^%mgwPipe
-	QUIT
-	;
-shellCommand(command,result)	;
-	n lineNo
-	k result
-	d lockPipe
-	zsystem command_" |mumps -run shellPipe^%zewdGTM"
-	m result=^%mgwPipe
-	d deletePipe
-	d unlockPipe
-	s lineNo=""
-	f  s lineNo=$o(result(lineNo),-1) q:lineNo=""  q:result(lineNo)'=""  k result(lineNo)
-	QUIT
-	;
-fileInfo(path,info)	
-	n line,temp
-	k info
-	s temp="temp"_$p($h,",",2)_".txt"
-	i '$$fileExists^%zewdAPI(path) QUIT
-	zsystem "ls -l "_path_">"_temp
-	o temp:(readonly:exception="g fileDateNotExists") 
-	u temp
-	r line
-	s info("date")=$p(line," ",6,8)
-	s info("size")=$p(line," ",5)
-	c temp
-	s ok=$$deleteFile^%zewdAPI(temp)
-	QUIT
-fileDateNotExists	
-	s $zt=""
-	i $p($zs,",",1)=2 QUIT
-	QUIT
-shell(command,result)	
-	n i,io,temp
-	k result
-	s io=$io
-	s temp="temp"_$p($h,",",2)_".txt"
-	zsystem command_">"_temp
-	o temp:(readonly) 
-	u temp:exception="g eoshell"
-	f i=1:1 r result(i)
-eoshell	;
-	c temp
-	u io
-	s ok=$$deleteFile^%zewdAPI(temp)
-	QUIT i-1
-	;
-testGlobal()	
-	s start=$h
-	f i=1:1:1000 d fileInfo^%zewdAPI("/usr/php/ewdMgr/user.php",.info)
-	s end=$h
-	s dur=$p(end,",",2)-$p(start,",",2)
-	QUIT dur
-	;
-testFile()	
-	s start=$h
-	f i=1:1:1000 d fileInfo^%zewdGTM("/usr/php/ewdMgr/user.php",.info)
-	s end=$h
-	s dur=$p(end,",",2)-$p(start,",",2)
-	QUIT dur
-	;
-mySQL(sql,resultArray,username,password,database)
-	n nlines,str
-	;
-	i $g(username)="" s username="root"
-	i $g(password)="" s password="1234567"
-	i $g(database)="" s database="test"
-	s str="mysql --xml -u "_username_" -p"_password_" "_database_" -e """_sql_""""
-	s nlines=$$shell(str,.resultArray)
-	QUIT nlines
-	;
-encodeDate(dateString)
-	n %DN,%DS
-	s %DS=dateString
-	d INT^%DATE
-	QUIT $g(%DN)
-	;
-relink ;
- s ^%zewd("relink")=1 k ^%zewd("relink","process")
- QUIT
- ;
-install
- n default,x
- ;
- w !,"Installing/Configuring "_$$version^%zewdAPI(),!!
- w "Note: hit Esc to go back at any point",!!
-install1 ;
- s default=$g(^zewd("config","applicationRootPath"))
- i default="" s default="/usr/ewdapps"
- w !,"Application Root Path ("_default_"): " r x
- i $zb=$c(27) w !," Installation aborted",!! QUIT
- i x="" s x=default w x
- s ^zewd("config","applicationRootPath")=x
- ;
-install2 ;
- s default=$g(^zewd("config","routinePath","gtm"))
- i default="" s default="/usr/local/gtm/ewd/"
- w !,"Routine Path ("_default_"): " r x
- i $zb=$c(27) w ! g install1
- i x="" s x=default w x
- s ^zewd("config","routinePath","gtm")=x
- ;
-install3 ; 
- s default=$g(^zewd("config","jsScriptPath","gtm","outputPath"))
- i default="" s default="/var/www/resources/"
- w !,"Javascript and CSS File Output Path ("_default_"): " r x
- i $zb=$c(27) w ! g install2
- i x="" s x=default w x
- i $e(x,$l(x))'="/" s x=x_"/"
- s ^zewd("config","jsScriptPath","gtm","outputPath")=x
- ;
-install4 ; 
- s default=$g(^zewd("config","jsScriptPath","gtm","path"))
- i default="" s default="/resources/"
- w !,"Javascript and CSS File URL Path ("_default_"): " r x
- i $zb=$c(27) w ! g install3
- i x="" s x=default w x
- i $e(x,$l(x))'="/" s x=x_"/"
- s ^zewd("config","jsScriptPath","gtm","path")=x
- ;
- s ^zewd("config","backEndTechnology")="m"
- i '$d(^zewd("config","defaultFormat"))  s ^zewd("config","defaultFormat")="pretty"
- s ^zewd("config","defaultTechnology")="gtm"
- s ^zewd("config","frontEndTechnology")="gtm"
- i '$d(^zewd("config","jsScriptPath","gtm","mode")) s ^zewd("config","jsScriptPath","gtm","mode")="fixed"
- s ^zewd("config","sessionDatabase")="gtm"
- w !!,$$version^%zewdAPI()_" is configured and ready for use",!!
- QUIT
- ;
-leaveAsM	;
- ;;_zewdCompiler11.m
- ;;_zewdCompiler12.m
- ;;_zewdCompiler14.m
- ;;_zewdCompiler15.m
- ;;_zewdCompiler17.m
- ;;_zewdCompiler18.m
- ;;_zewdCompiler21.m
- ;;_zewdCompiler2.m
- ;;_zewdCompiler9.m
- ;;_zewdDemo.m
- ;;_zewdDocumentation1.m
- ;;_zewdDocumentation2.m
- ;;_zewdDocumentation3.m
- ;;_zewdDocumentation4.m
- ;;_zewdEJSCData.m
- ;;_zewdExtJSCode.m
- ;;_zewdExtJSData.m
- ;;_zewdExtJSDat2.m
- ;;_zewdExtJSData3.m
- ;;_zewdGTM.m
- ;;_zewdGTMRuntime.m
- ;;_zewdHTTP.m
- ;;_zewdLAMP1.m
- ;;_zewdMgr.m
- ;;_zewdMgr2.m
- ;;_zewdMgr3.m
- ;;_zewdMgrAjax.m
- ;;_zewdMgrAjax2.m
- ;;_zewdSlideshow.m
- ;;_zewdYUI1.m
- ;;_zewdYUI2.m
- ;;_zewdvaMgr.m
- ;;***END***