VistA-FOIAVistA/r/ORDER_ENTRY_RESULTS_REPORTI.../ORCHTAB3.m

131 lines
7.1 KiB
Mathematica

ORCHTAB3 ;SLC/MKB,dcm-Add item to tab listing ; 08 May 2002 2:12 PM
;;3.0;ORDER ENTRY/RESULTS REPORTING;**27,45,86,92,110,141**;Dec 17, 1997
ORDER ; -- order
N ID,ORACT,OR0,OR3,ORA0,DATES,TIMES,STATUS,PROV,ORVER,DATA,ORIGVIEW,ORTX,IDX,ORJ,J
S ID=ORIFN,ORACT=+$P(ORIFN,";",2) S:'ORACT ORACT=1
S OR0=$G(^OR(100,+ORIFN,0)),OR3=$G(^(3)),ORA0=$G(^(8,ORACT,0))
D DATES S ORVER=$$VERIFIED ;set DATES, [TIMES], ORVER
S STATUS=$S($P(ORA0,U,15):$P(ORA0,U,15),1:$P(OR3,U,3))
I $P(ORA0,U,15)=10,$P(OR3,U,3)=14 S STATUS=14 ;delayed-lapsed order
S:FRMT="S" STATUS=$$LOW^XLFSTR($P($G(^ORD(100.01,+STATUS,0)),U)),DATA(1)=$$PAD^ORCHTAB(DATES,16)_$$PAD^ORCHTAB(STATUS,17)_ORVER,DATA=1
ORD1 I FRMT'="S" D
. S STATUS=$P($G(^ORD(100.01,+STATUS,0)),U,2)
. S PROV=+$S($P(ORA0,U,5):$P(ORA0,U,5),1:$P(ORA0,U,3))
. S DATA(1)=$$PAD^ORCHTAB($$LNAMEF^ORCHTAB(PROV),12)_$$PAD^ORCHTAB(DATES,17)_$$PAD^ORCHTAB(STATUS,4)_ORVER,DATA=1
. I $L($G(TIMES)) S DATA=2,DATA(2)=" "_TIMES
S ORIGVIEW=$S(MULT:0,$P(CONTEXT,";",3)'=2:1,'ORYD:1,$P(ORA0,U)'<ORYD:0,1:1)
D TEXT^ORQ12(.ORTX,ORIFN,40) ; get order text
ORD2 D ADD^ORCHTAB S IDX=$G(^TMP("OR",$J,ORTAB,"IDX",NUM))
I $O(^OR(100,+ORIFN,2,0)) S ORJ=+$P(IDX,U,2),$E(^TMP("OR",$J,ORTAB,ORJ,0),5)="+" ;child orders exist
I $P(ORA0,U,14)>1 S ORJ=+$P(IDX,U,2),$E(^TMP("OR",$J,ORTAB,ORJ,0),5)="*" ;pkg updated
I $P($G(^OR(100,+ORIFN,8,ORACT,3)),U) D ; flagged
. S ORJ=+$P(IDX,U,2) K ^TMP("OR",$J,ORTAB,"VIDEO",ORJ)
. D SETVIDEO^ORCHTAB(ORJ,1,3,IORVON,IORVOFF)
F ORJ=+$P(IDX,U,2):1:($P(IDX,U,2)+$P(IDX,U,3)-1) D ; unsigned
. S J=$F(^TMP("OR",$J,ORTAB,ORJ,0),"*UNSIGNED*")
. D:J SETVIDEO^ORCHTAB(ORJ,J-10,10,IOINHI,IOINORM)
Q
;
DELAYED ; -- Delayed order
N OR0,ORA0,OR3,ORIGVIEW,ORTX,PROV,EVNT,ID,IDX,ORJ,J,STATUS,START,ORVER,DATA
S OR0=$G(^OR(100,+ORIFN,0)),OR3=$G(^(3)),ORA0=$G(^(8,1,0))
S PROV=+$S($P(ORA0,U,5):$P(ORA0,U,5),1:$P(ORA0,U,3)),ORIGVIEW=1
S STATUS=+$S($P(ORA0,U,15):$P(ORA0,U,15),1:$P(OR3,U,3))
S STATUS=$$LOW^XLFSTR($P($G(^ORD(100.01,STATUS,0)),U,2))
S EVNT=$$SHORTNM^OREVNTX(+$P(OR0,U,17)),ORVER=$$VERIFIED
I $P(OR3,U,3)=6 S START=$$DATETIME^ORCHTAB($P(OR0,U,8)),EVNT=$E(START,1,15)
;S ORD=$S(STS=16:STATUS,1:SPEC),ORC=$S(STS=16:"Status",1:"To Specialty")
;I FRMT="S" S DATA(1)=$$PAD^ORCHTAB(ORD,33)_ORVER,ORCAPTN("DATA")=ORC
S DATA(1)=$$PAD^ORCHTAB($$LNAMEF^ORCHTAB(PROV),12)_$$PAD^ORCHTAB(EVNT,17)_$$PAD^ORCHTAB(STATUS,4)_ORVER,ORCAPTN("DATA")="Provider Start/Event Sts"
D TEXT^ORQ12(.ORTX,ORIFN,40) S ID=ORIFN,DATA=1
D ADD^ORCHTAB S IDX=$G(^TMP("OR",$J,ORTAB,"IDX",NUM))
F ORJ=+$P(IDX,U,2):1:($P(IDX,U,2)+$P(IDX,U,3)-1) D ; unsigned
. S J=$F(^TMP("OR",$J,ORTAB,ORJ,0),"*UNSIGNED*")
. D:J SETVIDEO^ORCHTAB(ORJ,J-10,10,IOINHI,IOINORM)
Q
;
DATES ; -- Return start and stop dates for display in DATES [,TIMES]
N SHORT,ACT,START,STOP,T1,T2
S DATES="",SHORT=(FRMT="S"),ACT=$P(ORA0,U,2)
S START=$S($P(OR3,U,3)=11:$$VALUE^ORX8(+ORIFN,"START"),ACT="NW"!(ACT="XX")!(ACT="RL"):$P(OR0,U,8),ACT="DC":"",1:$P(ORA0,U))
S STOP=$S(SHORT:"",$P(OR3,U,3)=11:$$VALUE^ORX8(+ORIFN,"STOP"),ACT="HD":$P($G(^OR(100,+ORIFN,8,ORACT,2)),U),1:$P(OR0,U,9))
I '$L(STOP) D Q ;Short format or no Stop date/time
. S START=$$DATETIME^ORCHTAB(START) S:SHORT DATES=$E(START,1,14)
. S:'SHORT DATES=$E($P(START," "),1,14),TIMES=$E($P(START," ",2),1,14)
S STOP=$$DATETIME^ORCHTAB(STOP),T2=$P(STOP," ",2)
I '$L(START) D Q ;Long format but no Start date/time
. S DATES=$J($E($P(STOP," "),1,14),15)
. S:$L(T2) TIMES=$J($E(T2,1,14),15)
S START=$$DATETIME^ORCHTAB(START,1),T1=$P(START," ",2)
S DATES=$$LJ^XLFSTR($E($P(START," "),1,5),5)_" "_$J($E($P(STOP," "),1,8),8)
S:$L(T1)!$L(T2) TIMES=$$LJ^XLFSTR($E(T1,1,5),10)_$J($E(T2,1,5),5)
Q
;
VERIFIED() ; -- Returns string of verifiers' initials
N ORV,ORX,ORVER S ORVER=""
F ORV=8,10,18 D ;ck nurse, clerk, and chart reviewers
. S ORX=$P(ORA0,U,ORV) I ORX'>0 S ORVER=ORVER_" " Q
. S ORX=$$INITIALS(ORX),ORVER=ORVER_$$LJ^XLFSTR(ORX,7)
Q ORVER
;
INITIALS(USER) ; -- Return initials of USER
N X,Y S X=$G(^VA(200,+$G(USER),0)),Y=$P(X,U,2)
S:'$L(Y) Y=" x "
Q Y
;
MEDS ; -- medications
N ID,START,STOP,STATUS,ORIFN,TYPE,DATA,ORTX,PROV,I,X,IDX,ORJ
S ID=$P(ORX,U),STOP=$P(ORX,U,4),ORIFN=$P(ORX,U,8)
S PROV=$S($G(^TMP("PS",$J,ORI,"P",0)):+^(0),1:+$P($G(^OR(100,+ORIFN,0)),U,4))
S STATUS=$$LOW^XLFSTR($P(ORX,U,9)) S:STATUS["(edit)" STATUS="dc/edit"
S:STATUS="suspended" STATUS="active/susp"
S:'INPT DATA(1)=$$PAD^ORCHTAB($$LNAMEF^ORCHTAB(PROV),12)_$$PAD^ORCHTAB($$DATE^ORCHTAB(STOP),10)_STATUS,DATA=1 I INPT D
. S START=$P($G(^OR(100,+ORIFN,0)),U,8),START=$$DATETIME^ORCHTAB(START)
. S STOP=$$DATETIME^ORCHTAB(STOP)
. S DATA(1)=$$PAD^ORCHTAB($P(START," "),10)_$$PAD^ORCHTAB($P(STOP," "),10)_STATUS
. S DATA=2,DATA(2)=$$PAD^ORCHTAB($P(START," ",2),10)_$P(STOP," ",2)
S TYPE=$S($O(^TMP("PS",$J,ORI,"B",0)):"IV",$O(^TMP("PS",$J,ORI,"A",0)):"IV",1:"DRUG") D @TYPE
D ADD^ORCHTAB K ORTX,DATA I INPT D
. S I=0 F S I=$O(^TMP("PS",$J,ORI,"SIO",I)) Q:I'>0 S X=$G(^(I,0)) D:$L(X) TXT^ORCHTAB
. S I=0 F S I=$O(ORTX(I)) Q:I'>0 S X=ORTX(I) D:$L(X) LINE^ORCHTAB
I 'INPT,$P(ORX,U,10) D
. S X=" Last Filled: "_$$DATE^ORCHTAB($P(ORX,U,10))_", "_+$P(ORX,U,5)_" refill(s) left"
. D LINE^ORCHTAB
S IDX=$G(^TMP("OR",$J,ORTAB,"IDX",NUM))
I $O(^OR(100,+ORIFN,8,"C","XX",0)) S ORJ=+$P(IDX,U,2),$E(^TMP("OR",$J,ORTAB,ORJ,0),5)="*" ;pkg updated
Q
;
DRUG ; -- UD or Outpt med
N I,X,NODE S X=$P(ORX,U,2),NODE="" ; drug name
I 'INPT,$P(ORX,U,12) S X=X_" Qty: "_$P(ORX,U,12)_$S($P(ORX,U,11):" for "_$P(ORX,U,11)_" days",1:"")
S:$L(X)'>ORMAX ORTX=1,ORTX(1)=X I $L(X)>ORMAX D TXT^ORCHTAB
S ORTX=ORTX+1,ORTX(ORTX)=$S(INPT:" Give:",1:" Sig:")_$S($P(ORX,U,13):" *** NOT TO BE GIVEN ***",1:"")
I INPT S X=$S($L($P(ORX,U,6)):$P(ORX,U,6),1:$P(ORX,U,7)) I $L(X) D TXT^ORCHTAB G D1
S NODE=$S(INPT:"SIG",$O(^TMP("PS",$J,ORI,"SIG",0)):"SIG",1:"SIO")
S I=0 F S I=$O(^TMP("PS",$J,ORI,NODE,I)) Q:I'>0 S X=$G(^(I,0)) D:$L(X) TXT^ORCHTAB ; instructions or sig
D1 I 'INPT,NODE'="SIO" Q ; done
S I=$O(^TMP("PS",$J,ORI,"MDR",0)),X=$G(^(+I,0)) D:$L(X) TXT^ORCHTAB
S I=$O(^TMP("PS",$J,ORI,"SCH",0)),X=$P($G(^(+I,0)),U) D:$L(X) TXT^ORCHTAB
Q
;
IV ; -- IV Fluid
N I,X,X0,Y
S I=0,X="" F S I=$O(^TMP("PS",$J,ORI,"A",I)) Q:I'>0 S X=X_$S($L(X):", ",1:"")_$TR(^(I,0),"^"," ")
I $L(X) S X=X_" in" D TXT^ORCHTAB
S I=0,X="" F S I=$O(^TMP("PS",$J,ORI,"B",I)) Q:I'>0 S X0=$G(^(I,0)) D
. S Y=$P(X0,U)_" "_$S($L($P(X0,U,3)):$P(X0,U,3)_" ",1:"")_$P(X0,U,2)
. S X=X_$S($L(X):", ",1:"")_Y
D:$L(X) TXT^ORCHTAB S I=$O(^TMP("PS",$J,ORI,"SCH",0))
I I S X=$P($G(^(I,0)),U) D:$L(X) TXT^ORCHTAB Q ;add schedule and Q if exists
S X=$P(ORX,U,3) D:$L(X) TXT^ORCHTAB ;infusion rate
Q
;
SORT(TYPE) ; -- sort Meds tab by status into ^TMP("ORPS",$J,STS)
N ACTIVE,NONACT,NONVER,I,X,ID,STS,SUB
S ACTIVE="^ACTIVE^REINSTATED^RENEWED^HOLD^ON CALL^SUSPENDED^REFILL^PROVIDER HOLD^",NONVER="^PENDING^NON-VERIFIED^NON VERIFIED^INCOMPLETE^DRUG INTERACTIONS^"
S NONACT="^DONE^EXPIRED^DISCONTINUED^DELETED^PURGE^DISCONTINUED (EDIT)^DISCONTINUED (RENEWAL)^DISCONTINUED BY PROVIDER^"
S I=0 F S I=$O(^TMP("PS",$J,I)) Q:I'>0 S X=$G(^(I,0)) D
. S ID=$P(X,U) Q:INPT&($P(ID,";",2)'="I") Q:'INPT&($P(ID,";",2)="I")
. S STS=U_$P(X,U,9)_U,SUB=$S(ACTIVE[STS:1,NONVER[STS:2,1:3),^TMP("ORPS",$J,SUB,I)=""
Q