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