source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPRS04.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: 6.8 KB
Line 
1ORPRS04 ; slc/dcm - Print Order summaries (SHRIVELED) ;11/28/00 15:39
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,69,92,121**;Dec 17, 1997
3EN ;Print orders
4 I $$S^%ZTLOAD S (ZTSTOP,DIROUT,OREND)=1 W !!,"TASKED Report stopped by WHILE RUNNING." Q
5 N DIRUT,DUOUT,ORCONT,ORLINE,ORLSTO,ORDAD,ORLST,OREND,YENKO,SHELBY
6 K ORSPG
7 S YENKO=$$GET^XPAR("ALL","OR PRINT NO ORDERS ON SUM",1,"I"),SHELBY=$O(^TMP("ORR",$J,ORLIST,0))
8 ;YENKO=0 or "", if you don't want to print a page when no orders are present
9 ; 1 to print the page with "NO ORDERS" on it.
10 I 'YENKO,'SHELBY Q
11 S $P(ORLINE,"-",IOM+1)="",ORBOT=$S(IOSL<254:IOSL,1:254),Y=+ORVP,ORDAD="",OREND=0
12 D END^ORUDPA
13 S ORREQ("O")=""
14 I $Y+11>IOSL,$E(IOST)="P" W @IOF
15 I '$G(ORSPG) S ORSPG=1 D
16 . 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)) Q
17 . D PTOP^ORPRS05(ORSPG,ORTIT,ORSHORT,ORSSTRT,ORSSTOP)
18 D PTHDR
19 I '$O(^TMP("ORR",$J,ORLIST,0)) W !!?3,"No orders.",!,ORLINE D Q
20 . S ORSPG("EOP")=1
21 . I $E(IOST)="C" D Q
22 .. K Y F Q:$G(Y)["^"!($G(Y)=-1) K DIR S DIR(0)="FO^1;2",DIR("A")="Press RETURN to continue or '^' to exit" D ^DIR S:Y="" Y=-1 K DIR Q:Y<0 D
23 ... I Y'["^" W $C(7),!!,"Enter '^' to stop listing for current patient"
24 . D PBOT^ORPRS05(1,ORBOT,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD),ORL(0),ORL(1),$G(ORSHORT))
25 . I '$G(ORSEND) Q
26 . W !!!!!?(IOM-44)\2,"***** E N D O F R E P O R T ****",!
27 . K ORSEND,ORSPG,ORCONT
28 S ORCONT=1,ORLSTO=0,ORLST=0
29 F S ORLST=$O(^TMP("ORR",$J,ORLIST,ORLST)) Q:'ORLST!$D(DUOUT) D PRT Q:OREND
30 Q:OREND!$D(DUOUT)!$D(DTOUT)!$G(ORSPG("LAST"))
31 S ORLSTO=1
32 D PGCHK()
33 Q
34PRT ;Print order line
35 N ORXPND,OACTION,ORIFN,ORASTS,ORSTS,ORTX,ORODT,ORSTOP,ORUSER,ORSTRT,ORMD,OREL,ORFLAG,ORNAT
36 S ORIFN=+^TMP("ORR",$J,ORLIST,ORLST),OACTION=$P(^(ORLST),";",2)
37 I ORSHORT,$G(ORSPG("EOP")) S ORREQ("O")="" D PTOP^ORPRS05(ORSPG,ORTIT,ORSHORT,ORSSTRT,ORSSTOP),PTHDR S ORSPG("EOP")=0
38 I 'ORSHORT,$G(ORSPG("EOP")) D:$E(IOST)="C" CTOP^ORPRS05(ORSPG,$G(ORSEND),$G(ORSPG("EOP")),ORTIT,ORSHORT,ORL(0),ORL(1),ORWARD,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD)) S ORSPG("EOP")=ORSPG
39 I $G(ORSPG(0))'=ORSPG S (ORREQ("O"),ORREQ("TIT",0))="",ORSPG(0)=ORSPG
40 Q:'$D(^OR(100,ORIFN,0)) S X=^(0),X3=$S($D(^(3)):^(3),1:""),ORDAD=$O(^(2,0))
41 S ORREQ=$P(X,"^",4),ORODT=$P(X,"^",7),ORSTOP=$P(X,"^",9),ORUSER=$P(X,"^",6),ORSTS=$P(X3,"^",3),ORSTRT=$P(X,"^",8),ORMD=$P(X3,"^",13),OREL=$S(ORSTS=11:1,1:"")
42 I $D(^OR(100,ORIFN,8,OACTION,0)) S X=^(0),ORODT=+X,ORREQ=$P(X,"^",3),ORMD=$P(X,"^",4),ORNAT=$P(X,"^",12),ORUSER=$P(X,"^",13),ORASTS=$P(X,"^",15),OREL=$S(ORASTS=11:1,1:"")
43 S ORREQ=$S(ORREQ:$S($D(^VA(200,ORREQ,0)):$P(^(0),"^"),1:"UNKNOWN"),1:"UNKNOWN"),ORREQ("TIT")=" " I ORREQ'="UNKNOWN" S X=$P(^(0),U,9),ORREQ("TIT")=$P($G(^DIC(3.1,+X,0)),U) I ORREQ("TIT")']"" S ORREQ("TIT")=" "
44 D TEXT^ORQ12(.ORTX,$S($G(OACTION):ORIFN_";"_OACTION,1:ORIFN),40)
45 S X=$P(ORREQ,",",2),ORREQ=$E($P(ORREQ,","),1,8)_","_$S($E(X)=" ":$E(X,$F(X,"")),1:$E(X))
46 S:ORREQ'=ORREQ("O") ORREQ("O")=ORREQ,ORREQ("F")=1,ORREQ("TIT",0)=""
47 S:'ORREQ("F")&(ORREQ=ORREQ("O")) ORREQ=" """
48 S ORREQ("F")=0
49 S:ORREQ("TIT")'=$G(ORREQ("TIT",0)) ORREQ("TIT",0)=ORREQ("TIT"),ORREQ("F")=1
50 S:'ORREQ("F")&(ORREQ("TIT")=ORREQ("TIT",0)) ORREQ("TIT")=" """
51 S ORREQ("F")=0
52STS ;
53 S ORSTS=$S($G(ORASTS)!(ORSTS):" "_$P(^ORD(100.01,$S($G(ORASTS):ORASTS,1:ORSTS),.1),"^"),1:" ")
54 D:'$D(ORTERM(5)) TERM^ORPRS01(IOST)
55 S ORFLAG=$$FLAG^ORPRS03(ORIFN,ORTERM(5))
56 S ORXPND=$O(ORTX(""),-1)
57 D PGCHK(ORXPND+1)
58 Q:OREND
59 W !!
60 S X=$P(ORTERM(7),"^")
61 S:OREL X=$$INV^ORU
62 W:$L(ORODT) $E(ORODT,4,5)_"/"_$E(ORODT,6,7)_"/"_$E(ORODT,2,3)
63 W ?8,ORSTS,?12,$S(ORDAD:"+",1:" ")
64 W:$O(ORTX(0)) ORTX($O(ORTX(0)))
65 W ?54,ORREQ W:$L(ORSTRT) ?65,$E(ORSTRT,4,5)_"/"_$E(ORSTRT,6,7)_"/"_$E(ORSTRT,2,3)
66 W:$L(ORSTOP) ?75,$E(ORSTOP,4,5)_"/"_$E(ORSTOP,6,7)
67 W !?3,$$MTIM(ORODT),?13
68 S X=$O(ORTX(0))
69 I X W:$O(ORTX(X)) ORTX($O(ORTX(X)))
70 W ?54,$E(ORREQ("TIT"),1,10),?68,$$MTIM(ORSTRT),?75,$$MTIM(ORSTOP)
71 S X=0 F I=1:1 S X=$O(ORTX(X)) Q:'X I I>2 W !?13,ORTX(X) D:($Y>(IOSL-5)) PGCHK(ORXPND-I) Q:OREND
72 Q:OREND
73 W !
74 I $$GET^XPAR("ALL","ORPF INITIALS ON SUMMARY",1,"I"),ORUSER W ?1,$P($G(^VA(200,ORUSER,0)),"^",2)
75 I $D(^OR(100,ORIFN,8,OACTION,0)) S X=^(0) D
76 . N NATURE,SIGSTS,NURSE,REVIEW
77 . S SIGSTS=$P(X,"^",4),NATURE=$P(X,"^",12),NURSE=$P(X,"^",8),REVIEW=$P(X,"^",18)
78 . I $L(SIGSTS) S SIGSTS=$$SET(100.008,4,SIGSTS)
79 . I NATURE S NATURE=$P(^ORD(100.02,NATURE,0),"^")
80 . I NURSE S NURSE=$P($G(^VA(200,NURSE,0)),"^",2)
81 . I REVIEW S REVIEW=$P($G(^VA(200,REVIEW,0)),"^",2)
82 . W:$L(NURSE) ?9,"Nrs:"_NURSE
83 . W:$L(REVIEW) ?19,"Chrt:"_REVIEW
84 . W:$L(NATURE) ?30,"Typ:"_$E(NATURE,1,18)
85 . W:$L(SIGSTS) ?54,"Sgn:"_$E(SIGSTS,1,25)
86 I $D(^OR(100,ORIFN,5,0)) S J=0 F S J=$O(^OR(100,ORIFN,5,J)) Q:'J W !?13,^(J,0)
87 I ORDAD D Q:OREND
88 . N I,ORSEQ
89 . S I=0,ORSEQ=0,ORTIT(0)=ORTIT
90 . D KIDS(ORIFN)
91 . S ORTIT=ORTIT(0)
92 I OREL W !?66,"*UNRELEASED*" S X=$P(ORTERM(7),U,3),X=$$INV^ORU
93 S ORSPG("LAST")='$O(^TMP("ORR",$J,ORLIST,ORLST)),ORCONT='ORSPG("LAST")
94 D PGCHK()
95 Q
96PGCHK(CNT) ;
97 N DIR,X,I
98 S:'$D(CNT) CNT=0
99 I $G(ORSPG("LAST")) W !!,?32,"* END OF ORDERS *" W:'$G(ORSHORT) !,ORLINE D
100 . I $E(IOST)="P" D PBOT^ORPRS05(ORSPG,IOSL,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD),ORL(0),ORL(1),$G(ORSHORT)) I '$G(ORSHORT)!($Y+15>IOSL) W @IOF
101 . I $E(IOST)="C" W ! S DIR(0)="FO^1;2",DIR("A")="Press RETURN to continue, '^' to exit" D ^DIR I $D(DUOUT) S OREND=1 Q
102 I $G(ORSEND),$G(ORLSTO) D K ORSEND,ORCONT Q
103 . W !?(IOM-44)\2,"***** E N D O F R E P O R T ****",!
104 . I $E(IOST)="C" W ! S DIR(0)="FO^1;2",DIR("A")="Press RETURN to continue, '^' to exit" D ^DIR I $D(DUOUT) S OREND=1 Q
105 I $G(ORSPG("LAST")) Q
106 I $E(IOST)="C" D Q
107 . I ((IOSL-$Y)>(4+CNT))!(CNT+4>(IOSL-3)) Q
108 . S ORSPG=$G(ORSPG)+1
109 . W !
110 . S DIR(0)="FO^1;2",DIR("A")="Press RETURN to continue or '^' to exit"
111 . D ^DIR
112 . I $D(DUOUT) K ORSEND,ORCONT S OREND=1 Q
113 . D CTOP^ORPRS05(ORSPG,$G(ORSEND),$G(ORSPG("EOP")),ORTIT,ORSHORT,ORL(0),ORL(1),ORWARD,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD))
114 . S ORSPG=0
115 . I $G(ORCONT) D PTHDR
116 I ((IOSL-$Y)>(6+CNT))!(CNT+6>(IOSL-5)) Q
117 D PBOT^ORPRS05(ORSPG,IOSL,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD),ORL(0),ORL(1),$G(ORSHORT))
118 S ORSPG=ORSPG+1
119 W @IOF
120 D PTOP^ORPRS05(ORSPG,ORTIT,ORSHORT,ORSSTRT,ORSSTOP)
121 I $G(ORCONT) D PTHDR
122 Q
123PTHDR ;
124 W !,ORPNM_" "_$G(ORSSN)_" "_$S($G(ORCONT):"(cont.)",1:"")_" "
125 S X=$P(ORWARD,"^",2)_" "_ORL(1)
126 W ?(80-$L(X))\2,X
127 Q
128KIDS(ORIFN,LENGTH) ;Print child orders
129 N ORCHLD,OROIFN
130 S OROIFN=ORIFN,ORCHLD=0
131 F I=0:0 S ORCHLD=$O(^OR(100,OROIFN,2,ORCHLD)) Q:ORCHLD<1 D PGCHK() Q:OREND S ORIFN=ORCHLD D ONE^ORPRS03(ORCHLD," ",$G(LENGTH))
132 Q
133MTIM(X) ;Format time from Fileman date in X
134 I '$G(X) Q ""
135 S X=$P(X,".",2)
136 Q:'$L(X) ""
137 S X=$E(X,1,2)_$E("00",0,2-$L($E(X,1,2)))_":"_$E(X,3,4)_$E("00",0,2-$L($E(X,3,4)))
138 Q X
139SET(FILE,FIELD,RESULT) ;Interpret set of codes
140 S X=$P(^DD(FILE,FIELD,0),"^",3),X=$P($P(";"_X,";"_RESULT_":",2),";")
141 Q X
Note: See TracBrowser for help on using the repository browser.