source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPR01.m@ 1686

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

initial load of WorldVistAEHR

File size: 3.7 KB
RevLine 
[613]1ORPR01 ; slc/dcm/rv - Some day my prints will come ;09/13/06 13:30
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,69,92,260**;Dec 17, 1997;Build 26
3LBL ;Print Labels
4 W !,"Print how many labels? 1// "
5 R X:DTIME
6 S:X="" X=1
7 Q:X["^"
8 I X'?1N.N!(X>10!(X<1)) W !,"Enter a number between 1 and 10" G LBL
9 D P2("L",X)
10 Q
11LBL1(SNUM,ORTIMES) ;
12 ;SNUM=1 to suppress form feed, passed to PRINT^ORPR00
13 ;ORTIMES=# of copies
14 N ORX,OR3,ORPK,ORTCNT,ORPKG
15 D GET(ORIFN),R1(3,$G(ORTIMES))
16 Q
17CHT ;Print Chart copies
18 I '$L(ORL) N OR4 S OR4="" D LOC^ORUTL I +$G(OREND) S OREND="" Q
19 D P2("C")
20 Q
21WRK ;Print Work copies
22 I '$L(ORL) N OR4 S OR4="" D LOC^ORUTL I +$G(OREND) S OREND="" Q
23 D P2("W")
24 Q
25SRV ;Print Service copies
26 D P2("S")
27 Q
28REQ ;Print Requisitions
29 D P2("R")
30 Q
31REQ1(SNUM,ORSCREEN) ;
32 ;SNUM=1 to suppress form feed, passed to PRINT^ORPR00
33 N ORX,OR3,ORPK,ORTCNT,ORPKG
34 D GET(ORIFN),R1(4,,$G(ORSCREEN))
35 Q
36R1(PIECE,ORTIMES,ORSCREEN) ;
37 ;PIECE=4 for requisitions
38 ;PIECE=3 for labels
39 ;ORTIMES=# of copies
40 ;ORSCREEN=Mumps screen to pass to PRINT^ORPR00
41 N P,ORFMT,ORIGVIEW,ORDLG
42 Q:'$G(PIECE)
43 S P=$P(ORX,"^",14),ORDLG=+$P(ORX,"^",5)
44 I 'P Q
45 S ORIGVIEW=1,ORFMT=$$GET^XPAR("SYS",$S(PIECE=3:"ORPF WARD LABEL FORMAT",PIECE=4:"ORPF WARD REQUISITION FORMAT",1:""),P,"I")
46 I PIECE=4,(P=$O(^DIC(9.4,"B","DIETETICS",0))),(ORDLG'=$O(^ORD(101.41,"B","FHW SPECIAL MEAL",0))) S ORFMT=0
47 I ORFMT<1 W !?2,$C(7),"Cannot print",!?2,$S(PIECE=3:"Labels",PIECE=4:"Requisitions",1:"")_" not set up for orders in the "_$P(^DIC(9.4,P,0),"^")_" package." D READ^ORUTL Q
48 D CPRINT(ORIFN,$G(ORTIMES),$G(ORSCREEN))
49 Q
50CPRINT(ORIFN,ORTIMES,ORSCREEN) ; Printit
51 N X
52 I +$G(ORFMT)'>0 Q
53 I $G(ORTCNT) D
54 . I $P($G(^ORD(100.23,ORFMT,0)),"^",4) S ORTCNT=ORTCNT\$P(^(0),"^",4)+1 Q
55 . S ORTCNT=ORTCNT\75+1
56 S X=($P(^ORD(100.23,ORFMT,0),"^",2)+$P($G(^OR(100,+ORIFN,2,0)),U,4))
57 I '$G(ORFIRST1),($Y+X+$S($G(ORTCNT)>0:ORTCNT-1,1:0)>(ORIOSL-3)) D Q:+$G(OREND)
58 . I $G(ORFOOT) D FOOT(ORFOOT)
59 . I $G(ORHEAD) D HEAD(ORHEAD)
60 . I '$G(ORHEAD),'$G(ORFOOT) W @ORIOF
61 D PRINT^ORPR00(ORFMT,$S($G(ORTIMES):ORTIMES,1:1),0,$G(SNUM),$G(ORSCREEN))
62 Q
63HEAD(FMT) ;
64 Q:+$G(OREND)
65 S IOF=ORIOF
66 D PRINT^ORPR00(FMT,1)
67 S IOF="!"
68 Q
69FOOT(FMT) ; Print Footer
70 Q:+$G(OREND)
71 S:IOF?1"!"."!" $P(IOF,"!",$S(ORIOSL>200:200,ORIOSL-$Y>1:ORIOSL-$Y,1:2))=""
72 D PRINT^ORPR00(FMT,1)
73 I $E(IOST)="C" D
74 . N DIR
75 . S DIR(0)="FO^1:1",DIR("A")="Press RETURN to continue or '^' to exit"
76 . S DIR("?")="Enter '^' to quit present report or '^^' to quit to menu"
77 . D ^DIR
78 . I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S OREND=1
79 S IOF=ORIOF
80 Q
81GET(ORIFN) ;Get stuff
82 N I,ORTX,X
83 S ORX=^OR(100,ORIFN,0),OR3=$G(^(3)),ORPK=$G(^(4)),ORPKG=$P(ORX,"^",14)
84 S ORTCNT=0,I=0
85 D TEXT^ORQ12(.ORTX,ORIFN) F S I=$O(ORTX(I)) Q:I<1 S X=ORTX(I),ORTCNT=ORTCNT+$L(X)
86 Q
87P2(REPORT,ORTIMES) ;Sort 'n print
88 ;REPORT=type of report (L=labels, R=requisitions, S=service copies,
89 ; C=chart copies, W=work copies)
90 ;ORTIMES=# of copies
91 Q:'$L($G(REPORT))
92 N NQUE
93 S NQUE=$S(REPORT="S":1,1:""),REPORT=$S(REPORT="C":"1^^^^",REPORT="L":"^1^^^",REPORT="R":"^^1^^",REPORT="S":"^^^1^",REPORT="W":"^^^^1",1:"")
94 Q:'$L(REPORT)
95 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("jive") I 'ORNMBR S VALMBCK="" Q
96 Q:'$O(^TMP("OR",$J,"CURRENT","IDX",0))
97 N ORAL,ORIFN,ORSEQ,OACTION,ORIDX
98 K ^TMP("OREPRINT",$J)
99 D FULL^VALM1
100 S VALMBCK="R"
101 F ORIDX=1:1:($L(ORNMBR,",")-1) S ORSEQ=$P(ORNMBR,",",ORIDX) Q:+$G(OREND) D
102 . I +ORSEQ>0,$D(^TMP("OR",$J,"CURRENT","IDX",ORSEQ)) S ORIFN=+^TMP("OR",$J,"CURRENT","IDX",ORSEQ),OACTION=$P($P(^(ORSEQ),"^"),";",2),^TMP("OREPRINT",$J,ORIDX)=ORIFN_";"_OACTION
103 I $O(^TMP("OREPRINT",$J,0)) D PRINT^ORPR02(ORVP,"^TMP(""OREPRINT"",$J)",,ORL,REPORT,"1^^^^1^1^1",NQUE,$G(ORTIMES))
104 K ^TMP("OREPRINT",$J)
105 Q
Note: See TracBrowser for help on using the repository browser.