- 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/OCXOZ08.m
r613 r623 1 OCXOZ08 ;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 CHK164 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 S OCXDF(2)=$P($G(OCXPSD),"|",2) I $L(OCXDF(2)),($E(OCXDF(2),1,2)="PS") S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXDF(62)=$$AGE^ORQPTQ4(OCXDF(37)) I $L(OCXDF(62)) D CHK426^OCXOZ0E30 31 32 CHK171 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 CHK176 51 52 53 54 55 56 57 58 59 60 61 CHK182 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 CHK186 85 86 87 88 89 90 91 92 93 94 95 CH(OCXOI) 96 97 98 99 CRCL(DFN) 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 FILE(DFN,OCXELE,OCXDFL) 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 FLAB(DFN,OCXLIST,OCXSPEC) 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 RECCH(DFN,DAYS) 179 180 181 182 RECCHST(DFN,DAYS) 183 184 185 186 187 188 189 TERMLKUP(OCXTERM,OCXLIST) 190 191 1 OCXOZ08 ;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 CHK164 ; Look through the current environment for valid Event/Elements for this patient. 14 ; Called from CHK163+11^OCXOZ07. 15 ; 16 Q:$G(OCXOERR) 17 ; 18 ; Local CHK164 Variables 19 ; OCXDF(2) ----> Data Field: FILLER (FREE TEXT) 20 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC) 21 ; OCXDF(59) ---> Data Field: CHOLECYSTOGRAM PROCEDURE FLAG (BOOLEAN) 22 ; OCXDF(62) ---> Data Field: PATIENT AGE (NUMERIC) 23 ; OCXDF(73) ---> Data Field: ORDERABLE ITEM IEN (NUMERIC) 24 ; 25 ; Local Extrinsic Functions 26 ; CH( --------------> IS THIS A CHOLECYSTOGRAM RADIOLOGY PROCEDURE 27 ; 28 S OCXDF(73)=$P($G(OCXPSD),"|",1) I $L(OCXDF(73)) S OCXDF(59)=$P($$CH(OCXDF(73)),"^",1) I $L(OCXDF(59)),(OCXDF(59)) S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) D CHK171 29 S OCXDF(2)=$P($G(OCXPSD),"|",2) I $L(OCXDF(2)),($E(OCXDF(2),1,2)="PS") S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXDF(62)=$$AGE^ORQPTQ4(OCXDF(37)) I $L(OCXDF(62)) D CHK434^OCXOZ0E 30 Q 31 ; 32 CHK171 ; Look through the current environment for valid Event/Elements for this patient. 33 ; Called from CHK164+15. 34 ; 35 Q:$G(OCXOERR) 36 ; 37 ; Local CHK171 Variables 38 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC) 39 ; OCXDF(60) ---> Data Field: RECENT CHOLECYSTOGRAM FLAG (BOOLEAN) 40 ; OCXDF(61) ---> Data Field: RECENT CHOLECYSTOGRAM TEXT (FREE TEXT) 41 ; OCXDF(122) --> Data Field: RECENT CHOLECYSTOGRAM ORDER STATUS (FREE TEXT) 42 ; 43 ; Local Extrinsic Functions 44 ; RECCH( -----------> RECENT CHOLECYSTOGRAM PREOCEDURE 45 ; RECCHST( ---------> RECENT CHOLECYSTOGRAM ORDER STATUS 46 ; 47 S OCXDF(60)=$P($$RECCH(OCXDF(37),7),"^",1) I $L(OCXDF(60)),(OCXDF(60)) S OCXDF(61)=$P($$RECCH(OCXDF(37),7),"^",3),OCXDF(122)=$P($$RECCHST(OCXDF(37),7),"^",2) D CHK176 48 Q 49 ; 50 CHK176 ; Look through the current environment for valid Event/Elements for this patient. 51 ; Called from CHK171+15. 52 ; 53 Q:$G(OCXOERR) 54 ; 55 ; Local Extrinsic Functions 56 ; FILE(DFN,63, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: PATIENT HAS RECENT CHOLECYSTOGRAM) 57 ; 58 S OCXOERR=$$FILE(DFN,63,"61,122") Q:OCXOERR 59 Q 60 ; 61 CHK182 ; Look through the current environment for valid Event/Elements for this patient. 62 ; Called from CHK163+12^OCXOZ07. 63 ; 64 Q:$G(OCXOERR) 65 ; 66 ; Local CHK182 Variables 67 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC) 68 ; OCXDF(62) ---> Data Field: PATIENT AGE (NUMERIC) 69 ; OCXDF(64) ---> Data Field: FORMATTED RENAL LAB RESULTS (FREE TEXT) 70 ; OCXDF(76) ---> Data Field: CREATININE CLEARANCE (ESTIM) VALUE (NUMERIC) 71 ; OCXDF(109) --> Data Field: NUMBER OF MEDS (NUMERIC) 72 ; OCXDF(123) --> Data Field: POLYPHARMACY (BOOLEAN) 73 ; 74 ; Local Extrinsic Functions 75 ; CRCL( ------------> CREATININE CLEARANCE (ESTIMATED/CALCULATED) 76 ; FILE(DFN,95, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: POLYPHARMACY) 77 ; FLAB( ------------> FORMATTED LAB RESULTS 78 ; 79 S OCXDF(62)=$$AGE^ORQPTQ4(OCXDF(37)) I $L(OCXDF(62)),(OCXDF(62)>65) S OCXDF(64)=$$FLAB(OCXDF(37),"SERUM CREATININE^SERUM UREA NITROGEN","SERUM SPECIMEN") D CHK186 80 S OCXDF(76)=$P($$CRCL(OCXDF(37)),"^",2) I $L(OCXDF(76)),(OCXDF(76)<50),(OCXDF(76)>0) D CHK247^OCXOZ0B 81 S OCXDF(123)=$P($$POLYRX^ORKPS(OCXDF(37)),"^",1) I $L(OCXDF(123)),(OCXDF(123)) S OCXDF(109)=$P($$NUMRX^ORKPS(OCXDF(37)),"^",1),OCXOERR=$$FILE(DFN,95,"109") Q:OCXOERR 82 Q 83 ; 84 CHK186 ; Look through the current environment for valid Event/Elements for this patient. 85 ; Called from CHK182+18. 86 ; 87 Q:$G(OCXOERR) 88 ; 89 ; Local Extrinsic Functions 90 ; FILE(DFN,64, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: PHARMACY PATIENT OVER 65) 91 ; 92 S OCXOERR=$$FILE(DFN,64,"64") Q:OCXOERR 93 Q 94 ; 95 CH(OCXOI) ; Compiler Function: IS THIS A CHOLECYSTOGRAM RADIOLOGY PROCEDURE 96 ; 97 N OCXVAL S OCXVAL=$$CM^ORQQRA(OCXOI) Q:(OCXVAL["C") 1_U_OCXVAL Q 0 98 ; 99 CRCL(DFN) ; Compiler Function: CREATININE CLEARANCE (ESTIMATED/CALCULATED) 100 ; 101 N HT,AGE,SEX,SCR,SCRD,CRCL,LRWKLD,RSLT,ORW,ORH,PSCR 102 N HTGT60,ABW,IBW,BWRATIO,BWDIFF,LOWBW,ADJBW 103 S RSLT="0^<Unavailable>" 104 S PSCR="^^^^^^0" 105 D VITAL^ORQQVI("WEIGHT","WT",DFN,.ORW,0,"",$$NOW^XLFDT) 106 Q:'$D(ORW) RSLT 107 S ABW=$P(ORW(1),U,3) Q:+$G(ABW)<1 RSLT 108 S ABW=ABW/2.2 ;ABW (actual body weight) in kg 109 D VITAL^ORQQVI("HEIGHT","HT",DFN,.ORH,0,"",$$NOW^XLFDT) 110 Q:'$D(ORH) RSLT 111 S HT=$P(ORH(1),U,3) Q:+$G(HT)<1 RSLT 112 S AGE=$$AGE^ORQPTQ4(DFN) Q:'AGE RSLT 113 S SEX=$P($$SEX^ORQPTQ4(DFN),U,1) Q:'$L(SEX) RSLT 114 S OCXTL="" Q:'$$TERMLKUP^ORB31(.OCXTL,"SERUM CREATININE") RSLT 115 S OCXTLS="" Q:'$$TERMLKUP^ORB31(.OCXTLS,"SERUM SPECIMEN") RSLT 116 S SCR="",OCXT=0 F S OCXT=$O(OCXTL(OCXT)) Q:'OCXT D 117 .S OCXTS=0 F S OCXTS=$O(OCXTLS(OCXTS)) Q:'OCXTS D 118 ..S SCR=$$LOCL^ORQQLR1(DFN,$P(OCXTL(OCXT),U),$P(OCXTLS(OCXTS),U)) 119 ..I $P(SCR,U,7)>$P(PSCR,U,7) S PSCR=SCR 120 S SCR=PSCR,SCRV=$P(SCR,U,3) Q:+$G(SCRV)<.01 RSLT 121 S SCRD=$P(SCR,U,7) Q:'$L(SCRD) RSLT 122 ; 123 S HTGT60=$S(HT>60:(HT-60)*2.3,1:0) ;if ht > 60 inches 124 I HTGT60>0 D 125 .S IBW=$S(SEX="M":50+HTGT60,1:45.5+HTGT60) ;Ideal Body Weight 126 .S BWRATIO=(ABW/IBW) ;body weight ratio 127 .S BWDIFF=$S(ABW>IBW:ABW-IBW,1:0) 128 .S LOWBW=$S(IBW<ABW:IBW,1:ABW) 129 .I BWRATIO>1.3,(BWDIFF>0) S ADJBW=((0.3*BWDIFF)+IBW) 130 .E S ADJBW=LOWBW 131 I +$G(ADJBW)<1 D 132 .S ADJBW=ABW 133 S CRCL=(((140-AGE)*ADJBW)/(SCRV*72)) 134 ; 135 S:SEX="M" RSLT=SCRD_U_$J(CRCL,1,1) 136 S:SEX="F" RSLT=SCRD_U_$J((CRCL*.85),1,1) 137 Q RSLT 138 ; 139 FILE(DFN,OCXELE,OCXDFL) ; This Local Extrinsic Function logs a validated event/element. 140 ; 141 N OCXTIMN,OCXTIML,OCXTIMT1,OCXTIMT2,OCXDATA,OCXPC,OCXPC,OCXVAL,OCXSUB,OCXDFI 142 S DFN=+$G(DFN),OCXELE=+$G(OCXELE) 143 ; 144 Q:'DFN 1 Q:'OCXELE 1 K OCXDATA 145 ; 146 S OCXDATA(DFN,OCXELE)=1 147 F OCXPC=1:1:$L(OCXDFL,",") S OCXDFI=$P(OCXDFL,",",OCXPC) I OCXDFI D 148 .S OCXVAL=$G(OCXDF(+OCXDFI)),OCXDATA(DFN,OCXELE,+OCXDFI)=OCXVAL 149 ; 150 M ^TMP("OCXCHK",$J,DFN)=OCXDATA(DFN) 151 ; 152 Q 0 153 ; 154 FLAB(DFN,OCXLIST,OCXSPEC) ; Compiler Function: FORMATTED LAB RESULTS 155 ; 156 Q:'$G(DFN) "<Patient Not Specified>" 157 Q:'$L($G(OCXLIST)) "<Lab Tests Not Specified>" 158 N OCXLAB,OCXOUT,OCXPC,OCXSL,SPEC S OCXOUT="",SPEC="" 159 I $L($G(OCXSPEC)) S OCXSL=$$TERMLKUP(OCXSPEC,.OCXSL) 160 F OCXPC=1:1:$L(OCXLIST,U) S OCXLAB=$P(OCXLIST,U,OCXPC) I $L(OCXLAB) D 161 .N OCXX,OCXY,X,Y,DIC,TEST,SPEC,OCXTL,OCXA,OCXR 162 .S OCXTL="" Q:'$$TERMLKUP(OCXLAB,.OCXTL) 163 .S OCXX="",TEST=0 F S TEST=$O(OCXTL(TEST)) Q:'TEST D 164 ..I $L($G(OCXSL)) D 165 ...S SPEC=0 F S SPEC=$O(OCXSL(SPEC)) Q:'SPEC D 166 ....S OCXX=$$LOCL^ORQQLR1(DFN,TEST,SPEC) I $L(OCXX) D 167 .....S OCXA($P(OCXX,U,7))=OCXX 168 ..I '$L($G(OCXSL)) S OCXX=$$LOCL^ORQQLR1(DFN,TEST,"") 169 ..Q:'$L(OCXX) 170 .I $D(OCXA) S OCXR="",OCXR=$O(OCXA(OCXR),-1),OCXX=OCXA(OCXR) 171 .I $L(OCXX) D 172 ..S OCXY=$P(OCXX,U,2)_": "_$P(OCXX,U,3)_" "_$P(OCXX,U,4) 173 ..S OCXY=OCXY_" "_$S($L($P(OCXX,U,5)):"["_$P(OCXX,U,5)_"]",1:"") 174 ..I $L($P(OCXX,U,7)) S OCXY=OCXY_" "_$$FMTE^XLFDT($P(OCXX,U,7),"2P") 175 .S:$L(OCXOUT) OCXOUT=OCXOUT_" " S OCXOUT=OCXOUT_$G(OCXY) 176 Q:'$L(OCXOUT) "<Results Not Found>" Q OCXOUT 177 ; 178 RECCH(DFN,DAYS) ; Compiler Function: RECENT CHOLECYSTOGRAM PREOCEDURE 179 ; 180 Q:'$G(DFN) 0 Q:'$G(DAYS) 0 N OUT S OUT=$$RECENTCH^ORKRA(DFN,DAYS) Q:'$L(OUT) 0 Q 1_U_OUT 181 ; 182 RECCHST(DFN,DAYS) ; Compiler Function: RECENT CHOLECYSTOGRAM ORDER STATUS 183 ; 184 Q:'$G(DFN) 0 Q:'$G(DAYS) 0 185 N ORDER S ORDER=$P($$RECENTCH^ORKRA(DFN,DAYS),U) Q:'$L(ORDER) 0 186 N STATUS S STATUS=$P($$STATUS^ORQOR2(ORDER),U,2) Q:'$L(STATUS) 0 187 Q 1_U_STATUS 188 ; 189 TERMLKUP(OCXTERM,OCXLIST) ; 190 Q $$TERM^OCXOZ01(OCXTERM,.OCXLIST) 191 ;
Note:
See TracChangeset
for help on using the changeset viewer.
