- 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/ORWPS.m
r613 r623 1 ORWPS ; SLC/KCM/JLI/REV/CLA - Meds Tab; 02/11/2008 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,132,141,173,203,190,195,265,275,243**;Dec 17, 1997;Build 242 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 COVER(LST,DFN) ; retrieve meds for cover sheet 5 K ^TMP("PS",$J) 6 D OCL^PSOORRL(DFN,"","") 7 N ILST,ITMP,X S ILST=0 8 S ITMP="" F S ITMP=$O(^TMP("PS",$J,ITMP)) Q:'ITMP D 9 . S X=^TMP("PS",$J,ITMP,0) 10 . I '$L($P(X,U,2)) S X="??" ; show something if drug empty 11 . I $D(^TMP("PS",$J,ITMP,"CLINIC",0)) S LST($$NXT)=$P(X,U,1,2)_U_$P(X,U,8,9)_U_"C" 12 . E S LST($$NXT)=$P(X,U,1,2)_U_$P(X,U,8,9) 13 K ^TMP("PS",$J) 14 Q 15 DT(X) ; -- Returns FM date for X 16 N Y,%DT S %DT="T",Y="" D:X'="" ^%DT 17 Q Y 18 ; 19 ACTIVE(LST,DFN,USER,VIEW,UPDATE) ; retrieve active inpatient & outpatient meds 20 K ^TMP("PS",$J) 21 K ^TMP("ORACT",$J) 22 N BEG,END,ERROR,CTX,STVIEW 23 S (BEG,END,CTX)="" 24 S VIEW=+$G(VIEW) 25 S UPDATE=+$G(UPDATE) 26 I VIEW=0,UPDATE=0 S VIEW=1 27 S CTX=$$GET^XPAR("ALL","ORCH CONTEXT MEDS") 28 I CTX=";" D DEL^XPAR("USR.`"_DUZ,"ORCH CONTEXT MEDS") 29 S CTX=$$GET^XPAR("ALL","ORCH CONTEXT MEDS") 30 S BEG=$$DT($P(CTX,";")),END=$$DT($P(CTX,";",2)) 31 I +$G(USER)=0 S USER=DUZ 32 I UPDATE=1 D 33 .S STVIEW=$$GET^XPAR($G(USER)_";VA(200,","OR MEDS TAB SORT",1,"I") 34 .I VIEW>0,+STVIEW'=VIEW D PUT^XPAR(DUZ_";VA(200,","OR MEDS TAB SORT",,VIEW,.ERROR) S STVIEW=VIEW 35 .I VIEW=0,+STVIEW=0 D PUT^XPAR(DUZ_";VA(200,","OR MEDS TAB SORT",,"1",.ERROR) S STVIEW=1,VIEW=1 36 .I VIEW=0,+STVIEW'=VIEW S VIEW=+STVIEW 37 .S LST(0)=STVIEW 38 D OCL^PSOORRL(DFN,BEG,END,VIEW) 39 N ITMP,FIELDS,INSTRUCT,COMMENTS,REASON,NVSDT,TYPE,ILST,J S ILST=0 40 S ITMP="" F S ITMP=$O(^TMP("PS",$J,ITMP)) Q:'ITMP D 41 . K INSTRUCT,COMMENTS,REASON 42 . K ^TMP("ORACT",$J,"COMMENTS") 43 . S COMMENTS="^TMP(""ORACT"",$J,""COMMENTS"")" 44 . S (INSTRUCT,@COMMENTS)="",FIELDS=^TMP("PS",$J,ITMP,0) 45 . I +$P(FIELDS,"^",8),$D(^OR(100,+$P(FIELDS,"^",8),8,"C","XX")) D 46 . . S $P(^TMP("PS",$J,ITMP,0),"^",2)="*"_$P(^TMP("PS",$J,ITMP,0),"^",2) ;dan testing 47 . S TYPE=$S($P($P(FIELDS,U),";",2)="O":"OP",1:"UD") 48 . I $D(^TMP("PS",$J,ITMP,"CLINIC",0)) S TYPE="CP" 49 . N LOC,LOCEX S (LOC,LOCEX)="" 50 . I TYPE="CP" S LOC=$G(^TMP("PS",$J,ITMP,"CLINIC",0)) 51 . S:LOC LOCEX=$P($G(^SC(+LOC,0)),U)_":"_+LOC ;IMO NEW 52 . I TYPE="OP",$P(FIELDS,";")["N" S TYPE="NV" ;non-VA med 53 . I $O(^TMP("PS",$J,ITMP,"A",0))>0 S TYPE="IV" 54 . I $O(^TMP("PS",$J,ITMP,"B",0))>0 S TYPE="IV" 55 . I (TYPE="UD")!(TYPE="CP") D UDINST(.INSTRUCT,ITMP) 56 . I TYPE="OP" D OPINST(.INSTRUCT,ITMP) 57 . I TYPE="IV" D IVINST(.INSTRUCT,ITMP) 58 . I TYPE="NV" D NVINST(.INSTRUCT,ITMP),NVREASON(.REASON,.NVSDT,ITMP) 59 . I (TYPE="UD")!(TYPE="IV")!(TYPE="NV")!(TYPE="CP") D SETMULT(COMMENTS,ITMP,"SIO") 60 . M COMMENTS=@COMMENTS 61 . I $D(COMMENTS(1)) S COMMENTS(1)="\"_COMMENTS(1) 62 . S:TYPE="NV" $P(FIELDS,U,4)=$G(NVSDT) 63 . I LOC S LST($$NXT)="~CP:"_LOCEX_U_FIELDS 64 . E S LST($$NXT)="~"_TYPE_U_FIELDS 65 . S J=0 F S J=$O(INSTRUCT(J)) Q:'J S LST($$NXT)=INSTRUCT(J) 66 . S J=0 F S J=$O(COMMENTS(J)) Q:'J S LST($$NXT)="t"_COMMENTS(J) 67 . S J=0 F S J=$O(REASON(J)) Q:'J S LST($$NXT)="t"_REASON(J) 68 K ^TMP("PS",$J) 69 K ^TMP("ORACT",$J) 70 Q 71 NXT() ; increment ILST 72 S ILST=ILST+1 73 Q ILST 74 ; 75 UDINST(Y,INDEX) ; assembles instructions for a unit dose order 76 N I,X,RST 77 S X=^TMP("PS",$J,INDEX,0) 78 S RST="^TMP(""ORACT"",$J,""INSTRUCT"")" 79 S @RST@(1)=" "_$P(X,U,2),@RST=1 80 S X=$S($L($P(X,U,6)):$P(X,U,6),1:$P(X,U,7)) 81 I $L(X) S @RST=2,@RST@(2)=X 82 E S @RST=1 D SETMULT(.RST,INDEX,"SIG") 83 S @RST@(2)="\Give: "_$G(@RST@(2)),@RST=$G(@RST,2) 84 D SETMULT(RST,INDEX,"MDR"),SETMULT(RST,INDEX,"SCH") 85 F I=3:1:@RST S @RST@(I)=" "_@RST@(I) 86 M Y=@RST K @RST 87 Q 88 OPINST(Y,INDEX) ; assembles instructions for an outpatient prescription 89 N I,X,RST 90 S X=^TMP("PS",$J,INDEX,0) 91 S RST="^TMP(""ORACT"",$J,""INSTRUCT"")" 92 S @RST@(1)=" "_$P(X,U,2),@RST=1 93 I $L($P(X,U,12)) S @RST@(1)=@RST@(1)_" Qty: "_$P(X,U,12) 94 I $L($P(X,U,11)) S @RST@(1)=@RST@(1)_" for "_$P(X,U,11)_" days" 95 D SETMULT(RST,INDEX,"SIG") 96 I @RST=1 D 97 . D SETMULT(RST,INDEX,"SIO") 98 . D SETMULT(RST,INDEX,"MDR") 99 . D SETMULT(RST,INDEX,"SCH") 100 S @RST@(2)="\ Sig: "_$G(@RST@(2)) 101 F I=3:1:@RST S @RST@(I)=" "_@RST@(I) 102 M Y=@RST K @RST 103 Q 104 IVINST(Y,INDEX) ; assembles instructions for an IV order 105 N SOLN1,I,RST,IVDUR,CNT 106 S IVDUR="" 107 S RST="^TMP(""ORACT"",$J,""INSTRUCT"")" 108 S @RST=0 D SETMULT(RST,INDEX,"A") S SOLN1=@RST+1 109 D SETMULT(RST,INDEX,"B") 110 I $D(@RST@(SOLN1)),$L($P(FIELDS,U,2)) S @RST@(SOLN1)="in "_@RST@(SOLN1) 111 S SOLN1=@RST+1 112 S CNT=@RST 113 D SETMULT(RST,INDEX,"MDR") 114 I $D(^TMP("PS",$J,INDEX,"SCH",1,0)) S @RST@(@RST)=@RST@(@RST)_" "_^TMP("PS",$J,INDEX,"SCH",1,0) 115 F I=1:1:@RST S @RST@(I)="\"_$TR(@RST@(I),U," ") 116 I $D(@RST@(1)) S @RST@(1)=" "_$E(@RST@(1),2,999) 117 S @RST@(@RST)=@RST@(@RST)_" "_$P(^TMP("PS",$J,INDEX,0),U,3) 118 S:$D(^TMP("PS",$J,INDEX,"IVLIM",0)) IVDUR=$G(^TMP("PS",$J,INDEX,"IVLIM",0)) 119 I $L(IVDUR) D 120 . N DURU,DURV S DURU="",DURV=0 121 . I IVDUR["dose" D Q 122 . .S DURV=$P(IVDUR,"doses",2) 123 . .S IVDUR="for a total of "_+DURV_$S(+DURV=1:"dose",+DURV>1:" doses",1:" dose") 124 . .S @RST@(@RST)=@RST@(@RST)_" "_IVDUR 125 . S DURU=$E(IVDUR,1),DURV=$E(IVDUR,2,$L(IVDUR)) 126 . I (DURU="D")!(DURU="d") S IVDUR="for "_+DURV_$S(+DURV=1:" day",+DURV>1:" days",1:" day") 127 . I (DURU="H")!(DURU="h") S IVDUR="for "_+DURV_$S(+DURV=1:" hours",+DURV>1:" hours",1:" hour") 128 . I (DURU="M")!(DURU="m") S IVDUR="with total volume "_+DURV_" ml" 129 . I (DURU="L")!(DURU="l") S IVDUR="with total volume "_+DURV_" L" 130 . S @RST@(@RST)=@RST@(@RST)_" "_IVDUR 131 M Y=@RST K @RST 132 Q 133 NVINST(Y,INDEX) ; assembles instructions for a non-VA med 134 N I,X,RST 135 S X=^TMP("PS",$J,INDEX,0) 136 S RST="^TMP(""ORACT"",$J,""INSTRUCT"")" 137 S @RST@(1)=" "_$P(X,U,2),@RST=1 138 D SETMULT(RST,INDEX,"SIG") 139 I @RST=1 D 140 . D SETMULT(RST,INDEX,"SIO") 141 . D SETMULT(RST,INDEX,"MDR") 142 . D SETMULT(RST,INDEX,"SCH") 143 S @RST@(2)="\ "_$G(@RST@(2)) 144 F I=3:1:@RST S @RST@(I)=" "_@RST@(I) 145 M Y=@RST K @RST 146 Q 147 NVREASON(ORR,NVSDT,INDEX) ; assembles start date and reasons for a non-VA med 148 N ORI,J,X,ORN,ORA 149 S ORI=0 K ORR 150 S X=^TMP("PS",$J,INDEX,0) 151 S ORN=+$P(X,U,8) 152 I $D(^OR(100,ORN,0)) D 153 .S NVSDT=$P(^OR(100,ORN,0),U,8) 154 .D WPVAL^ORWDXR(.ORA,ORN,"STATEMENTS") I $D(ORA) D 155 ..S J=0 F S J=$O(ORA(J)) Q:J<1 S ORI=ORI+1,ORR(ORI)=ORA(J) 156 Q 157 SETMULT(Y,INDEX,SUB) ; appends the multiple at the subscript to Y 158 N I,X,J 159 S J=$G(@Y) 160 S I=0 F S I=$O(^TMP("PS",$J,INDEX,SUB,I)) Q:'I S X=$G(^(I,0)) D 161 . I SUB="B",$L($P(X,U,3)) S X=$P(X,U)_" "_$P(X,U,3)_"^"_$P(X,U,2) 162 . S J=J+1,@Y@(J)=X 163 S @Y=J 164 Q 165 COMPRESS(Y) ; concatenate Y subscripts into smallest possible number 166 N I,J,X S J=1,X(J)="" 167 S I=0 F S I=$O(Y(I)) Q:'I D 168 . I ($L(Y(I))+$L(X(J)))>245 S J=J+1,X(J)="" 169 . S X(J)=X(J)_$S($L(X(J)):" ",1:"")_Y(I) 170 K Y M Y=X 171 Q 172 DETAIL(ROOT,DFN,ID) ; -- show details for a med order 173 K ^TMP("ORXPND",$J) 174 N LCNT,ORVP 175 S LCNT=0,ORVP=DFN_";DPT(" 176 D MEDS^ORCXPND1 177 S ROOT=$NA(^TMP("ORXPND",$J)) 178 Q 179 MEDHIST(ORROOT,DFN,ORIFN) ; -- show admin history for a med (RV) 180 N ORPSID,HPIV,ISIV,CKPKG,ORPHMID 181 N CLINDISP,IVDIAL 182 S ORPSID=+$P($$OI^ORX8(ORIFN),U,3),ISIV=0,HPIV=0 183 S ORROOT=$NA(^TMP("ORHIST",$J)) K @ORROOT 184 S ORPHMID=$G(^OR(100,+ORIFN,4)) ;Pharmacy order number 185 S ISIV=$O(^ORD(100.98,"B","IV RX",ISIV)) 186 S HPIV=$O(^ORD(100.98,"B","TPN",HPIV)) 187 S CLINDISP=$O(^ORD(100.98,"B","C RX","")) 188 S IVDIAL=$O(^ORD(101.41,"B","PSJI OR PAT FLUID OE","")) 189 S CKPKG=$$PATCH^XPDUTL("PSB*2.0*19") 190 ;if the order is pending or the order has no pharmacy # 191 ;or the order is not in the Display Group IV MEDICATION 192 ; then use the Orderable item number to get the MAH. 193 I (ORPHMID["P")!(ORPHMID="") D Q 194 . I '$L($T(HISTORY^PSBMLHS)) D Q 195 . . S @ORROOT@(0)="This report is only available using BCMA version 2.0." 196 . D HISTORY^PSBMLHS(.ORROOT,DFN,ORPSID) ; DBIA #3459 for BCMA v2.0 197 ; If the order has a Display Group of IV MEDICATION the use the Pharmacy order number to get the MA 198 I ($P($G(^OR(100,+ORIFN,0)),U,11)=ISIV)!($P($G(^OR(100,+ORIFN,0)),U,11)=HPIV)!(($P($G(^OR(100,+ORIFN,0)),U,11)=CLINDISP)&(+$P($G(^OR(100,+ORIFN,0)),U,5)=IVDIAL)) D Q 199 . I 'CKPKG S @ORROOT@(0)="Medication Administration History is not available at this time for IV fluids." 200 . I CKPKG D 201 . . D RPC^PSBO(.ORROOT,"PM",DFN,"","","","","","","","","",ORPHMID) ;DBIA #3955 202 . . I '$D(@ORROOT) S @ORROOT@(0)="No Medication Administration History found for the IV order." 203 I '$L($T(HISTORY^PSBMLHS)) D Q 204 . S @ORROOT@(0)="This report is only available using BCMA version 2.0." 205 D HISTORY^PSBMLHS(.ORROOT,DFN,ORPSID) ; DBIA #3459 for BCMA v2.0 206 Q 207 ; 208 REASON(ORY) ; -- Return Non-VA Med Statement/Reasons 209 N ORE 210 D GETLST^XPAR(.ORY,"ALL","ORWD NONVA REASON","E") 211 Q 1 ORWPS ; SLC/KCM/JLI/REV/CLA - Meds Tab; 05/22/03 ; 5/18/07 10:18am 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,132,141,173,203,190,195,265,275**;Dec 17, 1997;Build 7 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 COVER(LST,DFN) ; retrieve meds for cover sheet 5 K ^TMP("PS",$J) 6 D OCL^PSOORRL(DFN,"","") ;DBIA #2400 7 N ILST,ITMP,X S ILST=0 8 S ITMP="" F S ITMP=$O(^TMP("PS",$J,ITMP)) Q:'ITMP D 9 . S X=^TMP("PS",$J,ITMP,0) 10 . I '$L($P(X,U,2)) S X="??" ; show something if drug empty 11 . I $D(^TMP("PS",$J,ITMP,"CLINIC",0)) S LST($$NXT)=$P(X,U,1,2)_U_$P(X,U,8,9)_U_"C" 12 . E S LST($$NXT)=$P(X,U,1,2)_U_$P(X,U,8,9) 13 K ^TMP("PS",$J) 14 Q 15 DT(X) ; -- Returns FM date for X 16 N Y,%DT S %DT="T",Y="" D:X'="" ^%DT 17 Q Y 18 ; 19 ACTIVE(LST,DFN) ; retrieve active inpatient & outpatient meds 20 K ^TMP("PS",$J) 21 K ^TMP("ORACT",$J) 22 N BEG,END,CTX 23 S (BEG,END,CTX)="" 24 S CTX=$$GET^XPAR("ALL","ORCH CONTEXT MEDS") 25 I CTX=";" D DEL^XPAR("USR.`"_DUZ,"ORCH CONTEXT MEDS") 26 S CTX=$$GET^XPAR("ALL","ORCH CONTEXT MEDS") 27 S BEG=$$DT($P(CTX,";")),END=$$DT($P(CTX,";",2)) 28 D OCL^PSOORRL(DFN,BEG,END) ;DBIA #2400 29 N ITMP,FIELDS,INSTRUCT,COMMENTS,REASON,NVSDT,TYPE,ILST,J S ILST=0 30 S ITMP="" F S ITMP=$O(^TMP("PS",$J,ITMP),-1) Q:'ITMP D 31 . K INSTRUCT,COMMENTS,REASON 32 . K ^TMP("ORACT",$J,"COMMENTS") 33 . S COMMENTS="^TMP(""ORACT"",$J,""COMMENTS"")" 34 . S (INSTRUCT,@COMMENTS)="",FIELDS=^TMP("PS",$J,ITMP,0) 35 . I +$P(FIELDS,"^",8),$D(^OR(100,+$P(FIELDS,"^",8),8,"C","XX")) D 36 . . S $P(^TMP("PS",$J,ITMP,0),"^",2)="*"_$P(^TMP("PS",$J,ITMP,0),"^",2) ;dan testing 37 . S TYPE=$S($P($P(FIELDS,U),";",2)="O":"OP",1:"UD") 38 . I $D(^TMP("PS",$J,ITMP,"CLINIC",0)) S TYPE="CP" 39 . N LOC,LOCEX S (LOC,LOCEX)="" 40 . I TYPE="CP" S LOC=$G(^TMP("PS",$J,ITMP,"CLINIC",0)) 41 . S:LOC LOCEX=$P($G(^SC(+LOC,0)),U)_":"_+LOC ;IMO NEW DBIA #964 42 . I TYPE="OP",$P(FIELDS,";")["N" S TYPE="NV" ;non-VA med 43 . I $O(^TMP("PS",$J,ITMP,"A",0))>0 S TYPE="IV" 44 . I $O(^TMP("PS",$J,ITMP,"B",0))>0 S TYPE="IV" 45 . I (TYPE="UD")!(TYPE="CP") D UDINST(.INSTRUCT,ITMP) 46 . I TYPE="OP" D OPINST(.INSTRUCT,ITMP) 47 . I TYPE="IV" D IVINST(.INSTRUCT,ITMP) 48 . I TYPE="NV" D NVINST(.INSTRUCT,ITMP),NVREASON(.REASON,.NVSDT,ITMP) 49 . I (TYPE="UD")!(TYPE="IV")!(TYPE="NV")!(TYPE="CP") D SETMULT(COMMENTS,ITMP,"SIO") 50 . M COMMENTS=@COMMENTS 51 . I $D(COMMENTS(1)) S COMMENTS(1)="\"_COMMENTS(1) 52 . S:TYPE="NV" $P(FIELDS,U,4)=$G(NVSDT) 53 . I LOC S LST($$NXT)="~CP:"_LOCEX_U_FIELDS 54 . E S LST($$NXT)="~"_TYPE_U_FIELDS 55 . S J=0 F S J=$O(INSTRUCT(J)) Q:'J S LST($$NXT)=INSTRUCT(J) 56 . S J=0 F S J=$O(COMMENTS(J)) Q:'J S LST($$NXT)="t"_COMMENTS(J) 57 . S J=0 F S J=$O(REASON(J)) Q:'J S LST($$NXT)="t"_REASON(J) 58 K ^TMP("PS",$J) 59 K ^TMP("ORACT",$J) 60 Q 61 NXT() ; increment ILST 62 S ILST=ILST+1 63 Q ILST 64 ; 65 UDINST(Y,INDEX) ; assembles instructions for a unit dose order 66 N I,X,RST 67 S X=^TMP("PS",$J,INDEX,0) 68 S RST="^TMP(""ORACT"",$J,""INSTRUCT"")" 69 S @RST@(1)=" "_$P(X,U,2),@RST=1 70 S X=$S($L($P(X,U,6)):$P(X,U,6),1:$P(X,U,7)) 71 I $L(X) S @RST=2,@RST@(2)=X 72 E S @RST=1 D SETMULT(.RST,INDEX,"SIG") 73 S @RST@(2)="\Give: "_$G(@RST@(2)),@RST=$G(@RST,2) 74 D SETMULT(RST,INDEX,"MDR"),SETMULT(RST,INDEX,"SCH") 75 F I=3:1:@RST S @RST@(I)=" "_@RST@(I) 76 M Y=@RST K @RST 77 Q 78 OPINST(Y,INDEX) ; assembles instructions for an outpatient prescription 79 N I,X,RST 80 S X=^TMP("PS",$J,INDEX,0) 81 S RST="^TMP(""ORACT"",$J,""INSTRUCT"")" 82 S @RST@(1)=" "_$P(X,U,2),@RST=1 83 I $L($P(X,U,12)) S @RST@(1)=@RST@(1)_" Qty: "_$P(X,U,12) 84 I $L($P(X,U,11)) S @RST@(1)=@RST@(1)_" for "_$P(X,U,11)_" days" 85 D SETMULT(RST,INDEX,"SIG") 86 I @RST=1 D 87 . D SETMULT(RST,INDEX,"SIO") 88 . D SETMULT(RST,INDEX,"MDR") 89 . D SETMULT(RST,INDEX,"SCH") 90 S @RST@(2)="\ Sig: "_$G(@RST@(2)) 91 F I=3:1:@RST S @RST@(I)=" "_@RST@(I) 92 M Y=@RST K @RST 93 Q 94 IVINST(Y,INDEX) ; assembles instructions for an IV order 95 N SOLN1,I,RST,IVDUR 96 S IVDUR="" 97 S RST="^TMP(""ORACT"",$J,""INSTRUCT"")" 98 S @RST=0 D SETMULT(RST,INDEX,"A") S SOLN1=@RST+1 99 D SETMULT(RST,INDEX,"B") 100 I $D(@RST@(SOLN1)),$L($P(FIELDS,U,2)) S @RST@(SOLN1)="in "_@RST@(SOLN1) 101 S SOLN1=@RST+1 102 D SETMULT(RST,INDEX,"SCH") S:$D(@RST@(SOLN1)) @RST@(SOLN1)=" "_@RST@(SOLN1) 103 F I=1:1:@RST S @RST@(I)="\"_$TR(@RST@(I),U," ") 104 I $D(@RST@(1)) S @RST@(1)=" "_$E(@RST@(1),2,999) 105 S @RST@(@RST)=@RST@(@RST)_" "_$P(^TMP("PS",$J,INDEX,0),U,3) 106 S:$D(^TMP("PS",$J,INDEX,"IVLIM",0)) IVDUR=$G(^TMP("PS",$J,INDEX,"IVLIM",0)) 107 I $L(IVDUR) D 108 . N DURU,DURV S DURU="",DURV=0 109 . S DURU=$E(IVDUR,1),DURV=$E(IVDUR,2,$L(IVDUR)) 110 . I (DURU="D")!(DURU="d") S IVDUR="for "_+DURV_$S(+DURV=1:" day",+DURV>1:" days",1:" day") 111 . I (DURU="H")!(DURU="h") S IVDUR="for "_+DURV_$S(+DURV=1:" hours",+DURV>1:" hours",1:" hour") 112 . I (DURU="M")!(DURU="m") S IVDUR="with total volume "_+DURV_" ml" 113 . I (DURU="L")!(DURU="l") S IVDUR="with total volume "_+DURV_" L" 114 . S @RST@(@RST)=@RST@(@RST)_" "_IVDUR 115 M Y=@RST K @RST 116 Q 117 NVINST(Y,INDEX) ; assembles instructions for a non-VA med 118 N I,X,RST 119 S X=^TMP("PS",$J,INDEX,0) 120 S RST="^TMP(""ORACT"",$J,""INSTRUCT"")" 121 S @RST@(1)=" "_$P(X,U,2),@RST=1 122 D SETMULT(RST,INDEX,"SIG") 123 I @RST=1 D 124 . D SETMULT(RST,INDEX,"SIO") 125 . D SETMULT(RST,INDEX,"MDR") 126 . D SETMULT(RST,INDEX,"SCH") 127 S @RST@(2)="\ "_$G(@RST@(2)) 128 F I=3:1:@RST S @RST@(I)=" "_@RST@(I) 129 M Y=@RST K @RST 130 Q 131 NVREASON(ORR,NVSDT,INDEX) ; assembles start date and reasons for a non-VA med 132 N ORI,J,X,ORN,ORA 133 S ORI=0 K ORR 134 S X=^TMP("PS",$J,INDEX,0) 135 S ORN=+$P(X,U,8) 136 I $D(^OR(100,ORN,0)) D 137 .S NVSDT=$P(^OR(100,ORN,0),U,8) 138 .D WPVAL^ORWDXR(.ORA,ORN,"STATEMENTS") I $D(ORA) D 139 ..S J=0 F S J=$O(ORA(J)) Q:J<1 S ORI=ORI+1,ORR(ORI)=ORA(J) 140 Q 141 SETMULT(Y,INDEX,SUB) ; appends the multiple at the subscript to Y 142 N I,X,J 143 S J=$G(@Y) 144 S I=0 F S I=$O(^TMP("PS",$J,INDEX,SUB,I)) Q:'I S X=$G(^(I,0)) D 145 . I SUB="B",$L($P(X,U,3)) S X=$P(X,U)_" "_$P(X,U,3)_"^"_$P(X,U,2) 146 . S J=J+1,@Y@(J)=X 147 S @Y=J 148 Q 149 COMPRESS(Y) ; concatenate Y subscripts into smallest possible number 150 N I,J,X S J=1,X(J)="" 151 S I=0 F S I=$O(Y(I)) Q:'I D 152 . I ($L(Y(I))+$L(X(J)))>245 S J=J+1,X(J)="" 153 . S X(J)=X(J)_$S($L(X(J)):" ",1:"")_Y(I) 154 K Y M Y=X 155 Q 156 DETAIL(ROOT,DFN,ID) ; -- show details for a med order 157 K ^TMP("ORXPND",$J) 158 N LCNT,ORVP 159 S LCNT=0,ORVP=DFN_";DPT(" 160 D MEDS^ORCXPND1 161 S ROOT=$NA(^TMP("ORXPND",$J)) 162 Q 163 MEDHIST(ORROOT,DFN,ORIFN) ; -- show admin history for a med (RV) 164 N ORPSID,HPIV,ISIV,CKPKG,ORPHMID 165 S ORPSID=+$P($$OI^ORX8(ORIFN),U,3),(HPIV,ISIV)=0 166 S ORROOT=$NA(^TMP("ORHIST",$J)) K @ORROOT 167 S ORPHMID=$G(^OR(100,+ORIFN,4)) ;Pharmacy order number 168 S ISIV=$O(^ORD(100.98,"B","IV RX",ISIV)) 169 S HPIV=$O(^ORD(100.98,"B","TPN",HPIV)) 170 S CKPKG=$$PATCH^XPDUTL("PSB*2.0*19") 171 ;if the order is pending or the order has no pharmacy # 172 ;or the order is not in the Display Group IV MEDICATION 173 ; then use the Orderable item number to get the MAH. 174 I (ORPHMID["P")!(ORPHMID="") D Q 175 . I '$L($T(HISTORY^PSBMLHS)) D Q 176 . . S @ORROOT@(0)="This report is only available using BCMA version 2.0." 177 . D HISTORY^PSBMLHS(.ORROOT,DFN,ORPSID) ; DBIA #3459 for BCMA v2.0 178 ; If the order has a Display Group of IV MEDICATION the use the Pharmacy order number to get the MAH 179 I $P($G(^OR(100,+ORIFN,0)),U,11)=ISIV!($P($G(^OR(100,+ORIFN,0)),U,11)=HPIV) D Q 180 . I 'CKPKG S @ORROOT@(0)="Medication Administration History is not available at this time for IV fluids." 181 . I CKPKG D 182 . . D RPC^PSBO(.ORROOT,"PM",DFN,"","","","","","","","","",ORPHMID) ;DBIA #3955 183 . . I '$D(@ORROOT) S @ORROOT@(0)="No Medication Administration History found for the IV order." 184 I '$L($T(HISTORY^PSBMLHS)) D Q 185 . S @ORROOT@(0)="This report is only available using BCMA version 2.0." 186 D HISTORY^PSBMLHS(.ORROOT,DFN,ORPSID) ; DBIA #3459 for BCMA v2.0 187 Q 188 ; 189 REASON(ORY) ; -- Return Non-VA Med Statement/Reasons 190 N ORE 191 D GETLST^XPAR(.ORY,"ALL","ORWD NONVA REASON","E") 192 Q
Note:
See TracChangeset
for help on using the changeset viewer.
