- ORPR01 ; slc/dcm/rv - Some day my prints will come ;09/13/06 13:30
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,69,92,260**;Dec 17, 1997;Build 26
- LBL ;Print Labels
- W !,"Print how many labels? 1// "
- R X:DTIME
- S:X="" X=1
- Q:X["^"
- I X'?1N.N!(X>10!(X<1)) W !,"Enter a number between 1 and 10" G LBL
- D P2("L",X)
- Q
- LBL1(SNUM,ORTIMES) ;
- ;SNUM=1 to suppress form feed, passed to PRINT^ORPR00
- ;ORTIMES=# of copies
- N ORX,OR3,ORPK,ORTCNT,ORPKG
- D GET(ORIFN),R1(3,$G(ORTIMES))
- Q
- CHT ;Print Chart copies
- I '$L(ORL) N OR4 S OR4="" D LOC^ORUTL I +$G(OREND) S OREND="" Q
- D P2("C")
- Q
- WRK ;Print Work copies
- I '$L(ORL) N OR4 S OR4="" D LOC^ORUTL I +$G(OREND) S OREND="" Q
- D P2("W")
- Q
- SRV ;Print Service copies
- D P2("S")
- Q
- REQ ;Print Requisitions
- D P2("R")
- Q
- REQ1(SNUM,ORSCREEN) ;
- ;SNUM=1 to suppress form feed, passed to PRINT^ORPR00
- N ORX,OR3,ORPK,ORTCNT,ORPKG
- D GET(ORIFN),R1(4,,$G(ORSCREEN))
- Q
- R1(PIECE,ORTIMES,ORSCREEN) ;
- ;PIECE=4 for requisitions
- ;PIECE=3 for labels
- ;ORTIMES=# of copies
- ;ORSCREEN=Mumps screen to pass to PRINT^ORPR00
- N P,ORFMT,ORIGVIEW,ORDLG
- Q:'$G(PIECE)
- S P=$P(ORX,"^",14),ORDLG=+$P(ORX,"^",5)
- I 'P Q
- S ORIGVIEW=1,ORFMT=$$GET^XPAR("SYS",$S(PIECE=3:"ORPF WARD LABEL FORMAT",PIECE=4:"ORPF WARD REQUISITION FORMAT",1:""),P,"I")
- I PIECE=4,(P=$O(^DIC(9.4,"B","DIETETICS",0))),(ORDLG'=$O(^ORD(101.41,"B","FHW SPECIAL MEAL",0))) S ORFMT=0
- 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
- D CPRINT(ORIFN,$G(ORTIMES),$G(ORSCREEN))
- Q
- CPRINT(ORIFN,ORTIMES,ORSCREEN) ; Printit
- N X
- I +$G(ORFMT)'>0 Q
- I $G(ORTCNT) D
- . I $P($G(^ORD(100.23,ORFMT,0)),"^",4) S ORTCNT=ORTCNT\$P(^(0),"^",4)+1 Q
- . S ORTCNT=ORTCNT\75+1
- S X=($P(^ORD(100.23,ORFMT,0),"^",2)+$P($G(^OR(100,+ORIFN,2,0)),U,4))
- I '$G(ORFIRST1),($Y+X+$S($G(ORTCNT)>0:ORTCNT-1,1:0)>(ORIOSL-3)) D Q:+$G(OREND)
- . I $G(ORFOOT) D FOOT(ORFOOT)
- . I $G(ORHEAD) D HEAD(ORHEAD)
- . I '$G(ORHEAD),'$G(ORFOOT) W @ORIOF
- D PRINT^ORPR00(ORFMT,$S($G(ORTIMES):ORTIMES,1:1),0,$G(SNUM),$G(ORSCREEN))
- Q
- HEAD(FMT) ;
- Q:+$G(OREND)
- S IOF=ORIOF
- D PRINT^ORPR00(FMT,1)
- S IOF="!"
- Q
- Q:+$G(OREND)
- S:IOF?1"!"."!" $P(IOF,"!",$S(ORIOSL>200:200,ORIOSL-$Y>1:ORIOSL-$Y,1:2))=""
- D PRINT^ORPR00(FMT,1)
- I $E(IOST)="C" D
- . N DIR
- . S DIR(0)="FO^1:1",DIR("A")="Press RETURN to continue or '^' to exit"
- . S DIR("?")="Enter '^' to quit present report or '^^' to quit to menu"
- . D ^DIR
- . I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S OREND=1
- S IOF=ORIOF
- Q
- GET(ORIFN) ;Get stuff
- N I,ORTX,X
- S ORX=^OR(100,ORIFN,0),OR3=$G(^(3)),ORPK=$G(^(4)),ORPKG=$P(ORX,"^",14)
- S ORTCNT=0,I=0
- D TEXT^ORQ12(.ORTX,ORIFN) F S I=$O(ORTX(I)) Q:I<1 S X=ORTX(I),ORTCNT=ORTCNT+$L(X)
- Q
- P2(REPORT,ORTIMES) ;Sort 'n print
- ;REPORT=type of report (L=labels, R=requisitions, S=service copies,
- ; C=chart copies, W=work copies)
- ;ORTIMES=# of copies
- Q:'$L($G(REPORT))
- N NQUE
- 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:"")
- Q:'$L(REPORT)
- I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("jive") I 'ORNMBR S VALMBCK="" Q
- Q:'$O(^TMP("OR",$J,"CURRENT","IDX",0))
- N ORAL,ORIFN,ORSEQ,OACTION,ORIDX
- K ^TMP("OREPRINT",$J)
- D FULL^VALM1
- S VALMBCK="R"
- F ORIDX=1:1:($L(ORNMBR,",")-1) S ORSEQ=$P(ORNMBR,",",ORIDX) Q:+$G(OREND) D
- . 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
- I $O(^TMP("OREPRINT",$J,0)) D PRINT^ORPR02(ORVP,"^TMP(""OREPRINT"",$J)",,ORL,REPORT,"1^^^^1^1^1",NQUE,$G(ORTIMES))
- K ^TMP("OREPRINT",$J)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORPR01 3845 printed Feb 18, 2025@23:59:07 Page 2
- 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
- LBL ;Print Labels
- +1 WRITE !,"Print how many labels? 1// "
- +2 READ X:DTIME
- +3 if X=""
- SET X=1
- +4 if X["^"
- QUIT
- +5 IF X'?1N.N!(X>10!(X<1))
- WRITE !,"Enter a number between 1 and 10"
- GOTO LBL
- +6 DO P2("L",X)
- +7 QUIT
- LBL1(SNUM,ORTIMES) ;
- +1 ;SNUM=1 to suppress form feed, passed to PRINT^ORPR00
- +2 ;ORTIMES=# of copies
- +3 NEW ORX,OR3,ORPK,ORTCNT,ORPKG
- +4 DO GET(ORIFN)
- DO R1(3,$GET(ORTIMES))
- +5 QUIT
- CHT ;Print Chart copies
- +1 IF '$LENGTH(ORL)
- NEW OR4
- SET OR4=""
- DO LOC^ORUTL
- IF +$GET(OREND)
- SET OREND=""
- QUIT
- +2 DO P2("C")
- +3 QUIT
- WRK ;Print Work copies
- +1 IF '$LENGTH(ORL)
- NEW OR4
- SET OR4=""
- DO LOC^ORUTL
- IF +$GET(OREND)
- SET OREND=""
- QUIT
- +2 DO P2("W")
- +3 QUIT
- SRV ;Print Service copies
- +1 DO P2("S")
- +2 QUIT
- REQ ;Print Requisitions
- +1 DO P2("R")
- +2 QUIT
- REQ1(SNUM,ORSCREEN) ;
- +1 ;SNUM=1 to suppress form feed, passed to PRINT^ORPR00
- +2 NEW ORX,OR3,ORPK,ORTCNT,ORPKG
- +3 DO GET(ORIFN)
- DO R1(4,,$GET(ORSCREEN))
- +4 QUIT
- R1(PIECE,ORTIMES,ORSCREEN) ;
- +1 ;PIECE=4 for requisitions
- +2 ;PIECE=3 for labels
- +3 ;ORTIMES=# of copies
- +4 ;ORSCREEN=Mumps screen to pass to PRINT^ORPR00
- +5 NEW P,ORFMT,ORIGVIEW,ORDLG
- +6 if '$GET(PIECE)
- QUIT
- +7 SET P=$PIECE(ORX,"^",14)
- SET ORDLG=+$PIECE(ORX,"^",5)
- +8 IF 'P
- QUIT
- +9 SET ORIGVIEW=1
- SET ORFMT=$$GET^XPAR("SYS",$SELECT(PIECE=3:"ORPF WARD LABEL FORMAT",PIECE=4:"ORPF WARD REQUISITION FORMAT",1:""),P,"I")
- +10 IF PIECE=4
- IF (P=$ORDER(^DIC(9.4,"B","DIETETICS",0)))
- IF (ORDLG'=$ORDER(^ORD(101.41,"B","FHW SPECIAL MEAL",0)))
- SET ORFMT=0
- +11 IF ORFMT<1
- WRITE !?2,$CHAR(7),"Cannot print",!?2,$SELECT(PIECE=3:"Labels",PIECE=4:"Requisitions",1:"")_" not set up for orders in the "_$PIECE(^DIC(9.4,P,0),"^")_" package."
- DO READ^ORUTL
- QUIT
- +12 DO CPRINT(ORIFN,$GET(ORTIMES),$GET(ORSCREEN))
- +13 QUIT
- CPRINT(ORIFN,ORTIMES,ORSCREEN) ; Printit
- +1 NEW X
- +2 IF +$GET(ORFMT)'>0
- QUIT
- +3 IF $GET(ORTCNT)
- Begin DoDot:1
- +4 IF $PIECE($GET(^ORD(100.23,ORFMT,0)),"^",4)
- SET ORTCNT=ORTCNT\$PIECE(^(0),"^",4)+1
- QUIT
- +5 SET ORTCNT=ORTCNT\75+1
- End DoDot:1
- +6 SET X=($PIECE(^ORD(100.23,ORFMT,0),"^",2)+$PIECE($GET(^OR(100,+ORIFN,2,0)),U,4))
- +7 IF '$GET(ORFIRST1)
- IF ($Y+X+$SELECT($GET(ORTCNT)>0:ORTCNT-1,1:0)>(ORIOSL-3))
- Begin DoDot:1
- +8 IF $GET(ORFOOT)
- DO FOOT(ORFOOT)
- +9 IF $GET(ORHEAD)
- DO HEAD(ORHEAD)
- +10 IF '$GET(ORHEAD)
- IF '$GET(ORFOOT)
- WRITE @ORIOF
- End DoDot:1
- if +$GET(OREND)
- QUIT
- +11 DO PRINT^ORPR00(ORFMT,$SELECT($GET(ORTIMES):ORTIMES,1:1),0,$GET(SNUM),$GET(ORSCREEN))
- +12 QUIT
- HEAD(FMT) ;
- +1 if +$GET(OREND)
- QUIT
- +2 SET IOF=ORIOF
- +3 DO PRINT^ORPR00(FMT,1)
- +4 SET IOF="!"
- +5 QUIT
- +1 if +$GET(OREND)
- QUIT
- +2 if IOF?1"!"."!"
- SET $PIECE(IOF,"!",$SELECT(ORIOSL>200:200,ORIOSL-$Y>1:ORIOSL-$Y,1:2))=""
- +3 DO PRINT^ORPR00(FMT,1)
- +4 IF $EXTRACT(IOST)="C"
- Begin DoDot:1
- +5 NEW DIR
- +6 SET DIR(0)="FO^1:1"
- SET DIR("A")="Press RETURN to continue or '^' to exit"
- +7 SET DIR("?")="Enter '^' to quit present report or '^^' to quit to menu"
- +8 DO ^DIR
- +9 IF $SELECT($DATA(DIROUT):1,$DATA(DUOUT):1,$DATA(DTOUT):1,1:0)
- SET OREND=1
- End DoDot:1
- +10 SET IOF=ORIOF
- +11 QUIT
- GET(ORIFN) ;Get stuff
- +1 NEW I,ORTX,X
- +2 SET ORX=^OR(100,ORIFN,0)
- SET OR3=$GET(^(3))
- SET ORPK=$GET(^(4))
- SET ORPKG=$PIECE(ORX,"^",14)
- +3 SET ORTCNT=0
- SET I=0
- +4 DO TEXT^ORQ12(.ORTX,ORIFN)
- FOR
- SET I=$ORDER(ORTX(I))
- if I<1
- QUIT
- SET X=ORTX(I)
- SET ORTCNT=ORTCNT+$LENGTH(X)
- +5 QUIT
- P2(REPORT,ORTIMES) ;Sort 'n print
- +1 ;REPORT=type of report (L=labels, R=requisitions, S=service copies,
- +2 ; C=chart copies, W=work copies)
- +3 ;ORTIMES=# of copies
- +4 if '$LENGTH($GET(REPORT))
- QUIT
- +5 NEW NQUE
- +6 SET NQUE=$SELECT(REPORT="S":1,1:"")
- SET REPORT=$SELECT(REPORT="C":"1^^^^",REPORT="L":"^1^^^",REPORT="R":"^^1^^",REPORT="S":"^^^1^",REPORT="W":"^^^^1",1:"")
- +7 if '$LENGTH(REPORT)
- QUIT
- +8 IF '$GET(ORNMBR)
- SET ORNMBR=$$ORDERS^ORCHART("jive")
- IF 'ORNMBR
- SET VALMBCK=""
- QUIT
- +9 if '$ORDER(^TMP("OR",$JOB,"CURRENT","IDX",0))
- QUIT
- +10 NEW ORAL,ORIFN,ORSEQ,OACTION,ORIDX
- +11 KILL ^TMP("OREPRINT",$JOB)
- +12 DO FULL^VALM1
- +13 SET VALMBCK="R"
- +14 FOR ORIDX=1:1:($LENGTH(ORNMBR,",")-1)
- SET ORSEQ=$PIECE(ORNMBR,",",ORIDX)
- if +$GET(OREND)
- QUIT
- Begin DoDot:1
- +15 IF +ORSEQ>0
- IF $DATA(^TMP("OR",$JOB,"CURRENT","IDX",ORSEQ))
- SET ORIFN=+^TMP("OR",$JOB,"CURRENT","IDX",ORSEQ)
- SET OACTION=$PIECE($PIECE(^(ORSEQ),"^"),";",2)
- SET ^TMP("OREPRINT",$JOB,ORIDX)=ORIFN_";"_OACTION
- End DoDot:1
- +16 IF $ORDER(^TMP("OREPRINT",$JOB,0))
- DO PRINT^ORPR02(ORVP,"^TMP(""OREPRINT"",$J)",,ORL,REPORT,"1^^^^1^1^1",NQUE,$GET(ORTIMES))
- +17 KILL ^TMP("OREPRINT",$JOB)
- +18 QUIT