- 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/ORMPS1.m
r613 r623 1 ORMPS1 ;SLC/MKB - Process Pharmacy ORM msgs cont ; 3/27/08 7:38am 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**86,92,94,116,134,152,158,149,190,195,215,265,275,243**;Dec 17, 1997;Build 242 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 UDOSE ; -- new Unit Dose order 5 N ADMIN,QT,DRUG,INSTR,DOSE,RTE,SCH,OI,URG,WP,DUR,STR,DRGNM,X,PSOI,PSDD,S0,ID,LDOSE,XC,NTE,S0,RXR 6 S ORDIALOG=+$O(^ORD(101.41,"AB","PSJ OR PAT OE",0)) 7 I $G(ORAPPT)>0 S ORDG=+$O(^ORD(100.98,"B","CLINIC ORDERS",0)) 8 E S ORDG=+$O(^ORD(100.98,"B","UNIT DOSE MEDICATIONS",0)) 9 S ORPKG=+$$PKG("PSJ") 10 D GETDLG1^ORCD(ORDIALOG) S QT=$G(ORQT(1)) 11 S DRUG=$$PTR("DISPENSE DRUG"),INSTR=$$PTR("INSTRUCTIONS") 12 S DOSE=$$PTR("DOSE"),RTE=$$PTR("ROUTE") 13 S SCH=$$PTR("SCHEDULE"),ADMIN=$$PTR("ADMIN TIMES") 14 S OI=$$PTR("ORDERABLE ITEM"),URG=$$PTR("URGENCY") 15 S WP=$$PTR("WORD PROCESSING 1"),DUR=$$PTR("DURATION") 16 S STR=$$PTR("STRENGTH"),DRGNM=$$PTR("DRUG NAME") 17 UD1 S:RXO X=$P(RXO,"|",2),ORDIALOG(OI,1)=$$ORDITEM^ORM(X),PSOI=$P(X,U,4,5) 18 I '$G(ORDIALOG(OI,1)) S ORERR="Missing or invalid orderable item" Q 19 S PSDD=$P($$FIND^ORM(+RXE,3),U,4,5),ORDIALOG(DRUG,1)=+PSDD 20 S S0=$$FIND^ORM(+RXE,26)_"&"_$P($$FIND^ORM(+RXE,27),U,5) 21 S ID=$P(QT,U),LDOSE=$P(QT,U,8) I 'ID,S0 D 22 . N UNT,PTRN S UNT=$P(S0,"&",2),PTRN="1.N1"""_UNT_"""" 23 . I LDOSE?@PTRN S $P(ID,"&",1,2)=+LDOSE_"&"_UNT Q ;pre-POE orders 24 . S:$P(PSOI,U,2)'[S0 ORDIALOG(STR,1)=$TR(S0,"&") 25 I 'ID,'S0 S ORDIALOG(DRGNM,1)=$$UNESC^ORMPS2($P(PSDD,U,2)) 26 S:$L(ID) ORDIALOG(DOSE,1)=$$UNESC^ORMPS2($P(ID,"&",1,4)_"&"_LDOSE_"&"_+PSDD_"&"_S0) 27 I LDOSE="" D I LDOSE="" S ORERR="Unable to determine instructions" Q 28 . I $G(RXC)'>0 D Q ;look for units/dose 29 .. S LDOSE=$P(ID,"&",3),X=$P(ID,"&",4) I 'LDOSE S LDOSE="" Q 30 .. S:'$L(X) X=$$UNESC^ORMPS2($P($$FIND^ORM(+RXE,7),U,5)) S:$L(X) LDOSE=LDOSE_" "_X 31 .. S ORDIALOG(DRGNM,1)=$$UNESC^ORMPS2($P(PSDD,U,2)) ;force use of DD 32 . F D Q:LDOSE'="" S RXC=$O(@ORMSG@(RXC)) Q:'RXC Q:$E(@ORMSG@(RXC),1,3)'="RXC" 33 .. S XC=@ORMSG@(RXC) Q:+$P($P(XC,"|",3),U,4)'=+PSOI 34 .. S LDOSE=$P(XC,"|",4)_$P($P(XC,"|",5),U,5) ;strength_units 35 S ORDIALOG(INSTR,1)=$$UNESC^ORMPS2(LDOSE) 36 UD2 S NTE=$$NTE^ORMPS3(21) I NTE D 37 . N CNT,I S CNT=1,^TMP("ORWORD",$J,WP,1,CNT,0)=$$UNESC^ORMPS2($P(@ORMSG@(NTE),"|",4)) 38 . I $O(@ORMSG@(NTE,0)) S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S CNT=CNT+1,^TMP("ORWORD",$J,WP,1,CNT,0)=$$UNESC^ORMPS2(@ORMSG@(NTE,I)) 39 . S ^TMP("ORWORD",$J,WP,1,0)="^^"_CNT_U_CNT_U_DT_U 40 . S ORDIALOG(WP,1)="^TMP(""ORWORD"",$J,"_WP_",1)" 41 S RXR=$$RXR^ORMPS I 'RXR S ORERR="Missing or invalid RXR segment" Q 42 S ORDIALOG(RTE,1)=$P($P(RXR,"|",2),U,4),ORDIALOG(URG,1)=ORURG 43 S X=$P(QT,U,2) 44 S ORDIALOG(SCH,1)=$$UNESC^ORMPS2($P(X,"&")) 45 S:$L($P(X,"&",2)) ORDIALOG(ADMIN,1)=$P(X,"&",2) 46 S X=$P(QT,U,3) I $L(X) D ;set only if previous order had duration 47 . N IFN S IFN=$S($G(ORIFN):+ORIFN,$P(ZRX,"|",2):+$P(ZRX,"|",2),1:0) 48 . S:$O(^OR(100,+IFN,4.5,"ID","DAYS",0)) ORDIALOG(DUR,1)=$$DURATION^ORMPS3(X) 49 D DOSETEXT^ORCDPS2 ;reset Instructions text, SIG 50 D UNESCARR^ORMPS2("ORDIALOG") 51 Q 52 OUT ; -- new Outpt order 53 N OI,SIG,INSTR,DOSE,RTE,SCH,DUR,SC,STR,DRUG,PI,CONJ,PSOI,PSDD,S0,X,I,RXR,J,NTE,ZSC,CNT,PC 54 S ORDIALOG=+$O(^ORD(101.41,"AB","PSO OERR",0)) 55 S ORDG=+$O(^ORD(100.98,"B","OUTPATIENT MEDICATIONS",0)) 56 S ORPKG=+$$PKG("PSO") D GETDLG1^ORCD(ORDIALOG) 57 S OI=$$PTR("ORDERABLE ITEM"),SIG=$$PTR("SIG") 58 S INSTR=$$PTR("INSTRUCTIONS"),DOSE=$$PTR("DOSE") 59 S SCH=$$PTR("SCHEDULE"),DUR=$$PTR("DURATION") 60 S RTE=$$PTR("ROUTE"),SC=$$PTR("SERVICE CONNECTED") 61 S STR=$$PTR("STRENGTH"),DRUG=$$PTR("DISPENSE DRUG") 62 S PI=$$PTR("PATIENT INSTRUCTIONS"),CONJ=$$PTR("AND/THEN") 63 S PC=$$PTR("WORD PROCESSING 1") 64 S:RXO X=$P(RXO,"|",2),ORDIALOG(OI,1)=$$ORDITEM^ORM(X),PSOI=$P(X,U,4,5) 65 I '$G(ORDIALOG(OI,1)) S ORERR="Missing or invalid orderable item" Q 66 S PSDD=$P($$FIND^ORM(+RXE,3),U,4,5),ORDIALOG(DRUG,1)=+PSDD 67 S S0=$$FIND^ORM(+RXE,26)_"&"_$P($$FIND^ORM(+RXE,27),U,5) 68 I S0,$P(PSOI,U,2)'[S0 S ORDIALOG(STR,1)=$TR(S0,"&") 69 I 'S0,'$G(ORQT(1)) S ORDIALOG($$PTR("DRUG NAME"),1)=$$UNESC^ORMPS2($P(PSDD,U,2)) 70 OUT1 S ORDIALOG($$PTR("QUANTITY"),1)=$$FIND^ORM(+RXE,11) 71 S ORDIALOG($$PTR("REFILLS"),1)=$$FIND^ORM(+RXE,13) 72 S X=$$FIND^ORM(+RXE,23) S:$E(X)="D" X=+$E(X,2,99) 73 S:X ORDIALOG($$PTR("DAYS SUPPLY"),1)=X 74 I ZRX S X=$P(ZRX,"|",5) S:$L(X) ORDIALOG($$PTR("ROUTING"),1)=X 75 S:ORURG ORDIALOG($$PTR("URGENCY"),1)=ORURG F I=1:1:ORQT D 76 . S ORDIALOG(INSTR,I)=$$UNESC^ORMPS2($P(ORQT(I),U,8)),X=$P(ORQT(I),U) 77 . S:$L(X) ORDIALOG(DOSE,I)=$$UNESC^ORMPS2($P(X,"&",1,4)_"&"_$P(ORQT(I),U,8)_"&"_+PSDD_"&"_S0) 78 . S X=$P(ORQT(I),U,2) S:$L(X) ORDIALOG(SCH,I)=$$UNESC^ORMPS2(X) 79 . S X=$P(ORQT(I),U,3) S:$L(X) ORDIALOG(DUR,I)=$$DURATION^ORMPS3(X) 80 . S X=$P(ORQT(I),U,9) S:$L(X) ORDIALOG(CONJ,I)=$S(X="S":"T",1:X) 81 S RXR=$$RXR^ORMPS I RXR S ORDIALOG(RTE,1)=$P($P(RXR,"|",2),U,4) D 82 . S I=1,J=+RXR ;look for multiple RXR's 83 . F S J=$O(@ORMSG@(J)) Q:J'>0 S RXR=@ORMSG@(J) Q:$E(RXR,1,3)'="RXR" S I=I+1,ORDIALOG(RTE,I)=$P($P(RXR,"|",2),U,4) 84 OUT2 S NTE=$$NTE^ORMPS3(6) I NTE D ;Prov Comm ;D:'NTE PCOMM^ORMPS2 85 . S CNT=1,^TMP("ORWORD",$J,PC,1,CNT,0)=$$UNESC^ORMPS2($P(@ORMSG@(NTE),"|",4)) 86 . I $O(@ORMSG@(NTE,0)) S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S CNT=CNT+1,^TMP("ORWORD",$J,PC,1,CNT,0)=$$UNESC^ORMPS2(@ORMSG@(NTE,I)) 87 . S ^TMP("ORWORD",$J,PC,1,0)="^^"_CNT_U_CNT_U_DT_U 88 . S ORDIALOG(PC,1)="^TMP(""ORWORD"",$J,"_PC_",1)",ORDIALOG(PC,"FORMAT")="@" ;keep, don't show 89 . N XCNT,XCOMM,XCOMMENT,XORCOMM,XXCNT,XORIFN 90 . S XORIFN=$G(ORIFN) S:XORIFN="" XORIFN=$P(RXR,"|",2) Q:XORIFN="" 91 . S XCOMM=$O(^OR(100,+XORIFN,4.5,"ID","COMMENT",0)) Q:XCOMM="" 92 . S XCNT=0 F S XCNT=$O(^TMP("ORWORD",$J,PC,1,XCNT)) Q:XCNT="" S XCOMMENT=^TMP("ORWORD",$J,PC,1,XCNT,0) D 93 .. S XORCOMM=$G(^OR(100,+XORIFN,4.5,XCOMM,2,XCNT,0)),XXCNT=0 94 .. I XORCOMM="" F S XXCNT=$O(^OR(100,+XORIFN,4.5,XCOMM,2,XXCNT)) Q:XXCNT="" S XORCOMM=$G(^(XXCNT,0)) Q:XORCOMM'="" 95 .. I $G(XCOMMENT)=$G(XORCOMM) S ORDIALOG(PC,"FORMAT")="@" 96 S NTE=$$NTE^ORMPS3(7) I NTE D ;Pat Instr 97 . S CNT=1,^TMP("ORWORD",$J,PI,1,CNT,0)=$$UNESC^ORMPS2($P(@ORMSG@(NTE),"|",4)) 98 . I $O(@ORMSG@(NTE,0)) S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S CNT=CNT+1,^TMP("ORWORD",$J,PI,1,CNT,0)=$$UNESC^ORMPS2(@ORMSG@(NTE,I)) 99 . S ^TMP("ORWORD",$J,PI,1,0)="^^"_CNT_U_CNT_U_DT_U 100 . S ORDIALOG(PI,1)="^TMP(""ORWORD"",$J,"_PI_",1)" 101 S NTE=$$NTE^ORMPS3(21) I NTE D ;Sig 102 . S CNT=1,^TMP("ORWORD",$J,SIG,1,CNT,0)=$$UNESC^ORMPS2($P(@ORMSG@(NTE),"|",4)) 103 . I $O(@ORMSG@(NTE,0)) S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S CNT=CNT+1,^TMP("ORWORD",$J,SIG,1,CNT,0)=$$UNESC^ORMPS2(@ORMSG@(NTE,I)) 104 . S ^TMP("ORWORD",$J,SIG,1,0)="^^"_CNT_U_CNT_U_DT_U 105 . S ORDIALOG(SIG,1)="^TMP(""ORWORD"",$J,"_SIG_",1)" 106 . S ORDIALOG(PI,"FORMAT")="@" ;PI already included in Sig 107 OUT3 I '$G(ORQT(1))!('NTE) D DOSETEXT^ORCDPS2 ;reset Instructions text, Sig 108 S ZSC=$$ZSC^ORMPS3,X=$P(ZSC,"|",2) I X?2.3U S ORDIALOG(SC,1)=$S(X="SC":1,1:0) 109 Q 110 IV ; -- new IV order 111 N IVTYP,IVTYPE S IVTYP=$P(ZRX,"|",7) I IVTYP="",$$NUMADDS^ORMPS3'>1 G UDOSE 112 N SOLN,VOL,ADDS,STR,UNITS,RATE,URG,X,X1,X2,I,J,TYPE,OI,WP,NTE,SCH,DAYS,ROUTE,ADMIN 113 N RXR 114 S ORDIALOG=+$O(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0)) 115 I +$G(ORAPPT)>0 S ORDG=+$O(^ORD(100.98,"B","CLINIC ORDERS",0)) 116 E S ORDG=+$O(^ORD(100.98,"B",$S($P(ZRX,"|",7)="TPN":"TPN",1:"IV RX"),0)) 117 S ORPKG=+$$PKG("PSJ") D GETDLG1^ORCD(ORDIALOG) 118 S SOLN=$$PTR("ORDERABLE ITEM"),VOL=$$PTR("VOLUME"),SCH=$$PTR("SCHEDULE") 119 S RATE=$$PTR("INFUSION RATE") S:ORURG ORDIALOG($$PTR("URGENCY"),1)=ORURG 120 S WP=$$PTR("WORD PROCESSING 1"),ADDS=$$PTR("ADDITIVE") 121 S STR=$$PTR("STRENGTH PSIV"),UNITS=$$PTR("UNITS") 122 S DAYS=$$PTR("DURATION"),IVTYPE=$$PTR("IV TYPE"),ADMIN=$$PTR("ADMIN TIMES") 123 IV1 S NTE=$$NTE^ORMPS3(21) I NTE D 124 . N CNT,I S CNT=1,^TMP("ORWORD",$J,WP,1,CNT,0)=$$UNESC^ORMPS2($P(@ORMSG@(NTE),"|",4)) 125 . I $O(@ORMSG@(NTE,0)) S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S CNT=CNT+1,^TMP("ORWORD",$J,WP,1,CNT,0)=$$UNESC^ORMPS2(@ORMSG@(NTE,I)) 126 . S ^TMP("ORWORD",$J,WP,1,0)="^^"_CNT_U_CNT_U_DT_U 127 . S ORDIALOG(WP,1)="^TMP(""ORWORD"",$J,"_WP_",1)" 128 N ORDAYS S ORDAYS="" 129 S:$D(RXO) ORDAYS=$P($P(RXO,"|",2),"^",3) 130 S:$L(ORDAYS) ORDAYS=$$IVLIM^ORMPS2(ORDAYS) 131 S:$L(ORDAYS) ORDIALOG(DAYS,1)=ORDAYS 132 S ORDIALOG(IVTYPE,1)=IVTYP 133 S X=$P($$FIND^ORM(+RXE,25),U,5) 134 S ORDIALOG(RATE,1)=$$FIND^ORM(+RXE,24)_$S($L(X):" "_X,1:""),(I,J)=0 135 F D S RXC=$O(@ORMSG@(RXC)) Q:'RXC Q:$E(@ORMSG@(RXC),1,3)'="RXC" 136 . S X=@ORMSG@(RXC),TYPE=$P(X,"|",2),OI=$$ORDITEM^ORM($P(X,"|",3)) Q:'OI 137 . S X1=$P(X,"|",4),X2=$P($P(X,"|",5),U,5) 138 . I $E(TYPE)="B" S J=J+1,ORDIALOG(SOLN,J)=OI,ORDIALOG(VOL,J)=X1 Q 139 . S I=I+1,ORDIALOG(ADDS,I)=OI,ORDIALOG(STR,I)=X1,ORDIALOG(UNITS,I)=X2 140 IV2 ; 141 S RXR=$$RXR^ORMPS 142 S ROUTE=$P(RXR,"|",2) 143 S ORDIALOG($$PTR("ROUTE"),1)=$P(ROUTE,U,4) 144 I IVTYP="I" S X=$P($G(ORQT(1)),U,2) D 145 .S:$L($P(X,"&")) ORDIALOG(SCH,1)=$P(X,"&") 146 .S:$L($P(X,"&",2)) ORDIALOG(ADMIN,1)=$P(X,"&",2) 147 D UNESCARR^ORMPS2("ORDIALOG") 148 Q 149 PKG(NMSP) ; -- Return Package file ptr for NMSP 150 N I S I=0 151 F S I=+$O(^DIC(9.4,"C",NMSP,I)) Q:I<1 Q:'$O(^(I,0)) ;no Addl Prefs 152 Q I 153 PTR(NAME) ; -- Returns ien of prompt NAME in Order Dialog file #101.41 154 Q +$O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0)) 155 QT ; -- Unpiece the Q/T field from RXE 156 I 'RXE S ORQT(1)=ORQT,ORQT=1 Q ; nothing to reset 157 N X,Y,I,J,P,SEG,DONE K ORQT 158 S SEG=$G(@ORMSG@(+RXE)),X=$P(SEG,"|",2),(I,J,P,DONE)=0 159 F D Q:DONE 160 . S P=P+1,Y=$P(X,"~",P) I Y="" S DONE=1 Q 161 . I P<$L(X,"~") S I=I+1,ORQT(I)=Y Q 162 . I $L(SEG,"|")>2 S I=I+1,ORQT(I)=Y,DONE=1 Q 163 . S J=+$O(@ORMSG@(+RXE,J)) I J'>0 S I=I+1,ORQT(I)=Y,DONE=1 Q 164 . S SEG=$G(@ORMSG@(+RXE,J)),X=$P(SEG,"|"),P=1,I=I+1,ORQT(I)=Y_$P(X,"~") 165 S ORQT=I Q:'ORQT ; else reset ORSTRT, ORSTOP, ORURG 166 S ORSTRT=$P(ORQT(1),U,4),ORSTOP=$P(ORQT(ORQT),U,5),ORURG=$P(ORQT(1),U,6) 167 S:ORSTRT ORSTRT=$$FMDATE^ORM(ORSTRT) S:ORSTOP ORSTOP=$$FMDATE^ORM(ORSTOP) S:$L(ORURG) ORURG=$$URGENCY^ORM(ORURG) 168 Q 1 ORMPS1 ;SLC/MKB - Process Pharmacy ORM msgs cont ;12/9/04 12:01 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**86,92,94,116,134,152,158,149,190,195,215,265,275**;Dec 17, 1997;Build 7 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 UDOSE ; -- new Unit Dose order 5 N QT,DRUG,INSTR,DOSE,RTE,SCH,OI,URG,WP,DUR,STR,DRGNM,X,PSOI,PSDD,S0,ID,LDOSE,XC,NTE,S0,RXR 6 S ORDIALOG=+$O(^ORD(101.41,"AB","PSJ OR PAT OE",0)) 7 I $G(ORAPPT)>0 S ORDG=+$O(^ORD(100.98,"B","CLINIC ORDERS",0)) 8 E S ORDG=+$O(^ORD(100.98,"B","UNIT DOSE MEDICATIONS",0)) 9 S ORPKG=+$$PKG("PSJ") 10 D GETDLG1^ORCD(ORDIALOG) S QT=$G(ORQT(1)) 11 S DRUG=$$PTR("DISPENSE DRUG"),INSTR=$$PTR("INSTRUCTIONS") 12 S DOSE=$$PTR("DOSE"),RTE=$$PTR("ROUTE"),SCH=$$PTR("SCHEDULE") 13 S OI=$$PTR("ORDERABLE ITEM"),URG=$$PTR("URGENCY") 14 S WP=$$PTR("WORD PROCESSING 1"),DUR=$$PTR("DURATION") 15 S STR=$$PTR("STRENGTH"),DRGNM=$$PTR("DRUG NAME") 16 UD1 S:RXO X=$P(RXO,"|",2),ORDIALOG(OI,1)=$$ORDITEM^ORM(X),PSOI=$P(X,U,4,5) 17 I '$G(ORDIALOG(OI,1)) S ORERR="Missing or invalid orderable item" Q 18 S PSDD=$P($$FIND^ORM(+RXE,3),U,4,5),ORDIALOG(DRUG,1)=+PSDD 19 S S0=$$FIND^ORM(+RXE,26)_"&"_$P($$FIND^ORM(+RXE,27),U,5) 20 S ID=$P(QT,U),LDOSE=$P(QT,U,8) I 'ID,S0 D 21 . N UNT,PTRN S UNT=$P(S0,"&",2),PTRN="1.N1"""_UNT_"""" 22 . I LDOSE?@PTRN S $P(ID,"&",1,2)=+LDOSE_"&"_UNT Q ;pre-POE orders 23 . S:$P(PSOI,U,2)'[S0 ORDIALOG(STR,1)=$TR(S0,"&") 24 I 'ID,'S0 S ORDIALOG(DRGNM,1)=$P(PSDD,U,2) 25 S:$L(ID) ORDIALOG(DOSE,1)=$P(ID,"&",1,4)_"&"_LDOSE_"&"_+PSDD_"&"_S0 26 I LDOSE="" D I LDOSE="" S ORERR="Unable to determine instructions" Q 27 . I $G(RXC)'>0 D Q ;look for units/dose 28 .. S LDOSE=$P(ID,"&",3),X=$P(ID,"&",4) I 'LDOSE S LDOSE="" Q 29 .. S:'$L(X) X=$P($$FIND^ORM(+RXE,7),U,5) S:$L(X) LDOSE=LDOSE_" "_X 30 .. S ORDIALOG(DRGNM,1)=$P(PSDD,U,2) ;force use of DD 31 . F D Q:LDOSE'="" S RXC=$O(@ORMSG@(RXC)) Q:'RXC Q:$E(@ORMSG@(RXC),1,3)'="RXC" 32 .. S XC=@ORMSG@(RXC) Q:+$P($P(XC,"|",3),U,4)'=+PSOI 33 .. S LDOSE=$P(XC,"|",4)_$P($P(XC,"|",5),U,5) ;strength_units 34 S ORDIALOG(INSTR,1)=LDOSE 35 UD2 S NTE=$$NTE(21) I NTE D 36 . N CNT,I S CNT=1,^TMP("ORWORD",$J,WP,1,CNT,0)=$P(@ORMSG@(NTE),"|",4) 37 . I $O(@ORMSG@(NTE,0)) S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S CNT=CNT+1,^TMP("ORWORD",$J,WP,1,CNT,0)=@ORMSG@(NTE,I) 38 . S ^TMP("ORWORD",$J,WP,1,0)="^^"_CNT_U_CNT_U_DT_U 39 . S ORDIALOG(WP,1)="^TMP(""ORWORD"",$J,"_WP_",1)" 40 S RXR=$$RXR^ORMPS I 'RXR S ORERR="Missing or invalid RXR segment" Q 41 S ORDIALOG(RTE,1)=$P($P(RXR,"|",2),U,4),ORDIALOG(URG,1)=ORURG 42 S ORDIALOG(SCH,1)=$P(QT,U,2),X=$P(QT,U,3) 43 I $L(X) D ;set only if previous order had duration 44 . N IFN S IFN=$S($G(ORIFN):+ORIFN,$P(ZRX,"|",2):+$P(ZRX,"|",2),1:0) 45 . S:$O(^OR(100,+IFN,4.5,"ID","DAYS",0)) ORDIALOG(DUR,1)=$$DURATION(X) 46 D DOSETEXT^ORCDPS2 ;reset Instructions text, SIG 47 Q 48 OUT ; -- new Outpt order 49 N OI,SIG,INSTR,DOSE,RTE,SCH,DUR,SC,STR,DRUG,PI,CONJ,PSOI,PSDD,S0,X,I,RXR,J,NTE,ZSC,CNT,PC 50 S ORDIALOG=+$O(^ORD(101.41,"AB","PSO OERR",0)) 51 S ORDG=+$O(^ORD(100.98,"B","OUTPATIENT MEDICATIONS",0)) 52 S ORPKG=+$$PKG("PSO") D GETDLG1^ORCD(ORDIALOG) 53 S OI=$$PTR("ORDERABLE ITEM"),SIG=$$PTR("SIG") 54 S INSTR=$$PTR("INSTRUCTIONS"),DOSE=$$PTR("DOSE") 55 S SCH=$$PTR("SCHEDULE"),DUR=$$PTR("DURATION") 56 S RTE=$$PTR("ROUTE"),SC=$$PTR("SERVICE CONNECTED") 57 S STR=$$PTR("STRENGTH"),DRUG=$$PTR("DISPENSE DRUG") 58 S PI=$$PTR("PATIENT INSTRUCTIONS"),CONJ=$$PTR("AND/THEN") 59 S PC=$$PTR("WORD PROCESSING 1") 60 S:RXO X=$P(RXO,"|",2),ORDIALOG(OI,1)=$$ORDITEM^ORM(X),PSOI=$P(X,U,4,5) 61 I '$G(ORDIALOG(OI,1)) S ORERR="Missing or invalid orderable item" Q 62 S PSDD=$P($$FIND^ORM(+RXE,3),U,4,5),ORDIALOG(DRUG,1)=+PSDD 63 S S0=$$FIND^ORM(+RXE,26)_"&"_$P($$FIND^ORM(+RXE,27),U,5) 64 I S0,$P(PSOI,U,2)'[S0 S ORDIALOG(STR,1)=$TR(S0,"&") 65 I 'S0,'$G(ORQT(1)) S ORDIALOG($$PTR("DRUG NAME"),1)=$P(PSDD,U,2) 66 OUT1 S ORDIALOG($$PTR("QUANTITY"),1)=$$FIND^ORM(+RXE,11) 67 S ORDIALOG($$PTR("REFILLS"),1)=$$FIND^ORM(+RXE,13) 68 S X=$$FIND^ORM(+RXE,23) S:$E(X)="D" X=+$E(X,2,99) 69 S:X ORDIALOG($$PTR("DAYS SUPPLY"),1)=X 70 I ZRX S X=$P(ZRX,"|",5) S:$L(X) ORDIALOG($$PTR("ROUTING"),1)=X 71 S:ORURG ORDIALOG($$PTR("URGENCY"),1)=ORURG F I=1:1:ORQT D 72 . S ORDIALOG(INSTR,I)=$P(ORQT(I),U,8),X=$P(ORQT(I),U) 73 . S:$L(X) ORDIALOG(DOSE,I)=$P(X,"&",1,4)_"&"_$P(ORQT(I),U,8)_"&"_+PSDD_"&"_S0 74 . S X=$P(ORQT(I),U,2) S:$L(X) ORDIALOG(SCH,I)=X 75 . S X=$P(ORQT(I),U,3) S:$L(X) ORDIALOG(DUR,I)=$$DURATION(X) 76 . S X=$P(ORQT(I),U,9) S:$L(X) ORDIALOG(CONJ,I)=$S(X="S":"T",1:X) 77 S RXR=$$RXR^ORMPS I RXR S ORDIALOG(RTE,1)=$P($P(RXR,"|",2),U,4) D 78 . S I=1,J=+RXR ;look for multiple RXR's 79 . F S J=$O(@ORMSG@(J)) Q:J'>0 S RXR=@ORMSG@(J) Q:$E(RXR,1,3)'="RXR" S I=I+1,ORDIALOG(RTE,I)=$P($P(RXR,"|",2),U,4) 80 OUT2 S NTE=$$NTE(6) D:'NTE PCOMM^ORMPS2 I NTE D ;Prov Comm 81 . S CNT=1,^TMP("ORWORD",$J,PC,1,CNT,0)=$P(@ORMSG@(NTE),"|",4) 82 . I $O(@ORMSG@(NTE,0)) S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S CNT=CNT+1,^TMP("ORWORD",$J,PC,1,CNT,0)=@ORMSG@(NTE,I) 83 . S ^TMP("ORWORD",$J,PC,1,0)="^^"_CNT_U_CNT_U_DT_U 84 . S ORDIALOG(PC,1)="^TMP(""ORWORD"",$J,"_PC_",1)" 85 . N XCNT,XCOMM,XCOMMENT,XORCOMM,XXCNT,XORIFN 86 . S (XCOMM,XORCOMM)="" 87 . S XORIFN=$G(ORIFN) I XORIFN="" S XORIFN=$P(RXR,"|",2) 88 . Q:XORIFN="" 89 . S XCOMM=$O(^OR(100,+XORIFN,4.5,"ID","COMMENT",XCOMM)) Q:XCOMM="" 90 . S XCNT=0 F S XCNT=$O(^TMP("ORWORD",$J,PC,1,XCNT)) Q:XCNT="" S XCOMMENT=$G(^TMP("ORWORD",$J,PC,1,XCNT,0)) D 91 . . S XORCOMM=$G(^OR(100,+XORIFN,4.5,XCOMM,2,XCNT,0)) 92 . . S XXCNT=0 93 . . I XORCOMM="" F S XXCNT=$O(^OR(100,+XORIFN,4.5,XCOMM,2,XXCNT)) Q:XXCNT="" S XORCOMM=$G(^OR(100,+XORIFN,4.5,XCOMM,2,XXCNT,0)) Q:XORCOMM'="" 94 . . I $G(XCOMMENT)=$G(XORCOMM) S ORDIALOG(PC,"FORMAT")="@" 95 S NTE=$$NTE(7) I NTE D ;Pat Instr 96 . S CNT=1,^TMP("ORWORD",$J,PI,1,CNT,0)=$P(@ORMSG@(NTE),"|",4) 97 . I $O(@ORMSG@(NTE,0)) S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S CNT=CNT+1,^TMP("ORWORD",$J,PI,1,CNT,0)=@ORMSG@(NTE,I) 98 . S ^TMP("ORWORD",$J,PI,1,0)="^^"_CNT_U_CNT_U_DT_U 99 . S ORDIALOG(PI,1)="^TMP(""ORWORD"",$J,"_PI_",1)" 100 S NTE=$$NTE(21) I NTE D ;Sig 101 . S CNT=1,^TMP("ORWORD",$J,SIG,1,CNT,0)=$P(@ORMSG@(NTE),"|",4) 102 . I $O(@ORMSG@(NTE,0)) S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S CNT=CNT+1,^TMP("ORWORD",$J,SIG,1,CNT,0)=@ORMSG@(NTE,I) 103 . S ^TMP("ORWORD",$J,SIG,1,0)="^^"_CNT_U_CNT_U_DT_U 104 . S ORDIALOG(SIG,1)="^TMP(""ORWORD"",$J,"_SIG_",1)" 105 . S ORDIALOG(PI,"FORMAT")="@" ;PI already included in Sig 106 OUT3 I '$G(ORQT(1))!('NTE) D DOSETEXT^ORCDPS2 ;reset Instructions text, Sig 107 S ZSC=$$ZSC,X=$P(ZSC,"|",2) I X?2.3U S ORDIALOG(SC,1)=$S(X="SC":1,1:0) 108 Q 109 IV ; -- new IV order 110 N IVTYP S IVTYP=$P(ZRX,"|",7) I IVTYP="",$$NUMADDS'>1 G UDOSE 111 N SOLN,VOL,ADDS,STR,UNITS,RATE,URG,X,X1,X2,I,J,TYPE,OI,WP,NTE,SCH,DAYS 112 S ORDIALOG=+$O(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0)) 113 I +$G(ORAPPT)>0 S ORDG=+$O(^ORD(100.98,"B","CLINIC ORDERS",0)) 114 E S ORDG=+$O(^ORD(100.98,"B",$S($P(ZRX,"|",7)="TPN":"TPN",1:"IV RX"),0)) 115 S ORPKG=+$$PKG("PSJ") D GETDLG1^ORCD(ORDIALOG) 116 S SOLN=$$PTR("ORDERABLE ITEM"),VOL=$$PTR("VOLUME"),SCH=$$PTR("SCHEDULE") 117 S RATE=$$PTR("INFUSION RATE") S:ORURG ORDIALOG($$PTR("URGENCY"),1)=ORURG 118 S WP=$$PTR("WORD PROCESSING 1"),ADDS=$$PTR("ADDITIVE") 119 S STR=$$PTR("STRENGTH PSIV"),UNITS=$$PTR("UNITS") 120 S DAYS=$$PTR("DURATION") 121 IV1 S NTE=$$NTE(21) I NTE D 122 . N CNT,I S CNT=1,^TMP("ORWORD",$J,WP,1,CNT,0)=$P(@ORMSG@(NTE),"|",4) 123 . I $O(@ORMSG@(NTE,0)) S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S CNT=CNT+1,^TMP("ORWORD",$J,WP,1,CNT,0)=@ORMSG@(NTE,I) 124 . S ^TMP("ORWORD",$J,WP,1,0)="^^"_CNT_U_CNT_U_DT_U 125 . S ORDIALOG(WP,1)="^TMP(""ORWORD"",$J,"_WP_",1)" 126 N ORDAYS S ORDAYS="" 127 S:$D(RXO) ORDAYS=$P($P(RXO,"|",2),"^",3) 128 S:$L(ORDAYS) ORDAYS=$$IVLIM^ORMPS2(ORDAYS) 129 S:$L(ORDAYS) ORDIALOG(DAYS,1)=ORDAYS 130 S X=$P($$FIND^ORM(+RXE,25),U,5) 131 S ORDIALOG(RATE,1)=$$FIND^ORM(+RXE,24)_$S($L(X):" "_X,1:""),(I,J)=0 132 F D S RXC=$O(@ORMSG@(RXC)) Q:'RXC Q:$E(@ORMSG@(RXC),1,3)'="RXC" 133 . S X=@ORMSG@(RXC),TYPE=$P(X,"|",2),OI=$$ORDITEM^ORM($P(X,"|",3)) Q:'OI 134 . S X1=$P(X,"|",4),X2=$P($P(X,"|",5),U,5) 135 . I $E(TYPE)="B" S J=J+1,ORDIALOG(SOLN,J)=OI,ORDIALOG(VOL,J)=X1 Q 136 . S I=I+1,ORDIALOG(ADDS,I)=OI,ORDIALOG(STR,I)=X1,ORDIALOG(UNITS,I)=X2 137 I IVTYP="" S X=$P($G(ORQT(1)),U,2) S:$L(X) ORDIALOG(SCH,1)=X 138 Q 139 NTE(ID) ; -- Return subscript of NTE segment for RXE-<ID> 140 N I,SEG,Y S Y="",I=+RXE S:'$G(ID) ID=21 141 F S I=$O(@ORMSG@(I)) Q:I'>0 S SEG=@ORMSG@(I) Q:$E(SEG,1,3)="ORC" I $P(SEG,"|",1,2)=("NTE|"_ID) S Y=I Q 142 Q Y 143 ZSC() ; -- Return subscript of ZSC segment 144 N I,SEG,Y S Y="",I=+RXE 145 F S I=$O(@ORMSG@(I)) Q:I'>0 S SEG=$E(@ORMSG@(I),1,3) Q:SEG="ORC" I SEG="ZSC" S Y=I_U_@ORMSG@(I) Q 146 Q Y 147 NUMADDS() ; -- count number of additives to determine type 148 N CNT,I,X S CNT=0,I=+RXE 149 F S I=$O(@ORMSG@(I)) Q:I'>0 S X=@ORMSG@(I) Q:$P(X,"|")="ORC" I $E(X,1,6)="RXC|A|" S CNT=CNT+1 150 Q CNT 151 PKG(NMSP) ; -- Return Package file ptr for NMSP 152 N I S I=0 153 F S I=+$O(^DIC(9.4,"C",NMSP,I)) Q:I<1 Q:'$O(^(I,0)) ;no Addl Prefs DBIA #2058 154 Q I 155 PTR(NAME) ; -- Returns ien of prompt NAME in Order Dialog file #101.41 156 Q +$O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0)) 157 DURATION(X) ; -- Returns "# units" from U# format 158 N Y,Y1,Y2 I X'?.1U1.N Q "" 159 S Y1=$E(X),Y2=+$E(X,2,$L(X)) I X=+X S Y1="D",Y2=+X 160 S Y=Y2_" "_$S(Y1="L":"MONTH",Y1="W":"WEEK",Y1="H":"HOUR",Y1="M":"MINUTE",Y1="S":"SECOND",1:"DAY")_$S(Y2>1:"S",1:"") 161 Q Y 162 QT ; -- Unpiece the Q/T field from RXE 163 I 'RXE S ORQT(1)=ORQT,ORQT=1 Q ; nothing to reset 164 N X,Y,I,J,P,SEG,DONE K ORQT 165 S SEG=$G(@ORMSG@(+RXE)),X=$P(SEG,"|",2),(I,J,P,DONE)=0 166 F D Q:DONE 167 . S P=P+1,Y=$P(X,"~",P) I Y="" S DONE=1 Q 168 . I P<$L(X,"~") S I=I+1,ORQT(I)=Y Q 169 . I $L(SEG,"|")>2 S I=I+1,ORQT(I)=Y,DONE=1 Q 170 . S J=+$O(@ORMSG@(+RXE,J)) I J'>0 S I=I+1,ORQT(I)=Y,DONE=1 Q 171 . S SEG=$G(@ORMSG@(+RXE,J)),X=$P(SEG,"|"),P=1,I=I+1,ORQT(I)=Y_$P(X,"~") 172 S ORQT=I Q:'ORQT ; else reset ORSTRT, ORSTOP, ORURG 173 S ORSTRT=$P(ORQT(1),U,4),ORSTOP=$P(ORQT(ORQT),U,5),ORURG=$P(ORQT(1),U,6) 174 S:ORSTRT ORSTRT=$$FMDATE^ORM(ORSTRT) S:ORSTOP ORSTOP=$$FMDATE^ORM(ORSTOP) S:$L(ORURG) ORURG=$$URGENCY^ORM(ORURG) 175 Q
Note:
See TracChangeset
for help on using the changeset viewer.
