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