- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCHTAB3 7408 printed Apr 23, 2025@18:43:03 Page 2
- 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
