1 | ORPRS01 ; slc/dcm - Hot'n Summary Report utilities ;6/10/97 15:37
|
---|
2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11**;Dec 17, 1997
|
---|
3 | P ; Get Patient(s)
|
---|
4 | N %X,%Y,C,DIC,DFN,I,ORATTEND,Y
|
---|
5 | K ORSCPAT,^XUTL("OR",$J,"ORU"),^("ORV"),^("ORW"),^("ORLP")
|
---|
6 | S ORSHORT=$$SHORT^ORPRS02
|
---|
7 | D PATIENT^ORU1(.ORSCPAT,,1)
|
---|
8 | I $S($D(DIROUT):1,$D(DUOUT):1,1:0) S (OREND,XQORPOP)=1
|
---|
9 | Q
|
---|
10 | DAY(DAY) ; Get a date for 24 hr printing
|
---|
11 | ;DAY=Optional date for default date prompt
|
---|
12 | ;Returns: ORSSTRT=Internal Start date/time_"^"_Formatted Start date/time
|
---|
13 | ; ORSSTOP=Internal Stop date/time_"^"_Formatted Stop date/time
|
---|
14 | ; OREND,XQORPOP=1 if user ^'s or times out
|
---|
15 | ; DIROUT=1 if user ^^'s out
|
---|
16 | N %,%DT,%I,%T,%H,ORSDFLT,X,Y
|
---|
17 | D1 ;
|
---|
18 | S OREND=0,ORSDFLT=$S($G(DAY):$S($P(DAY,".",2)=2359:DAY+.7641,1:DAY),1:"T")
|
---|
19 | W !!,"Order Entry Date: "_$S(+ORSDFLT>0:$$DATE^ORU(ORSDFLT,"AMTH DD, CCYY"),1:"T")_"// "
|
---|
20 | R X:$S($D(DTIME):DTIME,1:300)
|
---|
21 | I $S(X="^":1,X="^^":1,'$T:1,1:0) S (OREND,XQORPOP)=1 S:X="^^" DIROUT=1 Q
|
---|
22 | S:X="" X=ORSDFLT
|
---|
23 | S %DT="EX"
|
---|
24 | D ^%DT
|
---|
25 | I X["?" K DAY G D1
|
---|
26 | I Y<1 W $C(7),?40,"Invalid Date." K DAY G D1
|
---|
27 | S ORSSTRT=Y-.7641_"^"_$$FMTE^XLFDT(Y-.7641),ORSSTOP=Y+.2359_"^"_$$FMTE^XLFDT(Y+.2359)
|
---|
28 | Q
|
---|
29 | RANGE(X1,X2) ; Get a date range for printing
|
---|
30 | ;X1=Default Start Date/time
|
---|
31 | ;X2=Default Stop Date/time
|
---|
32 | N %DT,%T,ORSDFLT,X,Y
|
---|
33 | I $D(ORPRES),+ORPRES=6!(+ORPRES=15)!(+ORPRES=16)!(+ORPRES=17) S (ORSSTRT,ORSSTOP)="" Q
|
---|
34 | R ;
|
---|
35 | S OREND=0,ORSDFLT=$S($G(X1)>0:$S($P(X1,".",2)=2359:X1+.7641,1:X1),1:"T")
|
---|
36 | W !!,"Start Date [Time]: "_$S(ORSDFLT>0:$$DATE^ORU(ORSDFLT,"AMTH DD, CCYY"),1:ORSDFLT)_"// "
|
---|
37 | R X:$S($D(DTIME):DTIME,1:300)
|
---|
38 | S:X="^"!('$T) (OREND,XQORPOP)=1
|
---|
39 | Q:OREND
|
---|
40 | S:X="" X=ORSDFLT
|
---|
41 | S %DT="EXT"
|
---|
42 | D ^%DT
|
---|
43 | G R:X["?"
|
---|
44 | I Y<1 W ?55,"Invalid Start Date/time." G R
|
---|
45 | S ORSSTRT=Y
|
---|
46 | E ; Get Ending Date/time
|
---|
47 | S ORSDFLT=$S($G(X2):$S($P(X2,".",2)'=2359:$P(X2,".")_".2359",1:X2),$G(ORSSTRT):$S($P(ORSSTRT,".",2)=2359:(ORSSTRT+.7641)_".2359",1:$P(ORSSTRT,".")_".2359"),1:"T@2359")
|
---|
48 | W !!,"Ending Date [Time] (inclusive): "_$S(+ORSDFLT>0:$$DATE^ORU(ORSDFLT,"AMTH DD, CCYY HR:MIN"),1:ORSDFLT)_"// "
|
---|
49 | R X:$S($D(DTIME):DTIME,1:300)
|
---|
50 | S:X="^"!('$T) (OREND,XQORPOP)=1
|
---|
51 | Q:OREND
|
---|
52 | S:X="" X=ORSDFLT
|
---|
53 | S %DT="EXT"
|
---|
54 | D ^%DT
|
---|
55 | G E:X["?"
|
---|
56 | I Y<1 W ?57,"Invalid End Date/time." G E
|
---|
57 | S ORSSTOP=Y
|
---|
58 | I ORSSTOP<ORSSTRT S X=ORSSTOP,ORSSTOP=ORSSTRT,ORSSTRT=X
|
---|
59 | S ORSSTOP=$S($L(ORSSTOP,".")=2:ORSSTOP,1:ORSSTOP+1)_"^"_$$FMTE^XLFDT(ORSSTOP)
|
---|
60 | S ORSSTRT=$S($L(ORSSTRT,".")=2:ORSSTRT,1:ORSSTRT-.7641)_"^"_$$FMTE^XLFDT(ORSSTRT)
|
---|
61 | Q
|
---|
62 | CUSTOM ; Selects order status and display group
|
---|
63 | N %,%Y,C,DIC,I,X,Y,XQORM,XQORSPEW,XQORNOD
|
---|
64 | S ORBUF=1
|
---|
65 | I $D(DIROUT)!($D(DTOUT)) S (OREND,XQORPOP)=1 Q
|
---|
66 | S:'$D(ORPRES) ORPRES="2;ACTIVE ORDERS"
|
---|
67 | D PRES^ORPRS09
|
---|
68 | I $G(OREND) S XQORPOP=1 Q
|
---|
69 | D SERV^ORPRS09
|
---|
70 | I $G(OREND) S XQORPOP=1 Q
|
---|
71 | Q
|
---|
72 | HSTS(X) ;Help for status descriptions (ORRP STATUS MENU protocol)
|
---|
73 | W !,"Valid selections are: "
|
---|
74 | I X["???" W ! D HACT1 W ! Q ;show descriptions and quit
|
---|
75 | D DISP^XQORM1
|
---|
76 | W !
|
---|
77 | Q
|
---|
78 | HACT1 ;
|
---|
79 | K ^TMP("ORRX",$J)
|
---|
80 | S Y=0 F I=0:0 S Y=$O(^ORD(101,+XQORNOD,10,Y)) Q:Y'>0 I $D(^ORD(101,+XQORNOD,10,Y,0)) S W=^(0),^TMP("ORRX",$J,$P(W,"^",3))=W
|
---|
81 | S Y=0 F I=1:1 S Y=$O(^TMP("ORRX",$J,Y)) Q:Y'>0 S X1=^(Y),W=+X1 D:I=20 READ^ORUTL W !,$P(X1,"^",2),?5 I W,$D(^ORD(101,W,0)) W $P(^(0),"^",2) I $P(^(0),"^",2)'=" ",$D(^ORD(101,W,1,1,0)) W " - "_^(0)
|
---|
82 | K W,X,^TMP("ORRX")
|
---|
83 | Q
|
---|
84 | EN(ORDG,ORSEL) ;Setup/Display groups
|
---|
85 | ;ORDG(optional)=ptr to display group to setup (All is the default)
|
---|
86 | ;ORSEL(optional)=Line label of action to take (BILD<default>, DISP)
|
---|
87 | ;Returns: ORGRP if ORSEL="BILD"
|
---|
88 | I $G(ORSEL)'="DISP" S ORSEL="BILD"
|
---|
89 | I '$G(ORDG) S ORDG=1 ;All if not specified
|
---|
90 | N ORMEM,ORSTK
|
---|
91 | S ORSTK=0
|
---|
92 | D @ORSEL
|
---|
93 | S ORSTK=1,ORSTK(ORSTK)=ORDG_"^0",ORSTK(0)=0,ORMEM=0
|
---|
94 | F I=0:0 S ORMEM=$O(^ORD(100.98,+ORSTK(ORSTK),1,ORMEM)) D @$S(+ORMEM'>0:"POP",1:"PROC") Q:ORSTK<1
|
---|
95 | Q
|
---|
96 | POP ;
|
---|
97 | S ORSTK=ORSTK-1,ORMEM=$P(ORSTK(ORSTK),"^",2)
|
---|
98 | Q
|
---|
99 | PROC ;
|
---|
100 | S $P(ORSTK(ORSTK),"^",2)=ORMEM,ORDG=$P(^ORD(100.98,+ORSTK(ORSTK),1,ORMEM,0),"^",1)
|
---|
101 | D @ORSEL
|
---|
102 | S ORSTK=ORSTK+1,ORSTK(ORSTK)=ORDG_"^0",ORMEM=0
|
---|
103 | Q
|
---|
104 | DISP ;
|
---|
105 | I $Y>(IOSL-4) D READ^ORUTL W @IOF
|
---|
106 | S W=^ORD(100.98,ORDG,0)
|
---|
107 | W !,?((ORSTK*2)),$P(W,"^")
|
---|
108 | Q
|
---|
109 | BILD ;
|
---|
110 | S ORGRP(ORDG)=""
|
---|
111 | Q
|
---|
112 | STOP ; Call DIR at bottom of screen
|
---|
113 | N DIR,X,Y
|
---|
114 | Q:$E(IOST)'="C"
|
---|
115 | I IOSL>($Y+5) F W ! Q:IOSL<($Y+6)
|
---|
116 | S DIR(0)="FO^1:1",DIR("A")="Press RETURN to continue or '^' to exit"
|
---|
117 | S DIR("?")="Enter '^' to quit present report or '^^' to quit to menu"
|
---|
118 | D ^DIR
|
---|
119 | Q
|
---|
120 | TERM(IOST) ;Setup terminal display values
|
---|
121 | ;IOST=Terminal type
|
---|
122 | ;Returns ORTERM(5)=REVERSE VIDEO ON^REVERSE VIDEO OFF
|
---|
123 | ; ORTERM(7)=HIGH INTENSITY^LOW INTENSITY^NORMAL INTENSITY
|
---|
124 | S (ORTERM(7),ORTERM(5))=""
|
---|
125 | I $D(IOST),$L(IOST) S X=$O(^%ZIS(2,"B",IOST,0)) I X,$D(^%ZIS(2,X)) S ORTERM(5)=$S($D(^(X,5)):$P(^(5),"^",4,5),1:""),ORTERM(7)=$S($D(^(7)):$P(^(7),"^",1,3),1:"") S:'$L($P(ORTERM(7),"^",3)) $P(ORTERM(7),"^",3)=$P(ORTERM(7),"^",2)
|
---|
126 | F I=1:2:3 I '$L($P(ORTERM(7),"^",I)) S ORTERM(7)="" Q
|
---|
127 | Q
|
---|