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

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 7.1 KB
Line 
1ORCHTAB3 ;SLC/MKB,dcm-Add item to tab listing ; 08 May 2002 2:12 PM
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**27,45,86,92,110,141**;Dec 17, 1997
3ORDER ; -- order
4 N ID,ORACT,OR0,OR3,ORA0,DATES,TIMES,STATUS,PROV,ORVER,DATA,ORIGVIEW,ORTX,IDX,ORJ,J
5 S ID=ORIFN,ORACT=+$P(ORIFN,";",2) S:'ORACT ORACT=1
6 S OR0=$G(^OR(100,+ORIFN,0)),OR3=$G(^(3)),ORA0=$G(^(8,ORACT,0))
7 D DATES S ORVER=$$VERIFIED ;set DATES, [TIMES], ORVER
8 S STATUS=$S($P(ORA0,U,15):$P(ORA0,U,15),1:$P(OR3,U,3))
9 I $P(ORA0,U,15)=10,$P(OR3,U,3)=14 S STATUS=14 ;delayed-lapsed order
10 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
11ORD1 I FRMT'="S" D
12 . S STATUS=$P($G(^ORD(100.01,+STATUS,0)),U,2)
13 . S PROV=+$S($P(ORA0,U,5):$P(ORA0,U,5),1:$P(ORA0,U,3))
14 . S DATA(1)=$$PAD^ORCHTAB($$LNAMEF^ORCHTAB(PROV),12)_$$PAD^ORCHTAB(DATES,17)_$$PAD^ORCHTAB(STATUS,4)_ORVER,DATA=1
15 . I $L($G(TIMES)) S DATA=2,DATA(2)=" "_TIMES
16 S ORIGVIEW=$S(MULT:0,$P(CONTEXT,";",3)'=2:1,'ORYD:1,$P(ORA0,U)'<ORYD:0,1:1)
17 D TEXT^ORQ12(.ORTX,ORIFN,40) ; get order text
18ORD2 D ADD^ORCHTAB S IDX=$G(^TMP("OR",$J,ORTAB,"IDX",NUM))
19 I $O(^OR(100,+ORIFN,2,0)) S ORJ=+$P(IDX,U,2),$E(^TMP("OR",$J,ORTAB,ORJ,0),5)="+" ;child orders exist
20 I $P(ORA0,U,14)>1 S ORJ=+$P(IDX,U,2),$E(^TMP("OR",$J,ORTAB,ORJ,0),5)="*" ;pkg updated
21 I $P($G(^OR(100,+ORIFN,8,ORACT,3)),U) D ; flagged
22 . S ORJ=+$P(IDX,U,2) K ^TMP("OR",$J,ORTAB,"VIDEO",ORJ)
23 . D SETVIDEO^ORCHTAB(ORJ,1,3,IORVON,IORVOFF)
24 F ORJ=+$P(IDX,U,2):1:($P(IDX,U,2)+$P(IDX,U,3)-1) D ; unsigned
25 . S J=$F(^TMP("OR",$J,ORTAB,ORJ,0),"*UNSIGNED*")
26 . D:J SETVIDEO^ORCHTAB(ORJ,J-10,10,IOINHI,IOINORM)
27 Q
28 ;
29DELAYED ; -- Delayed order
30 N OR0,ORA0,OR3,ORIGVIEW,ORTX,PROV,EVNT,ID,IDX,ORJ,J,STATUS,START,ORVER,DATA
31 S OR0=$G(^OR(100,+ORIFN,0)),OR3=$G(^(3)),ORA0=$G(^(8,1,0))
32 S PROV=+$S($P(ORA0,U,5):$P(ORA0,U,5),1:$P(ORA0,U,3)),ORIGVIEW=1
33 S STATUS=+$S($P(ORA0,U,15):$P(ORA0,U,15),1:$P(OR3,U,3))
34 S STATUS=$$LOW^XLFSTR($P($G(^ORD(100.01,STATUS,0)),U,2))
35 S EVNT=$$SHORTNM^OREVNTX(+$P(OR0,U,17)),ORVER=$$VERIFIED
36 I $P(OR3,U,3)=6 S START=$$DATETIME^ORCHTAB($P(OR0,U,8)),EVNT=$E(START,1,15)
37 ;S ORD=$S(STS=16:STATUS,1:SPEC),ORC=$S(STS=16:"Status",1:"To Specialty")
38 ;I FRMT="S" S DATA(1)=$$PAD^ORCHTAB(ORD,33)_ORVER,ORCAPTN("DATA")=ORC
39 S DATA(1)=$$PAD^ORCHTAB($$LNAMEF^ORCHTAB(PROV),12)_$$PAD^ORCHTAB(EVNT,17)_$$PAD^ORCHTAB(STATUS,4)_ORVER,ORCAPTN("DATA")="Provider Start/Event Sts"
40 D TEXT^ORQ12(.ORTX,ORIFN,40) S ID=ORIFN,DATA=1
41 D ADD^ORCHTAB S IDX=$G(^TMP("OR",$J,ORTAB,"IDX",NUM))
42 F ORJ=+$P(IDX,U,2):1:($P(IDX,U,2)+$P(IDX,U,3)-1) D ; unsigned
43 . S J=$F(^TMP("OR",$J,ORTAB,ORJ,0),"*UNSIGNED*")
44 . D:J SETVIDEO^ORCHTAB(ORJ,J-10,10,IOINHI,IOINORM)
45 Q
46 ;
47DATES ; -- Return start and stop dates for display in DATES [,TIMES]
48 N SHORT,ACT,START,STOP,T1,T2
49 S DATES="",SHORT=(FRMT="S"),ACT=$P(ORA0,U,2)
50 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))
51 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))
52 I '$L(STOP) D Q ;Short format or no Stop date/time
53 . S START=$$DATETIME^ORCHTAB(START) S:SHORT DATES=$E(START,1,14)
54 . S:'SHORT DATES=$E($P(START," "),1,14),TIMES=$E($P(START," ",2),1,14)
55 S STOP=$$DATETIME^ORCHTAB(STOP),T2=$P(STOP," ",2)
56 I '$L(START) D Q ;Long format but no Start date/time
57 . S DATES=$J($E($P(STOP," "),1,14),15)
58 . S:$L(T2) TIMES=$J($E(T2,1,14),15)
59 S START=$$DATETIME^ORCHTAB(START,1),T1=$P(START," ",2)
60 S DATES=$$LJ^XLFSTR($E($P(START," "),1,5),5)_" "_$J($E($P(STOP," "),1,8),8)
61 S:$L(T1)!$L(T2) TIMES=$$LJ^XLFSTR($E(T1,1,5),10)_$J($E(T2,1,5),5)
62 Q
63 ;
64VERIFIED() ; -- Returns string of verifiers' initials
65 N ORV,ORX,ORVER S ORVER=""
66 F ORV=8,10,18 D ;ck nurse, clerk, and chart reviewers
67 . S ORX=$P(ORA0,U,ORV) I ORX'>0 S ORVER=ORVER_" " Q
68 . S ORX=$$INITIALS(ORX),ORVER=ORVER_$$LJ^XLFSTR(ORX,7)
69 Q ORVER
70 ;
71INITIALS(USER) ; -- Return initials of USER
72 N X,Y S X=$G(^VA(200,+$G(USER),0)),Y=$P(X,U,2)
73 S:'$L(Y) Y=" x "
74 Q Y
75 ;
76MEDS ; -- medications
77 N ID,START,STOP,STATUS,ORIFN,TYPE,DATA,ORTX,PROV,I,X,IDX,ORJ
78 S ID=$P(ORX,U),STOP=$P(ORX,U,4),ORIFN=$P(ORX,U,8)
79 S PROV=$S($G(^TMP("PS",$J,ORI,"P",0)):+^(0),1:+$P($G(^OR(100,+ORIFN,0)),U,4))
80 S STATUS=$$LOW^XLFSTR($P(ORX,U,9)) S:STATUS["(edit)" STATUS="dc/edit"
81 S:STATUS="suspended" STATUS="active/susp"
82 S:'INPT DATA(1)=$$PAD^ORCHTAB($$LNAMEF^ORCHTAB(PROV),12)_$$PAD^ORCHTAB($$DATE^ORCHTAB(STOP),10)_STATUS,DATA=1 I INPT D
83 . S START=$P($G(^OR(100,+ORIFN,0)),U,8),START=$$DATETIME^ORCHTAB(START)
84 . S STOP=$$DATETIME^ORCHTAB(STOP)
85 . S DATA(1)=$$PAD^ORCHTAB($P(START," "),10)_$$PAD^ORCHTAB($P(STOP," "),10)_STATUS
86 . S DATA=2,DATA(2)=$$PAD^ORCHTAB($P(START," ",2),10)_$P(STOP," ",2)
87 S TYPE=$S($O(^TMP("PS",$J,ORI,"B",0)):"IV",$O(^TMP("PS",$J,ORI,"A",0)):"IV",1:"DRUG") D @TYPE
88 D ADD^ORCHTAB K ORTX,DATA I INPT D
89 . 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
90 . S I=0 F S I=$O(ORTX(I)) Q:I'>0 S X=ORTX(I) D:$L(X) LINE^ORCHTAB
91 I 'INPT,$P(ORX,U,10) D
92 . S X=" Last Filled: "_$$DATE^ORCHTAB($P(ORX,U,10))_", "_+$P(ORX,U,5)_" refill(s) left"
93 . D LINE^ORCHTAB
94 S IDX=$G(^TMP("OR",$J,ORTAB,"IDX",NUM))
95 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
96 Q
97 ;
98DRUG ; -- UD or Outpt med
99 N I,X,NODE S X=$P(ORX,U,2),NODE="" ; drug name
100 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:"")
101 S:$L(X)'>ORMAX ORTX=1,ORTX(1)=X I $L(X)>ORMAX D TXT^ORCHTAB
102 S ORTX=ORTX+1,ORTX(ORTX)=$S(INPT:" Give:",1:" Sig:")_$S($P(ORX,U,13):" *** NOT TO BE GIVEN ***",1:"")
103 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
104 S NODE=$S(INPT:"SIG",$O(^TMP("PS",$J,ORI,"SIG",0)):"SIG",1:"SIO")
105 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
106D1 I 'INPT,NODE'="SIO" Q ; done
107 S I=$O(^TMP("PS",$J,ORI,"MDR",0)),X=$G(^(+I,0)) D:$L(X) TXT^ORCHTAB
108 S I=$O(^TMP("PS",$J,ORI,"SCH",0)),X=$P($G(^(+I,0)),U) D:$L(X) TXT^ORCHTAB
109 Q
110 ;
111IV ; -- IV Fluid
112 N I,X,X0,Y
113 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),"^"," ")
114 I $L(X) S X=X_" in" D TXT^ORCHTAB
115 S I=0,X="" F S I=$O(^TMP("PS",$J,ORI,"B",I)) Q:I'>0 S X0=$G(^(I,0)) D
116 . S Y=$P(X0,U)_" "_$S($L($P(X0,U,3)):$P(X0,U,3)_" ",1:"")_$P(X0,U,2)
117 . S X=X_$S($L(X):", ",1:"")_Y
118 D:$L(X) TXT^ORCHTAB S I=$O(^TMP("PS",$J,ORI,"SCH",0))
119 I I S X=$P($G(^(I,0)),U) D:$L(X) TXT^ORCHTAB Q ;add schedule and Q if exists
120 S X=$P(ORX,U,3) D:$L(X) TXT^ORCHTAB ;infusion rate
121 Q
122 ;
123SORT(TYPE) ; -- sort Meds tab by status into ^TMP("ORPS",$J,STS)
124 N ACTIVE,NONACT,NONVER,I,X,ID,STS,SUB
125 S ACTIVE="^ACTIVE^REINSTATED^RENEWED^HOLD^ON CALL^SUSPENDED^REFILL^PROVIDER HOLD^",NONVER="^PENDING^NON-VERIFIED^NON VERIFIED^INCOMPLETE^DRUG INTERACTIONS^"
126 S NONACT="^DONE^EXPIRED^DISCONTINUED^DELETED^PURGE^DISCONTINUED (EDIT)^DISCONTINUED (RENEWAL)^DISCONTINUED BY PROVIDER^"
127 S I=0 F S I=$O(^TMP("PS",$J,I)) Q:I'>0 S X=$G(^(I,0)) D
128 . S ID=$P(X,U) Q:INPT&($P(ID,";",2)'="I") Q:'INPT&($P(ID,";",2)="I")
129 . S STS=U_$P(X,U,9)_U,SUB=$S(ACTIVE[STS:1,NONVER[STS:2,1:3),^TMP("ORPS",$J,SUB,I)=""
130 Q
Note: See TracBrowser for help on using the repository browser.