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