- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOZ09.m
r613 r623 1 OCXOZ09 ;SLC/RJS,CLA - Order Check Scan ;NOV 8,2009 at 18:442 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221,243**;Dec 17,1997;Build 242 3 4 5 6 7 8 9 10 11 12 13 CHK188 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 CHK192 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 CHK196 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 S OCXDF(73)=$P($G(OCXPSD),"|",1) I $L(OCXDF(73)) S OCXDF(67)=$$CM^ORQQRA(OCXDF(73)) I $L(OCXDF(67)),$$CLIST(OCXDF(67),"M,I,N") S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) D CHK458^OCXOZ0F65 66 67 68 CHK198 69 70 71 72 73 74 75 76 77 I ($E(OCXDF(2),1,2)="PS") D CHK360^OCXOZ0D78 79 80 CHK199 81 82 83 84 85 86 87 88 89 90 91 92 93 CHK201 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 CHK207 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 CHK211 131 132 133 134 135 136 137 138 139 140 141 ALRGY(ORPT) 142 143 144 145 146 147 148 CLIST(DATA,LIST) 149 150 151 152 153 CONTRANS(OCXC) 154 155 156 157 158 159 160 161 162 163 164 165 EQTERM(DATA,TERM) 166 167 168 169 170 171 172 173 174 FILE(DFN,OCXELE,OCXDFL) 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 MTSTF(OILIST) 190 191 192 193 194 195 196 197 198 199 200 RECBAR(DFN,HOURS) 201 202 203 204 205 TERMLKUP(OCXTERM,OCXLIST) 206 207 1 OCXOZ09 ;SLC/RJS,CLA - Order Check Scan ;DEC 27,2007 at 06:00 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221**;Dec 17,1997 3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998 4 ; 5 ; *************************************************************** 6 ; ** Warning: This routine is automatically generated by the ** 7 ; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine ** 8 ; ** will be lost the next time the rule compiler executes. ** 9 ; *************************************************************** 10 ; 11 Q 12 ; 13 CHK188 ; Look through the current environment for valid Event/Elements for this patient. 14 ; Called from CHK58+19^OCXOZ05. 15 ; 16 Q:$G(OCXOERR) 17 ; 18 ; Local CHK188 Variables 19 ; OCXDF(2) ----> Data Field: FILLER (FREE TEXT) 20 ; OCXDF(40) ---> Data Field: ORDER MODE (FREE TEXT) 21 ; OCXDF(47) ---> Data Field: OI LOCAL TEXT (FREE TEXT) 22 ; 23 ; Local Extrinsic Functions 24 ; CLIST( -----------> STRING CONTAINS ONE OF A LIST OF VALUES 25 ; EQTERM( ----------> EQUALS TERM OPERATOR 26 ; 27 I $$EQTERM(OCXDF(47),"ANGIOGRAM (PERIPHERAL)") S OCXDF(40)=$G(OCXPSM) I $L(OCXDF(40)),(OCXDF(40)="SESSION") D CHK192 28 I $$CLIST(OCXDF(47),"GLUCOPHAGE,METFORMIN") S OCXDF(40)=$G(OCXPSM) I $L(OCXDF(40)),(OCXDF(40)="SELECT") S OCXDF(2)=$P($G(OCXPSD),"|",2) I $L(OCXDF(2)) D CHK280^OCXOZ0B 29 Q 30 ; 31 CHK192 ; Look through the current environment for valid Event/Elements for this patient. 32 ; Called from CHK188+14. 33 ; 34 Q:$G(OCXOERR) 35 ; 36 ; Local CHK192 Variables 37 ; OCXDF(68) ---> Data Field: MISSING ANGIOGRAM, CATH PERIF LAB TESTS (FREE TEXT) 38 ; 39 ; Local Extrinsic Functions 40 ; FILE(DFN,65, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: SESSION ORDER FOR ANGIOGRAM) 41 ; MTSTF( -----------> MISSING TESTS DURING SESSION 42 ; 43 S OCXDF(68)=$$MTSTF("PROTHROMBIN TIME,PARTIAL THROMBOPLASTIN TIME") I $L(OCXDF(68)),($L(OCXDF(68))>0) S OCXOERR=$$FILE(DFN,65,"68") Q:OCXOERR 44 Q 45 ; 46 CHK196 ; Look through the current environment for valid Event/Elements for this patient. 47 ; Called from CHK163+13^OCXOZ07. 48 ; 49 Q:$G(OCXOERR) 50 ; 51 ; Local CHK196 Variables 52 ; OCXDF(2) ----> Data Field: FILLER (FREE TEXT) 53 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC) 54 ; OCXDF(67) ---> Data Field: CONTRAST MEDIA CODE (FREE TEXT) 55 ; OCXDF(73) ---> Data Field: ORDERABLE ITEM IEN (NUMERIC) 56 ; OCXDF(156) --> Data Field: ALLERGY ASSESSMENT (BOOLEAN) 57 ; 58 ; Local Extrinsic Functions 59 ; ALRGY( -----------> ALLERGY ASSESSMENT 60 ; CLIST( -----------> STRING CONTAINS ONE OF A LIST OF VALUES 61 ; FILE(DFN,136, ----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: NO ALLERGY ASSESSMENT) 62 ; 63 S OCXDF(2)=$P($G(OCXPSD),"|",2) I $L(OCXDF(2)) D CHK198 64 S OCXDF(73)=$P($G(OCXPSD),"|",1) I $L(OCXDF(73)) S OCXDF(67)=$$CM^ORQQRA(OCXDF(73)) I $L(OCXDF(67)),$$CLIST(OCXDF(67),"M,I,N") S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) D CHK466^OCXOZ0F 65 S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXDF(156)=$$ALRGY(OCXDF(37)) I $L(OCXDF(156)),'(OCXDF(156)) S OCXOERR=$$FILE(DFN,136,"") Q:OCXOERR 66 Q 67 ; 68 CHK198 ; Look through the current environment for valid Event/Elements for this patient. 69 ; Called from CHK196+17. 70 ; 71 Q:$G(OCXOERR) 72 ; 73 ; Local CHK198 Variables 74 ; OCXDF(2) ----> Data Field: FILLER (FREE TEXT) 75 ; 76 I (OCXDF(2)="RA") D CHK199 77 I ($E(OCXDF(2),1,2)="PS") D CHK362^OCXOZ0D 78 Q 79 ; 80 CHK199 ; Look through the current environment for valid Event/Elements for this patient. 81 ; Called from CHK198+8. 82 ; 83 Q:$G(OCXOERR) 84 ; 85 ; Local CHK199 Variables 86 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC) 87 ; OCXDF(73) ---> Data Field: ORDERABLE ITEM IEN (NUMERIC) 88 ; 89 S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) D CHK201 90 S OCXDF(73)=$P($G(OCXPSD),"|",1) I $L(OCXDF(73)) D CHK236^OCXOZ0A 91 Q 92 ; 93 CHK201 ; Look through the current environment for valid Event/Elements for this patient. 94 ; Called from CHK199+9. 95 ; 96 Q:$G(OCXOERR) 97 ; 98 ; Local CHK201 Variables 99 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC) 100 ; OCXDF(65) ---> Data Field: CONTRAST MEDIA ALLERGY FLAG (BOOLEAN) 101 ; OCXDF(67) ---> Data Field: CONTRAST MEDIA CODE (FREE TEXT) 102 ; OCXDF(69) ---> Data Field: RECENT BARIUM STUDY FLAG (BOOLEAN) 103 ; OCXDF(73) ---> Data Field: ORDERABLE ITEM IEN (NUMERIC) 104 ; 105 ; Local Extrinsic Functions 106 ; RECBAR( ----------> RECENT BARIUM STUDY 107 ; 108 S OCXDF(65)=$$ORCHK^GMRAOR(OCXDF(37),"CM","") I $L(OCXDF(65)),(OCXDF(65)) S OCXDF(73)=$P($G(OCXPSD),"|",1) I $L(OCXDF(73)) S OCXDF(67)=$$CM^ORQQRA(OCXDF(73)) D CHK207 109 S OCXDF(69)=$P($$RECBAR(OCXDF(37),48),"^",1) I $L(OCXDF(69)),(OCXDF(69)) S OCXDF(73)=$P($G(OCXPSD),"|",1) I $L(OCXDF(73)) S OCXDF(67)=$$CM^ORQQRA(OCXDF(73)) D CHK217^OCXOZ0A 110 Q 111 ; 112 CHK207 ; Look through the current environment for valid Event/Elements for this patient. 113 ; Called from CHK201+15. 114 ; 115 Q:$G(OCXOERR) 116 ; 117 ; Local CHK207 Variables 118 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC) 119 ; OCXDF(66) ---> Data Field: CONTRAST MEDIA CODE TRANSLATION (FREE TEXT) 120 ; OCXDF(67) ---> Data Field: CONTRAST MEDIA CODE (FREE TEXT) 121 ; OCXDF(159) --> Data Field: ALLERGY CONTRAST MEDIA LOCATION (FREE TEXT) 122 ; 123 ; Local Extrinsic Functions 124 ; CLIST( -----------> STRING CONTAINS ONE OF A LIST OF VALUES 125 ; CONTRANS( --------> CONTRAST MEDIA CODE TRANSLATION 126 ; 127 I $L(OCXDF(67)),$$CLIST(OCXDF(67),"M,I,N,L,C,G,B") S OCXDF(66)=$$CONTRANS(OCXDF(67)),OCXDF(159)=$P($$ORCHK^GMRAOR(OCXDF(37),"CM","",1),"^",2) D CHK211 128 Q 129 ; 130 CHK211 ; Look through the current environment for valid Event/Elements for this patient. 131 ; Called from CHK207+15. 132 ; 133 Q:$G(OCXOERR) 134 ; 135 ; Local Extrinsic Functions 136 ; FILE(DFN,66, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: CONTRAST MEDIA ALLERGY) 137 ; 138 S OCXOERR=$$FILE(DFN,66,"66,159") Q:OCXOERR 139 Q 140 ; 141 ALRGY(ORPT) ; determine if pt has an allergy assessment 142 ; rtn 0 if no allergy assessment, 1 if allergy assessment or NKA 143 N ORALRGY 144 D EN1^GMRAOR1(ORPT,"ORALRGY") 145 Q:$G(ORALRGY)="" 0 146 Q 1 147 ; 148 CLIST(DATA,LIST) ; DOES THE DATA FIELD CONTAIN AN ELEMENT IN THE LIST 149 ; 150 N PC F PC=1:1:$L(LIST,","),0 I PC,$L($P(LIST,",",PC)),(DATA[$P(LIST,",",PC)) Q 151 Q ''PC 152 ; 153 CONTRANS(OCXC) ; Compiler Function: CONTRAST MEDIA CODE TRANSLATION 154 ; 155 N OCXX 156 Q:'$L($G(OCXC)) "" S OCXX=$S((OCXC["B"):"Barium",1:"") 157 I (OCXC["G") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Gastrografin" 158 I (OCXC["I") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Ionic Iodinated" 159 I (OCXC["N") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Non-ionic Iodinated" 160 I (OCXC["L") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Gadolinium" 161 I (OCXC["C") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Cholecystographic" 162 I (OCXC["M") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Unspecified contrast media" 163 Q OCXX 164 ; 165 EQTERM(DATA,TERM) ; Compiler Function: EQUALS TERM OPERATOR 166 ; 167 N OCXF,OCXL 168 ; 169 S OCXL="",OCXF=$$TERMLKUP(TERM,.OCXL) 170 Q:'OCXF 0 171 I ($D(OCXL(DATA))!$D(OCXL("B",DATA))) Q 1 172 Q 0 173 ; 174 FILE(DFN,OCXELE,OCXDFL) ; This Local Extrinsic Function logs a validated event/element. 175 ; 176 N OCXTIMN,OCXTIML,OCXTIMT1,OCXTIMT2,OCXDATA,OCXPC,OCXPC,OCXVAL,OCXSUB,OCXDFI 177 S DFN=+$G(DFN),OCXELE=+$G(OCXELE) 178 ; 179 Q:'DFN 1 Q:'OCXELE 1 K OCXDATA 180 ; 181 S OCXDATA(DFN,OCXELE)=1 182 F OCXPC=1:1:$L(OCXDFL,",") S OCXDFI=$P(OCXDFL,",",OCXPC) I OCXDFI D 183 .S OCXVAL=$G(OCXDF(+OCXDFI)),OCXDATA(DFN,OCXELE,+OCXDFI)=OCXVAL 184 ; 185 M ^TMP("OCXCHK",$J,DFN)=OCXDATA(DFN) 186 ; 187 Q 0 188 ; 189 MTSTF(OILIST) ; Compiler Function: MISSING TESTS DURING SESSION 190 ; 191 N OCXPC,OCXOI,OCXOUT S OCXOUT="" 192 F OCXPC=1:1:$L(OILIST,",") S OCXOI=$P(OILIST,",",OCXPC) I $L(OCXOI) D 193 .N OCXL,OCXF,OCXD0 194 .S OCXL="",OCXF=$$TERMLKUP(OCXOI,.OCXL) 195 .S OCXD0=0 F S OCXD0=$O(OCXL(OCXD0)) Q:'OCXD0 Q:$$OISESS^ORKCHK2(+OCXD0) 196 .Q:OCXD0 197 .S:$L(OCXOUT) OCXOUT=OCXOUT_", " S OCXOUT=OCXOUT_OCXOI 198 Q OCXOUT 199 ; 200 RECBAR(DFN,HOURS) ; Compiler Function: RECENT BARIUM STUDY 201 ; 202 Q:'$G(DFN) 0 Q:'$G(HOURS) 0 N OUT S OUT=$$RECENTBA^ORKRA(DFN,HOURS) Q:'$L(OUT) 0 Q 1_U_OUT 203 ; 204 ; 205 TERMLKUP(OCXTERM,OCXLIST) ; 206 Q $$TERM^OCXOZ01(OCXTERM,.OCXLIST) 207 ;
Note:
See TracChangeset
for help on using the changeset viewer.