source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPRS11.m

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

initial load of WorldVistAEHR

File size: 5.1 KB
Line 
1ORPRS11 ; slc/dcm - Alternate lifestyle for Summary Reports ;12/7/00 13:13
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,92**;Dec 17, 1997
3 ;Sorts by display group, using the Summary Order display group for
4 ;the order. Loops on the AW x-ref, sorted by forward Start date.
5 ;Not currently in use!!!
6 ;The lookup on the AW x-ref needs to be changed to call ^ORQ1 with
7 ;the display group SUMMARY ORDER, then another sort needs to be done
8 ;on the returned array to sort on the Summary Order sequence and
9 ;the start time.
10IN ;START
11 Q ;Not ready for primetime.
12 S (OREND,ORANSI,ORSPG)=0
13 D:$D(ORSCPAT)'>9 P^ORPRS01
14 G:OREND!'$D(ORSCPAT) END
15 D PRES^ORPRS09
16 G:OREND END
17 D SERV^ORPRS09
18 G:OREND END
19 D RANGE^ORPRS01()
20 G:OREND END
21 S ORTIT=$P(ORPRES,";",2)_" for "_ORGRP("NAM")_" SERVICES"
22CONT ;
23 D QUE^ORUTL1("EN1^ORPRS11","Alternate Order Summary Report"),END
24 Q
25EN1 ;Entry point for Batch Processing
26 U IO
27 I +ORPRES=2 S %DT="",X="T-1" D ^%DT S ORYD=Y
28 I +ORPRES=6 S %DT="",X="T+1" D ^%DT S ORTMW=Y_".9999"
29 I $E(IOST)'="C",$L($G(ORSWDN)) S ORSLTR=$E(ORSWDN,1,(IOM\15)) D ^ORSLTR
30 S (NEXTP,OREND)=0
31 F S NEXTP=$O(ORSCPAT(NEXTP)) Q:NEXTP=""!(OREND=1) S ORVP=+ORSCPAT(NEXTP)_";DPT(" D EN Q:OREND D PGBRK^ORUHDR:$E(IOST)="C" Q:OREND
32END ; Clean up variables
33 K ^TMP("ORR",$J),ORSLTR,ORANSI,ORATTEND,ORDAD,ORDOG,ORDOGY,ORFLAG,ORI,ORSCPAT,ORSUM,ORTERM,ORYD,ORTMW,X2,X3,XQORSPEW,ORURMBD,ORPRTD,ORSHORT
34 K I,II,J,K,NEXTP,NB,ND,NS,ORES,ODATE,ORAGE,ORDCFC,ORMD,ORDG,ORDIC,ORDOB,OREND,ORFT,ORGRP,ORH,ORH2,ORHI,ORIO,ORL,ORLST,ORODT,ORNP,ORPD,ORPFG,ORPNM,ORPRES,ORUSER,ORPV,ORREQ,ORSPG
35 K ORSEL,ORSEQ,ORSEX,ORSP,ORSPAT,ORSPL,ORSSN,ORSSTOP,ORSSTRT,ORSTRT,ORSTOP,ORSTS,ORASTS,ORTIT,ORTM,ORTS,ORTX,ORVP,ORWARD,ORX,X,X1,Y,%,%DT,%IS,ORSWD,ORSWDN,ORRPG,ORIFN
36 I $D(ZTSK) D KILL^%ZTLOAD K ZTSK
37 Q
38EN ;
39 I '$D(^OR(100,"AW",ORVP)) W !!,"NO ORDERS FOUND",!! Q
40 S Y=+ORVP,ORSPG("EOP")=0
41 D END^ORUDPA
42 I $E(IOST)="C" D CTOP^ORPRS05(ORSPG,$G(ORSEND),$G(ORSPG("EOP")),ORTIT,ORSHORT,ORL(0),ORL(1),ORWARD,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD))
43 I $E(IOST)'="C" D Q:OREND
44 . D PGCHK Q:OREND
45 . D PTOP^ORPRS05(ORSPG,ORTIT,ORSHORT,ORSSTRT,ORSSTOP),PTHDR
46 I ORSPG("EOP")'=1 D PGCHK Q:OREND
47 K ORPRTD
48 S ORSUM=$O(^ORD(100.98,"B","SUMMARY ORDER",0))
49 Q:'ORSUM
50 S ORDOG=0
51 F S ORDOG=$O(^ORD(100.98,ORSUM,1,ORDOG)) Q:'ORDOG S ORDOGY=+^(ORDOG,0) I $D(^OR(100,"AW",ORVP,ORDOGY)) D Q:OREND
52 . D PGCHK,PGCHK1
53 . W !!,$P(^ORD(100.98,ORDOGY,0),"^")
54 . S X="",$P(X,"-",$L($P(^(0),"^"))+1)=""
55 . W !,X
56 . S ORTM=$S($D(ORSSTRT):+ORSSTRT,1:0)
57 . F S ORTM=$O(^OR(100,"AW",ORVP,ORDOGY,ORTM)) Q:'ORTM!(ORTM>+ORSSTOP) D Q:OREND
58 .. S ORIFN=0
59 .. F S ORIFN=$O(^OR(100,"AW",ORVP,ORDOGY,ORTM,ORIFN)) Q:'ORIFN D Q:OREND
60 ... D PGCHK,PGCHK1
61 ... Q:OREND
62 ... D PRT
63 ... S ORPRTD=1
64 I $G(ORPRTD),$E(IOST)'="C" S X="",$P(X,"-",IOM)="" W !,X D PBOT^ORPRS05(1,ORBOT,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD),ORL(0),ORL(1))
65 Q
66PRT ;Print order line
67 K ORTX
68 Q:'$D(^OR(100,ORIFN,0)) S X=^(0),X3=$S($D(^(3)):^(3),1:""),ORDAD=$O(^(2,0))
69 S ORREQ=$P(X,"^",4),ORODT=$P(X,"^",7),ORSTOP=$P(X,"^",9),ORUSER=$P(X,"^",6),ORSTS=$P(X3,"^",3),ORSTRT=$P(X0,"^",8),ORMD=$P(X3,"^",10)
70 I $G(OACTION) I $D(^OR(100,ORIFN,8,OACTION,0)) S X=^(0),ORODT=+X,ORREQ=$P(X,"^",3),ORMD=$P(X,"^",4),ORUSER=$P(X,"^",13),ORASTS=$P(X,"^",15),OREL=$S(ORASTS=11:1,1:"")
71 S ORREQ=$S(ORREQ:$S($D(^VA(200,ORREQ,0)):$P(^(0),"^"),1:"UNKNOWN"),1:"UNKNOWN")
72 D TEXT^ORQ12(.ORTX,$S($G(OACTION):ORIFN_";"_OACTION,1:ORIFN),40)
73 S X=$P(ORREQ,",",2),ORREQ=$E($P(ORREQ,","),1,8)_","_$S($E(X)=" ":$E(X,$F(X,"")),1:$E(X))
74STS ;
75 S ORSTS=$S($G(ORASTS)!(ORSTS):" "_$P(^ORD(100.01,$S($G(ORASTS):ORASTS,1:ORSTS),.1),"^"),1:" ")
76 D:'$D(ORTERM(5)) TERM^ORPRS01(IOST)
77 S ORFLAG=$$FLAG^ORPRS03(ORIFN,ORTERM(5))
78 W !
79 S X=$P(ORTERM(7),"^")
80 S:OREL X=$$INV^ORU
81 W:$L(ORODT) ?2,$E(ORODT,4,5),"/",$E(ORODT,6,7)
82 W ?9,ORSTS
83 W ?11,$S(ORDAD:"+",1:" ")
84 W:$O(ORTX(0)) ORTX($O(ORTX(0)))
85 W ?54,ORREQ
86 W:$L(ORSTRT) ?64,$E(ORSTRT,4,5),"/",$E(ORSTRT,6,7)
87 W:$L(ORSTOP) ?74,$E(ORSTOP,4,5),"/",$E(ORSTOP,6,7)
88 W !?2,$$MTIM^ORPRS04(ORODT),?12
89 S X=$O(ORTX(0))
90 I X W:$O(ORTX(X)) ORTX($O(ORTX(X)))
91 W ?67,$$MTIM^ORPRS04(ORSTRT),?74,$$MTIM^ORPRS04(ORSTOP)
92 S X=0 F I=1:1 S X=$O(ORTX(X)) Q:X'>0 I I>2 W !?12,ORTX(X)
93 I $D(^OR(100,ORIFN,5,0)) S J=0 F I=0:0 S J=$O(^OR(100,ORIFN,5,J)) Q:J<1 W !?12,^(J,0)
94 I ORDAD D
95 . S ORSEQ=0 D PRT1 K ORSEQ
96 I OREL W !?66,"*UNRELEASED*" S X=$P(ORTERM(7),"^",3),X=$$INV^ORU
97 K OREL Q
98PGCHK ;
99 S ORSPG("EOP")=0
100 Q:(IOSL-$Y)'<8
101 S ORSPG("EOP")=1
102 I ORSPG("EOP"),$E(IOST)="C" D WAIT
103 Q
104PGCHK1 ;
105 I $E(IOST)'="C",(IOSL-$Y)<8 S X="",$P(X,"-",IOM)="" W !,X D PBOT^ORPRS05(1,ORBOT,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD),ORL(0),ORL(1)),PTOP^ORPRS05(ORSPG,ORTIT,ORSHORT,ORSSTRT,ORSSTOP),PTHDR W !
106 Q
107WAIT ;
108 W !!,"Press RETURN to continue, '^' to escape"
109 R X:DTIME
110 S:'$T X="^"
111 S:X["^" OREND=1
112 D:'OREND CTOP^ORPRS05(ORSPG,$G(ORSEND),$G(ORSPG("EOP")),ORTIT,ORSHORT,ORL(0),ORL(1),ORWARD,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD))
113 W:OREND @IOF
114 Q
115PRT1 ;
116 S OROSEQ=$G(ORSEQ),OROIFN=ORIFN,ORCHLD=0
117 F I=0:0 S ORCHLD=$O(^OR(100,OROIFN,2,ORCHLD)) Q:ORCHLD<1 D PGCHK,PGCHK1 Q:OREND S ORIFN=ORCHLD,ORSEQ=" " D ONE^ORPRS03(ORIFN," ")
118 S ORIFN=OROIFN,ORSEQ=OROSEQ
119 K OROIFN,OROSEQ,ORCHLD
120 Q
121PTHDR ;
122 W !,ORPNM," "
123 S X=$P(ORWARD,"^",2)_" "_ORL(1)
124 W ?(80-$L(X)/2),X,?68,$G(ORSSN)
125 Q
Note: See TracBrowser for help on using the repository browser.