source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWPCE2.m@ 613

Last change on this file since 613 was 613, checked in by George Lilly, 14 years ago

initial load of WorldVistAEHR
File size: 7.6 KB
Line 
1ORWPCE2 ; ISL/JM/RV - wrap calls to PCE ;04/06/2006
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,116,173,195,243**;Dec 17, 1997;Build 242
3GETSET(ORWLST,ORWFILE,ORWFIELD,ORWNULL) ;gets set of codes
4 ; ORWLST(n)=code^text for code
5 N ORWPCE,ORWPCEL,ORWPCEC,ORWPCELO,ORWPCEHI,ORWPCECD,ORWPCET
6 S ORWPCELO="abcdefghijklmnopqrstuvwxyz"
7 S ORWPCEHI="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
8 D FIELD^DID(ORWFILE,ORWFIELD,"","POINTER","ORWPCE","ORWPCE")
9 S ORWPCEL=$L(ORWPCE("POINTER"),";")-1
10 F ORWPCEC=1:1:ORWPCEL D
11 . S ORWPCECD=$P($P(ORWPCE("POINTER"),";",ORWPCEC),":",1)
12 . S ORWPCET=$P($P(ORWPCE("POINTER"),";",ORWPCEC),":",2)
13 . S ORWLST(ORWPCEC)=ORWPCECD_"^"_$E(ORWPCET)_$TR($E(ORWPCET,2,99),ORWPCEHI,ORWPCELO)
14 S:$G(ORWNULL) ORWLST(0)="@^(None selected)"
15 Q
16 ;
17IMMTYPE(ORWLST,ORDT) ;get the list of active immunizations
18 N IEN,CNT,BINDEX S (IEN,CNT,BINDEX)=0
19 S:'$G(ORDT) ORDT=DT
20 F S BINDEX=$O(^AUTTIMM("B",BINDEX)) Q:BINDEX']"" F S IEN=$O(^(BINDEX,IEN)) Q:'+IEN D
21 . I $D(^AUTTIMM(IEN,0))#2,+$P(^(0),"^",7)=0 S CNT=CNT+1,ORWLST(CNT)=IEN_"^"_$P(^(0),"^")
22 . ;I $D(^AUTTIMM(IEN,0))#2,+$$SCREEN^XTID(9999999.14,,IEN,ORDT)=0 S CNT=CNT+1,ORWLST(CNT)=IEN_"^"_$P(^(0),"^")
23 Q
24 ;
25SKTYPE(ORWLST,ORDT) ;get the list of active skin test
26 N IEN,CNT,BINDEX S (IEN,CNT,BINDEX)=0
27 S:'$G(ORDT) ORDT=DT
28 F S BINDEX=$O(^AUTTSK("B",BINDEX)) Q:BINDEX']"" F S IEN=$O(^(BINDEX,IEN)) Q:'+IEN D
29 . I $D(^AUTTSK(IEN,0))#2,+$P(^(0),"^",3)=0 S CNT=CNT+1,ORWLST(CNT)=IEN_"^"_$P(^(0),"^")
30 . ;I $D(^AUTTSK(IEN,0))#2,+$$SCREEN^XTID(9999999.28,,IEN,ORDT)=0 S CNT=CNT+1,ORWLST(CNT)=IEN_"^"_$P(^(0),"^")
31 Q
32 ;
33EDTTYPE(ORWLST) ;get the list of active education topics
34 N IEN,CNT,BINDEX S (IEN,CNT,BINDEX)=0
35 F S BINDEX=$O(^AUTTEDT("B",BINDEX)) Q:BINDEX']"" F S IEN=$O(^(BINDEX,IEN)) Q:'+IEN I $D(^AUTTEDT(IEN,0))#2,+$P(^(0),"^",3)=0 S CNT=CNT+1,ORWLST(CNT)=IEN_"^"_$P(^(0),"^")
36 Q
37 ;
38HFTYPE(ORWLST,ADDCATS) ;get the list of active health factors
39 N IEN,CNT,BINDEX,REC
40 S (IEN,CNT,BINDEX)=0,ADDCATS=+$G(ADDCATS)
41 F S BINDEX=$O(^AUTTHF("B",BINDEX)) Q:BINDEX']"" D
42 .F S IEN=$O(^AUTTHF("B",BINDEX,IEN)) Q:'+IEN D
43 ..S REC=$G(^AUTTHF(IEN,0))
44 ..I +$P(REC,U,11) S REC=""
45 ..I 'ADDCATS,$P(REC,U,10)="C" S REC=""
46 ..I REC'="" D
47 ...S CNT=CNT+1,ORWLST(CNT)=IEN_U_$P(REC,U)
48 ...I ADDCATS S ORWLST(CNT)=ORWLST(CNT)_U_$P(REC,U,10)_U_$P(REC,U,3)
49 Q
50 ;
51EXAMTYPE(ORWLST) ;get the list of active exams
52 N IEN,CNT,BINDEX S (IEN,CNT,BINDEX)=0
53 F S BINDEX=$O(^AUTTEXAM("B",BINDEX)) Q:BINDEX']"" F S IEN=$O(^(BINDEX,IEN)) Q:'+IEN I $D(^AUTTEXAM(IEN,0))#2,+$P(^(0),"^",4)=0 S CNT=CNT+1,ORWLST(CNT)=IEN_"^"_$P(^(0),"^")
54 Q
55 ;
56TRTTYPE(ORWLST) ;get the list of active treatments
57 N IEN,CNT,BINDEX S (IEN,CNT,BINDEX)=0
58 F S BINDEX=$O(^AUTTTRT("B",BINDEX)) Q:BINDEX']"" F S IEN=$O(^(BINDEX,IEN)) Q:'+IEN I $D(^AUTTTRT(IEN,0))#2,+$P(^(0),"^",4)=0 S CNT=CNT+1,ORWLST(CNT)=IEN_"^"_$P(^(0),"^")
59 Q
60 ;
61ACTIVPRV(ORRETURN,ORWPROV,ORWDT) ;get if provider is active or not
62 S ORRETURN=$$ACTIVPRV^PXAPI(ORWPROV,ORWDT)
63 Q
64GETVISIT(VISIT,IEN,DFN,VSITSTR) ;Get the visit IEN
65 I +$G(IEN)<1 D I 1
66 .S VISIT=$$GETENC^PXAPI(DFN,$P(VSITSTR,";",2),$P(VSITSTR,";"))
67 E S VISIT=$P(^TIU(8925,IEN,0),U,3)
68 Q
69GAFOK(ORY) ; Returns true if all supporting MH GAF Code exists
70 S ORY=0
71 I $T(GAFHX^YSGAFAPI)'="",$T(ENT^YSGAFAP1)'="" S ORY=1
72 Q
73MHCLINIC(ORY,ORIEN) ; See if this is a mental health clinic
74 I $T(MHCLIN^SDUTL2)="" S ORY=1
75 E S ORY=$$MHCLIN^SDUTL2(ORIEN)
76 Q
77LOADGAF(ORY,ORINPUT) ; Retrieve GAF scores
78 D GAFHX^YSGAFAPI(.ORY,.ORINPUT)
79 Q
80SAVEGAF(ORY,ORINPUT) ; Save new GAF score
81 N ORDATA
82 D ENT^YSGAFAP1(.ORDATA,.ORINPUT)
83 S ORY=($G(ORDATA(1))="[DATA]")
84 Q
85FORCE(ORY,USER,LOC) ; Retrieve FORCE GUI PCE Entry for a given User/Location
86 N SRV,ORTMP,ORERR
87 S USER=$G(USER,DUZ)
88 S SRV=$P($G(^VA(200,USER,5)),U)
89 D GETLST^XPAR(.ORTMP,"USR^LOC.`"_$G(LOC)_"^SRV.`"_+$G(SRV)_"^DIV^SYS^PKG","ORWPCE FORCE PCE ENTRY","Q",.ORERR)
90 S ORY=+$P($G(ORTMP(1)),U,2)
91 Q
92HASCPT(ORY,ORLIST) ; Returns true if there are any mapped CPT Codes
93 N IEN,IDX,FOUND
94 S IDX=0
95 F S IDX=$O(ORLIST(IDX)) Q:'+IDX D
96 . S FOUND=0
97 . S IEN=$$FIND1^DIC(811.1,"","QX",ORLIST(IDX))
98 . I +IEN S FOUND=+$$GET1^DIQ(811.1,IEN,.05,"I")
99 . S ORY(IDX)=ORLIST(IDX)_"="_FOUND
100 Q
101ASKPCE(ORY,USER,LOC) ; Returns ORWPCE ASK ENCOUNTER UPDATE parameter value
102 N SRV,ORTMP,ORERR
103 S USER=$G(USER,DUZ)
104 S SRV=$P($G(^VA(200,USER,5)),U)
105 D GETLST^XPAR(.ORTMP,"USR^LOC.`"_$G(LOC)_"^SRV.`"_+$G(SRV)_"^DIV^SYS^PKG","ORWPCE ASK ENCOUNTER UPDATE","Q",.ORERR)
106 S ORY=+$P($G(ORTMP(1)),U,2)
107 Q
108GAFURL(URL) ;Returns the MH GAF Web Page URL
109 S URL=""
110 I $T(GAFURL^YTAPI5)'="" D
111 .N ORY
112 .D GAFURL^YTAPI5(.ORY)
113 .I $G(ORY(1))="[DATA]" S URL=$G(ORY(2))
114 Q
115MHTESTOK(ORY) ; Returns True if all supporting MH Test APIs exist
116 D GAFOK(.ORY)
117 I +ORY,+$G(DUZ),$T(SAVEIT^YTAPI1)'="",$T(PREVIEW^YTAPI4)'="",$T(SHOWALL^YTAPI3)'="",$T(LISTONE^YTAPI)'="",$T(MHS^PXRMRPCC)'="",$T(MHR^PXRMRPCC)'="",$T(MH^PXRMRPCC)'="" D
118 . N SRV
119 . S SRV=$P($G(^VA(200,DUZ,5)),U)
120 . S ORY=$$GET^XPAR(DUZ_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS","PXRM MENTAL HEALTH ACTIVE",1,"Q")
121 . I +ORY S ORY=1
122 Q
123MHATHRZD(ORY,TEST,USER) ;Indicates that user can score test
124 N ORYS,ORANS
125 I $T(PRIVL^YTAPI5)="" S ORY=1 Q
126 S ORY=0
127 S ORYS("CODE")=TEST
128 S ORYS("STAFF")=USER
129 D PRIVL^YTAPI5(.ORANS,.ORYS)
130 I $G(ORANS(1))="[DATA]" S ORY=+$P($G(ORANS(2)),U,1)
131 Q
132ANYTIME(ORY) ;Returns status of the ORWPCE ANYTIME ENCOUNTERS parameter
133 N SRV
134 S SRV=$P($G(^VA(200,DUZ,5)),U)
135 S ORY=$$GET^XPAR(DUZ_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS","ORWPCE ANYTIME ENCOUNTERS",1,"Q")
136 I +ORY S ORY=1
137 Q
138AUTOVSIT(ORY,LOC) ; Returns TRUE if automatic selection of Visit Type
139 N SRV
140 S SRV=$P($G(^VA(200,DUZ,5)),U)
141 S ORY=$$GET^XPAR(DUZ_";VA(200,^LOC.`"_$G(LOC)_"^SRV.`"_+$G(SRV)_"^DIV^SYS","ORWPCE DISABLE AUTO VISIT TYPE",1,"Q")
142 I +ORY S ORY=1
143 S ORY='ORY
144 Q
145DOCHKOUT(ORY,LOC) ; Returns TRUE if automatic selection of Visit Type
146 N SRV
147 S SRV=$P($G(^VA(200,DUZ,5)),U)
148 S ORY=$$GET^XPAR(DUZ_";VA(200,^LOC.`"_$G(LOC)_"^SRV.`"_+$G(SRV)_"^DIV^SYS","ORWPCE DISABLE AUTO CHECKOUT",1,"Q")
149 I +ORY S ORY=1
150 S ORY='ORY
151 Q
152CHKOUT(LOC) ; Returns TRUE if automatic selection of Visit Type
153 N ORY
154 D DOCHKOUT(.ORY,LOC)
155 Q ORY
156EXCLUDED(ORY,LOC,TYPE) ; Returns list of excluded PCE data elements
157 N SRV,PARAM
158 S PARAM=$S(TYPE=1:"IMMUNIZATIONS",TYPE=2:"SKIN TESTS",TYPE=3:"PATIENT ED",TYPE=4:"HEALTH FACTORS",TYPE=5:"EXAMS",1:"")
159 Q:PARAM=""
160 S SRV=$P($G(^VA(200,DUZ,5)),U)
161 S PARAM="ORWPCE EXCLUDE "_PARAM
162 D GETLST^XPAR(.ORY,"USR^LOC.`"_$G(LOC)_"^SRV.`"_+$G(SRV)_"^DIV^SYS^PKG",PARAM,"Q",.ORERR)
163 Q
164ISCLINIC(ORY,ORLOC) ; Returns TRUE if location is a clinic
165 N ORTYP
166 S ORY=0
167 S ORTYP=$$GET1^DIQ(44,+ORLOC,2,"I")
168 I (ORTYP="C")!(ORTYP="M") S ORY=1
169 Q
170HNCOK(ORY) ; Returns true if Head and/or Neck Cancer is enabled
171 S ORY=0
172 I $$PATCH^XPDUTL("DG*5.3*397"),$$PATCH^XPDUTL("SD*5.3*244"),$$PATCH^XPDUTL("PX*1.0*111"),$$PATCH^XPDUTL("IVM*2.0*46") S ORY=1
173 Q
174 ;
175CODACTIV(ORY,ORCODE,ORAPP,ORDATE) ; Is code active on the given date?
176 ; Remote procedure: ORWPCE ACTIVE CODE
177 ; ORCODE = ICD or CPT code to be checked
178 ; ORAPP = "ICD" or "CHP"
179 ; ORDATE = Date to be checked (defaults to current date)
180 S:'+$G(ORDATE) ORDATE=DT
181 S ORY=1
182 I ORAPP="ICD" D
183 . S ORY=+$$STATCHK^ICDAPIU(ORCODE,ORDATE)
184 E I ORAPP="CHP" D
185 . S ORY=+$$STATCHK^ICPTAPIU(ORCODE,ORDATE)
186 Q
187ICDACTIV(ORCODE,ORDATE) ; Check for active ICD code
188 D CODACTIV(.ORY,ORCODE,"ICD",$G(ORDATE))
189 Q +ORY
190CPTACTIV(ORCODE,ORDATE) ; Check for active CPT code
191 D CODACTIV(.ORY,ORCODE,"CHP",$G(ORDATE))
192 Q +ORY
193CXNOSHOW(ORY,ORDOCIEN) ; Should workload requirement be skipped for this note's visit?
194 ; RETURN VALUE: 0=SKIP ALL GUI WORKLOAD REQUIREMENTS
195 ; 1=CONTINUE WITH OTHER GUI WORKLOAD LOGIC
196 N ORTIU
197 D DOCPARM^TIUSRVP1(.ORTIU,ORDOCIEN) ; DBIA #4331
198 S ORY=+$$CHKWKL^TIUPXAP2(ORDOCIEN,ORTIU(0)) ; DBIA #4332
199 Q
Note: See TracBrowser for help on using the repository browser.