source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCHTAB3.m@ 635

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