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 Sep 23, 2025@20:08:53 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
