source: ePrescribing/trunk/p/C0PEREW.m@ 1797

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

initial release of ePrescribing
File size: 6.7 KB
Line 
1C0PEREW ; eRx/GPL - ePrescription ewd utilities; 1/3/11
2 ;;1.0;C0P;;Apr 25, 2012;Build 103
3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU
4 ;General Public License See attached copy of the License.
5 ;
6 ;This program is free software; you can redistribute it and/or modify
7 ;it under the terms of the GNU General Public License as published by
8 ;the Free Software Foundation; either version 2 of the License, or
9 ;(at your option) any later version.
10 ;
11 ;This program is distributed in the hope that it will be useful,
12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;GNU General Public License for more details.
15 ;
16 ;You should have received a copy of the GNU General Public License along
17 ;with this program; if not, write to the Free Software Foundation, Inc.,
18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 ;
20 Q
21 ;
22test1(sessid) ;
23 d setSessionValue^%zewdAPI("testing","ZZ",sessid)
24 q 0
25 ;
26cbTestMethod(prefix,seedValue,lastSeedValue,optionNo,options)
27 ;
28 n maxNo,noFound,dfn,dob,sex
29 ;
30 s maxNo=50
31 s noFound=0
32 f s seedValue=$o(^DPT("B",seedValue)) q:seedValue="" q:noFound=maxNo d
33 . s lastSeedValue=seedValue
34 . i prefix'="",$e(seedValue,1,$l(prefix))'=prefix q
35 . s optionNo=optionNo+1
36 . s noFound=noFound+1
37 . s options(optionNo)=seedValue
38 . s dfn=$o(^DPT("B",seedValue,"")) ; dfn of the patient
39 . s dob=$$GET1^DIQ(2,dfn,.03) ; date of birth
40 . s sex=$$GET1^DIQ(2,dfn,.02,"I") ; sex M or F
41 . s options(optionNo)=seedValue_" "_dob_" "_sex ; complete patient
42 QUIT
43 ;
44set1 ;
45 s ^zewd("comboPlus","methodMap","test")="cbTestMethod^C0PEREW"
46 ; THIS THE SHELL SCRIPT WHICH CREATED THE EWD PAGES IN THE C0P NAMESPACE
47 ;cp ../w/ewdWLerxewdajaxerror.m C0PE001.m
48 ;cp ../w/ewdWLerxewdajaxerrorredirect.m C0PE002.m
49 ;cp ../w/ewdWLerxewderrorredirect.m C0PE003.m
50 ;cp ../w/ewdWLerxindex1.m C0PE004.m
51 ;cp ../w/ewdWLerxmatch.m C0PE005.m
52 ;cp ../w/ewdWLerxnomatch.m C0PE006.m
53 ; WE NEED TO ADD THIS CONFIGURATION ONE TIME TO ^zewd
54 ;s ^zewd("routineMap","eRx","ewdajaxerror")="C0PE001"
55 ;s ^zewd("routineMap","eRx","ewdajaxerrorredirect")="C0PE002"
56 ;s ^zewd("routineMap","eRx","ewderrorredirect")="C0PE003"
57 ;s ^zewd("routineMap","eRx","index1")="C0PE004"
58 ;s ^zewd("routineMap","eRx","match")="C0PE005"
59 ;s ^zewd("routineMap","eRx","nomatch")="C0PE006"
60 ; unfortunately, the global map doesn't really work for now.. but
61 ; we will keep trying in future releases
62 q
63 ;
64INITSES(sessid) ; INITIALIZE AN EWD SESSION BY PULLING "VISTA" VARIABLES
65 ; INTO THE SESSION FROM WHERE THEY HAVE BEEN STORED. THEY ARE INDEXED
66 ; BY A UNIQUE RANDOM TOKEN WHICH IS PASSED WITH THE URL
67 ; FOR EXAMPLE https//example.com/ewd/myApp/index.ewd?token="12345"
68 N ZTOKEN,C0EARY
69 S ZTOKEN=$$URLTOKEN^C0CEWD(sessid) ; get the token passed on the url
70 D GET^C0CEWD("C0EARY",ZTOKEN,1) ; GET THE ARRAY OF VALUES
71 S C0EARY("TOKEN")=ZTOKEN
72 M ^TMP("GPL")=C0EARY
73 d mergeArrayToSession^%zewdAPI(.C0EARY,"VistA",sessid)
74 ; ALL VISTA VARIABLES ARE IN THE "VistA" section of the session
75 Q
76 ;
77INITREW(sessid) ; initialze the eRx Renewal Patient Matching screen
78 ;
79 N C0PSES,ZDJ,ZDOB,ZSEX
80 D INITSES(sessid) ; add the VistA Variables to the session
81 D mergeArrayFromSession^%zewdAPI(.C0PSES,"VistA",sessid) ; get them back
82 N ZNAME,ZMED,ZSV
83 S ZNAME=$G(C0PSES("C0PRenewalName"))
84 I ZNAME="" Q "" ;OOPS
85 S ZDOB=$G(C0PSES("RenewalDOB")) ; date of birth
86 I ZDOB'="" S ZDOB=$E(ZDOB,5,6)_"/"_$E(ZDOB,7,8)_"/"_$E(ZDOB,1,4) ; REFORMAT
87 d setSessionValue^%zewdAPI("RenewalDOB",ZDOB,sessid) ; save in session
88 S ZSEX=$G(C0PSES("RenewalSex")) ; gender
89 d setSessionValue^%zewdAPI("RenewalSex",ZSEX,sessid) ; save in session
90 s ZNAME=ZNAME_" "_ZDOB_" "_ZSEX ; ADD DOB AND SEX TO PATIENT NAME
91 d setSessionValue^%zewdAPI("C0PRenewalName",ZNAME,sessid) ;the whole name
92 d setSessionValue^%zewdAPI("pat4",$e(ZNAME,1,4),sessid) ;first part of name
93 S ZMED=$G(C0PSES("medication")) ; pull med from VistA part of session
94 d setSessionValue^%zewdAPI("medication",ZMED,sessid) ;the med
95 S ZDJ=$G(C0PSES("dollarJ")) ; job number of CPRS session
96 d setSessionValue^%zewdAPI("CPRSdollarJ",ZDJ,sessid) ; save in the session
97 S ZSV=$G(C0PSES("SUPERVISING-DUZ")) ; supervising doctor DUZ
98 d setSessionValue^%zewdAPI("supervisor",ZSV,sessid) ; save
99 d clearList^%zewdAPI("supervisor",sessid) ; make sure no list is there
100 M DUZ=C0PSES("DUZ") ; PASS LOG ON AUTHORITY
101 n svlist ; list of licensed prescribers
102 d SVLIST("svlist") ; generate the list
103 n zi,zn
104 s zi=""
105 f s zi=$o(svlist(zi)) q:zi="" d ; for each licensed prescriber
106 . s zn=$o(svlist(zi,"")) ; DUZ of prescriber
107 . d appendToList^%zewdAPI("supervisor",zi,zn,sessid) ;add to list
108 Q ""
109 ;
110MATCH(sessid) ; process submit after matching
111 S ^TMP("GPL","MATCH",sessid)=""
112 N ZRTN,ZNAME,ZDFN
113 S ZNAME=$$getSessionValue^%zewdAPI("patient",sessid) ; current match
114 S ZNAME=$P(ZNAME," ",1) ; GET JUST THE NAME - NOT DOB OR SEX
115 S ZDFN=$O(^DPT("B",ZNAME,""))
116 S ZRTN=""
117 I ZDFN="" S ZRTN="Please select a patient"
118 D setSessionValue^%zewdAPI("selectedDFN",ZDFN,sessid) ; record selection
119 Q ZRTN
120 ;
121NOMATCH(sessid) ; process submit after matching
122 S ^TMP("GPL","NOMATCH",sessid)=""
123 Q ""
124 ;
125MTCHPG(sessid) ; process the match clickthrough page
126 N GDFN,ZDJ
127 S GDFN=$$getSessionValue^%zewdAPI("selectedDFN",sessid) ; THE PATIENT SELECTED
128 S ZDJ=$$getSessionValue^%zewdAPI("CPRSdollarJ",sessid) ; CPRS job number
129 S ^TMP("C0E",ZDJ,"NEWDFN")=GDFN ; PASS THE NEW DFN TO CPRS
130 D BRSRDR(GDFN,sessid) ; GENERATE THE RENEWAL BROWSER REDIRECT PAGE
131 Q ""
132 ;
133NOMTCHPG(sessid) ; process the nomatch clickthrough page
134 D BRSRDR(0,sessid) ; BOTH MATCH AND NOMATCH DO THE SAME THING FOR NOW
135 Q ""
136 ;
137BRSRDR(ZDFN,sessid) ; GENERATE RENEWAL BROWSER REDIRCT HTML/XML TO CLICK THRU
138 ; TO ERX RENEWAL
139 N ZISTR,ZDUZ,ZHTML,C0PSES
140 D mergeArrayFromSession^%zewdAPI(.C0PSES,"VistA",sessid) ; get SESSION VARS
141 S ZDUZ=$G(C0PSES("DUZ"))
142 M DUZ=C0PSES("DUZ") ; PASS LOG ON AUTHORITY
143 S ZISTR=$G(C0PSES("renewalToken"))
144 S C0PSPRV=$$getSessionValue^%zewdAPI("supervisor",sessid) ;supervisor selected
145 I C0PSPRV="" S C0PSVRV=$G(C0PSES("SUPERVISOR-DUZ")) ; SUPERVISING DOCTOR DUZ
146 D ALERTRPC^C0PCPRS1(.ZHTML,ZDUZ,ZDFN,1,ZISTR,1) ; CALL WITH MODE=1
147 d mergeArrayToSession^%zewdAPI(.ZHTML,"eRxRenew",sessid)
148 Q
149 ;
150SVLIST(ZLIST) ; GENERATE A LIST OF LICENSED PRESCRIBERS FOR THE
151 ; MIDLEVEL SUPERVISING DOCTOR PULLDOWN; ZLIST IS PASSED BY NAME
152 N ZI,ZA
153 S ZA=$NA(^VA(200,"C0P","ERX")) ; INDEX TO USE
154 S ZI=""
155 F S ZI=$O(@ZA@(ZI)) Q:ZI="" D ; FOR EACH SUBSCRIBER
156 . N ZS
157 . D SETACCT^C0PSUB("ZS",ZI) ; GET SUBSCRIPTION INFO
158 . I $G(ZS("SUBSCRIBER-USERTYPE"))="LicensedPrescriber" D ; USE IT
159 . . N ZN
160 . . S ZN=$$GET1^DIQ(200,ZI,.01,"E") ; NAME OF SUBSCRIBER
161 . . S @ZLIST@(ZN,ZI)="" ; RETURN THIS SUBSCRIBER
162 . K ZS
163 Q
164 ;
Note: See TracBrowser for help on using the repository browser.