Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORPR01

ORPR01.m

Go to the documentation of this file.
  1. ORPR01 ; slc/dcm/rv - Some day my prints will come ;09/13/06 13:30
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,69,92,260**;Dec 17, 1997;Build 26
  1. LBL ;Print Labels
  1. W !,"Print how many labels? 1// "
  1. R X:DTIME
  1. S:X="" X=1
  1. Q:X["^"
  1. I X'?1N.N!(X>10!(X<1)) W !,"Enter a number between 1 and 10" G LBL
  1. D P2("L",X)
  1. Q
  1. LBL1(SNUM,ORTIMES) ;
  1. ;SNUM=1 to suppress form feed, passed to PRINT^ORPR00
  1. ;ORTIMES=# of copies
  1. N ORX,OR3,ORPK,ORTCNT,ORPKG
  1. D GET(ORIFN),R1(3,$G(ORTIMES))
  1. Q
  1. CHT ;Print Chart copies
  1. I '$L(ORL) N OR4 S OR4="" D LOC^ORUTL I +$G(OREND) S OREND="" Q
  1. D P2("C")
  1. Q
  1. WRK ;Print Work copies
  1. I '$L(ORL) N OR4 S OR4="" D LOC^ORUTL I +$G(OREND) S OREND="" Q
  1. D P2("W")
  1. Q
  1. SRV ;Print Service copies
  1. D P2("S")
  1. Q
  1. REQ ;Print Requisitions
  1. D P2("R")
  1. Q
  1. REQ1(SNUM,ORSCREEN) ;
  1. ;SNUM=1 to suppress form feed, passed to PRINT^ORPR00
  1. N ORX,OR3,ORPK,ORTCNT,ORPKG
  1. D GET(ORIFN),R1(4,,$G(ORSCREEN))
  1. Q
  1. R1(PIECE,ORTIMES,ORSCREEN) ;
  1. ;PIECE=4 for requisitions
  1. ;PIECE=3 for labels
  1. ;ORTIMES=# of copies
  1. ;ORSCREEN=Mumps screen to pass to PRINT^ORPR00
  1. N P,ORFMT,ORIGVIEW,ORDLG
  1. Q:'$G(PIECE)
  1. S P=$P(ORX,"^",14),ORDLG=+$P(ORX,"^",5)
  1. I 'P Q
  1. S ORIGVIEW=1,ORFMT=$$GET^XPAR("SYS",$S(PIECE=3:"ORPF WARD LABEL FORMAT",PIECE=4:"ORPF WARD REQUISITION FORMAT",1:""),P,"I")
  1. I PIECE=4,(P=$O(^DIC(9.4,"B","DIETETICS",0))),(ORDLG'=$O(^ORD(101.41,"B","FHW SPECIAL MEAL",0))) S ORFMT=0
  1. 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
  1. D CPRINT(ORIFN,$G(ORTIMES),$G(ORSCREEN))
  1. Q
  1. CPRINT(ORIFN,ORTIMES,ORSCREEN) ; Printit
  1. N X
  1. I +$G(ORFMT)'>0 Q
  1. I $G(ORTCNT) D
  1. . I $P($G(^ORD(100.23,ORFMT,0)),"^",4) S ORTCNT=ORTCNT\$P(^(0),"^",4)+1 Q
  1. . S ORTCNT=ORTCNT\75+1
  1. S X=($P(^ORD(100.23,ORFMT,0),"^",2)+$P($G(^OR(100,+ORIFN,2,0)),U,4))
  1. I '$G(ORFIRST1),($Y+X+$S($G(ORTCNT)>0:ORTCNT-1,1:0)>(ORIOSL-3)) D Q:+$G(OREND)
  1. . I $G(ORFOOT) D FOOT(ORFOOT)
  1. . I $G(ORHEAD) D HEAD(ORHEAD)
  1. . I '$G(ORHEAD),'$G(ORFOOT) W @ORIOF
  1. D PRINT^ORPR00(ORFMT,$S($G(ORTIMES):ORTIMES,1:1),0,$G(SNUM),$G(ORSCREEN))
  1. Q
  1. Q:+$G(OREND)
  1. S IOF=ORIOF
  1. D PRINT^ORPR00(FMT,1)
  1. S IOF="!"
  1. Q
  1. Q:+$G(OREND)
  1. S:IOF?1"!"."!" $P(IOF,"!",$S(ORIOSL>200:200,ORIOSL-$Y>1:ORIOSL-$Y,1:2))=""
  1. D PRINT^ORPR00(FMT,1)
  1. I $E(IOST)="C" D
  1. . N DIR
  1. . S DIR(0)="FO^1:1",DIR("A")="Press RETURN to continue or '^' to exit"
  1. . S DIR("?")="Enter '^' to quit present report or '^^' to quit to menu"
  1. . D ^DIR
  1. . I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S OREND=1
  1. S IOF=ORIOF
  1. Q
  1. GET(ORIFN) ;Get stuff
  1. N I,ORTX,X
  1. S ORX=^OR(100,ORIFN,0),OR3=$G(^(3)),ORPK=$G(^(4)),ORPKG=$P(ORX,"^",14)
  1. S ORTCNT=0,I=0
  1. D TEXT^ORQ12(.ORTX,ORIFN) F S I=$O(ORTX(I)) Q:I<1 S X=ORTX(I),ORTCNT=ORTCNT+$L(X)
  1. Q
  1. P2(REPORT,ORTIMES) ;Sort 'n print
  1. ;REPORT=type of report (L=labels, R=requisitions, S=service copies,
  1. ; C=chart copies, W=work copies)
  1. ;ORTIMES=# of copies
  1. Q:'$L($G(REPORT))
  1. N NQUE
  1. 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:"")
  1. Q:'$L(REPORT)
  1. I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("jive") I 'ORNMBR S VALMBCK="" Q
  1. Q:'$O(^TMP("OR",$J,"CURRENT","IDX",0))
  1. N ORAL,ORIFN,ORSEQ,OACTION,ORIDX
  1. K ^TMP("OREPRINT",$J)
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. F ORIDX=1:1:($L(ORNMBR,",")-1) S ORSEQ=$P(ORNMBR,",",ORIDX) Q:+$G(OREND) D
  1. . 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
  1. I $O(^TMP("OREPRINT",$J,0)) D PRINT^ORPR02(ORVP,"^TMP(""OREPRINT"",$J)",,ORL,REPORT,"1^^^^1^1^1",NQUE,$G(ORTIMES))
  1. K ^TMP("OREPRINT",$J)
  1. Q