source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCHANG2.m@ 619

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

initial load of WorldVistAEHR
File size: 5.1 KB
RevLine 
[613]1ORCHANG2 ;SLC/MKB-Change View status ; 08 May 2002 2:12 PM
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**27,72,68,141,215,243**;Dec 17, 1997;Build 242
3ORDERS ; -- Select new order status
4 N X,Y,HDR,I,DOMAIN,DEFAULT,PROMPT,HELP,STS
5 S HDR=$P($G(^TMP("OR",$J,ORTAB,0)),U,3),DEFAULT=""
6 F I=1:1 S X=$T(ORDSTS+I) Q:$P(X,";",4)="ZZZZ" D SET
7 S DOMAIN(0)=I-1,PROMPT="Select Order Status: "
8 S HELP="Enter the status of orders you wish to see listed here."
9 D EN Q:Y="^" S STS=+$G(DOMAIN(Y))
10 I "^8^9^10^20^"[(U_STS_U) D Q:Y="^"
11 . N STRT,STOP,Z
12 . S STRT=$$START^ORCHANGE("NOW-24H") I STRT="^" S Y="^" Q
13 . S STOP=$$STOP^ORCHANGE("NOW") I STOP="^" S Y="^" Q
14 . I STOP<STRT S Z=STRT,STRT=STOP,STOP=Z
15 . S $P(HDR,";",1,2)=$P(STRT,U,2)_";"_$P(STOP,U,2)
16 S $P(HDR,";",3)=STS,$P(HDR,";",8)=""
17 I (STS=2)!(STS=5) D
18 . I $P(HDR,";")'="" D
19 . . N THISTS,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
20 . . S THISTS=" only active "
21 . . S:STS=5 THISTS=" expiring "
22 . . W !,"Date range can not be selected when viewing"_THISTS_"orders"
23 . . W !,"and will be cleared."
24 . . S DIR(0)="E" D ^DIR
25 . S $P(HDR,";",1,2)=";"
26 I STS=6,$P(HDR,";")="" S $P(HDR,";",1,2)="T;T@23:59"
27 S $P(^TMP("OR",$J,ORTAB,0),U,3,4)=HDR_U
28 Q
29 ;
30STSLST(ORY) ; -- Returns array of order views as
31 ; ORY(n) = id ^ name ^ parent id [^+ if has members]
32 N I,X,CNT S CNT=0
33 F I=1:1 S X=$T(ORDSTS+I) Q:$P(X,";",4)="ZZZZ" S CNT=CNT+1,ORY(CNT)=$TR($P(X,";",3,6),";","^")
34 ; include specific patient events??
35 Q
36 ;
37ORDSTS ;;#;Name of Order Context
38 ;;1;All;0;+
39 ;;2;Active (includes pending, recent activity);1
40 ;;23;Current (Active & Pending status only);1
41 ;;3;Discontinued;1
42 ;;28;Discontinued/Entered in Error;1
43 ;;4;Completed/Expired;1
44 ;;5;Expiring;1
45 ;;7;Pending;1
46 ;;18;On Hold;1
47 ;;19;New Orders;1
48 ;;11;Unsigned;1
49 ;;8;Unverified by anyone;1;+
50 ;;9;Unverified by Nursing;8
51 ;;10;Unverified by Clerk;8
52 ;;20;Unverified/Chart Review;8
53 ;;13;Verbal/Phoned;1;+
54 ;;14;Verbal/Phoned unsigned;13
55 ;;12;Flagged;1
56 ;;6;Recent Activity (defaults to today's orders);1
57 ;;24;Delayed (all events);1;+
58 ;;15;Delayed Admission;24
59 ;;17;Delayed Transfer;24
60 ;;16;Delayed Discharge;24
61 ;;25;Delayed Return from O.R.;24
62 ;;26;Delayed for Manual Release;24
63 ;;22;Lapsed (never processed);1
64 ;;;ZZZZ
65 ;
66STS ; -- Select new [order or consult] status
67 N HDR,DEFAULT,DOMAIN,PROMPT,HELP,X,Y,I
68 S HDR=$P($G(^TMP("OR",$J,ORTAB,0)),U,3),DEFAULT=""
69 S (I,Y)=0 F S I=$O(^ORD(100.01,I)) Q:I'>0 Q:I=99 S X=$G(^(I,0)) D
70 . Q:"^1^2^5^6^8^9^13^"'[(U_I_U) S Y=Y+1
71 . S DOMAIN(Y)=I_U_$$LOWER^VALM1($P(X,U)),DOMAIN("B",$P(X,U))=Y
72 . S:I=$P(HDR,";",3) DEFAULT=$P(DOMAIN(Y),U,2)
73 S Y=Y+1,DOMAIN(Y)="^All Statuses",DOMAIN("B","ALL STATUSES")=Y
74 S DOMAIN(0)=Y,PROMPT="Select Consult Status: "
75 S HELP="Enter the status of consults you wish to see listed here."
76 D EN Q:Y="^"
77 S $P(HDR,";",3)=$P(DOMAIN(Y),U),$P(^TMP("OR",$J,ORTAB,0),U,3,4)=HDR_U
78 Q
79 ;
80TIU ; -- Select new document status
81 N X,Y,ORY,I,CNT,HDR,DOMAIN,DEFAULT,PROMPT,HELP
82 S HDR=$P($G(^TMP("OR",$J,ORTAB,0)),U,3),DEFAULT=$P(HDR,";",3)
83 D STATUS^TIUSRVL(.ORY)
84 S (I,CNT)=0 F S I=$O(ORY(I)) Q:I'>0 S CNT=CNT+1,DOMAIN(CNT)=ORY(I),DOMAIN("B",$$UP^XLFSTR($P(ORY(I),U,2)))=CNT
85 S DOMAIN(0)=CNT,PROMPT="Select Signature Status: "
86 S HELP="Enter the signature status you would like to screen on"
87 D EN Q:Y="^"
88 S $P(HDR,";",3)=$P(DOMAIN(Y),U,2),$P(^TMP("OR",$J,ORTAB,0),U,3,4)=HDR_U
89 Q
90 ;
91PLIST ; -- Select problem status
92 N X,Y,HDR,I,ID,NAME,DOMAIN,DEFAULT,PROMPT,HELP
93 S HDR=$P($G(^TMP("OR",$J,ORTAB,0)),U,3)
94 F I=1:1 S X=$T(PLSTS+I) Q:$P(X,";",4)="ZZZZ" D SET
95 S DOMAIN(0)=I-1,PROMPT="Select Problem Status: "
96 S HELP="Enter the status of the problems you wish to see listed here."
97 D EN Q:Y="^"
98 S $P(HDR,";",3)=$P(DOMAIN(Y),U),$P(^TMP("OR",$J,ORTAB,0),U,3,4)=HDR_U
99 Q
100 ;
101PLSTS ;;I;name
102 ;;A;active
103 ;;I;inactive
104 ;;B;both active & inactive
105 ;;;ZZZZ
106 ;
107SET ; -- set DOMAIN(I)=ID^NAME, DEFAULT from X=";;ID;NAME"
108 N ID,NAME
109 S ID=$P(X,";",3),NAME=$P(X,";",4)
110 S DOMAIN(I)=ID_U_NAME,DOMAIN("B",$$UP^XLFSTR(NAME))=I
111 S:ID=$P(HDR,";",3) DEFAULT=NAME
112 Q
113 ;
114EN ; -- Select new status via DOMAIN(), PROMPT, DEFAULT, HELP
115 N DONE S DONE=0,Y="" F D Q:DONE
116 . W !,PROMPT_$S($L(DEFAULT):DEFAULT_"//",1:"")
117 . R X:DTIME S:'$T X="^" I X["^" S Y="^",DONE=1 Q
118 . S:X="" X=DEFAULT I X="" S Y="^",DONE=1 Q
119 . I X["?" W !!,HELP D LIST Q
120 . D I 'Y W $C(7),!,HELP Q
121 . . N XP,XY,CNT,MATCH,DIR,I
122 . . S X=$$UP^XLFSTR(X),Y=+$G(DOMAIN("B",X)) Q:Y ; done
123 . . S CNT=0,XP=X F S XP=$O(DOMAIN("B",XP)) Q:XP="" Q:$E(XP,1,$L(X))'=X S CNT=CNT+1,XY=+DOMAIN("B",XP),MATCH(CNT)=XY_U_$P(DOMAIN(XY),U,2)
124 . . Q:'CNT
125 . . I CNT=1 S Y=+MATCH(1),XP=$P(MATCH(1),U,2) W $E(XP,$L(X)+1,$L(XP)) Q
126 . . S DIR(0)="NAO^1:"_CNT,DIR("A")="Select 1-"_CNT_": "
127 . . F I=1:1:CNT S DIR("A",I)=$J(I,3)_" "_$P(MATCH(I),U,2)
128 . . S DIR("?")="Select the desired value, by number"
129 . . I CNT>3 D FULL^VALM1 S VALMBCK="R" ;need to scroll
130 . . D ^DIR I $D(DIRUT) S Y="" Q
131 . . S Y=+MATCH(Y) W " "_$P(DOMAIN(Y),U,2)
132 . S DONE=1
133 Q
134 ;
135LIST ; -- List order statuses in DOMAIN
136 N I,Z,CNT,DONE D FULL^VALM1 S VALMBCK="R"
137 S CNT=0 W !,"Choose from:"
138 F I=1:1:DOMAIN(0) D Q:$G(DONE)
139 . S CNT=CNT+1 W ! I CNT>(IOSL-3) D Q:$G(DONE)
140 .. W ?3,"'^' TO STOP: " R Z:DTIME S:'$T!(Z["^") DONE=1 S CNT=1
141 . W $C(13)," "_$P(DOMAIN(I),U,2)
142 Q
Note: See TracBrowser for help on using the repository browser.