ORPRS03 ; slc/dcm - (@) Formerly known as prints ;12/7/00 13:15
;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,69,92**;Dec 17, 1997
EN ;Print orders
I $$S^%ZTLOAD S (ZTSTOP,OREND,DIROUT)=1 W !!,"TASKED Report stopped by "_$P(^VA(200,DUZ,0),U) Q
N DIRUT,DUOUT,ORBOT,ORSPG,ORLINE,YENKO,SHELBY,ORLST,ORREQ
N ORAGE,ORDOB,ORL,ORNP,ORPNM,ORPV,ORSEX,ORSSN,ORTS,ORWARD
I $G(ORNO),'$O(^TMP("ORR",$J,ORLIST,0)) Q
S YENKO=$$GET^XPAR("ALL","OR PRINT NO ORDERS ON SUM",1,"I"),SHELBY=$O(^TMP("ORR",$J,ORLIST,0))
;YENKO=0 or "", if you don't want to print a page when no orders are present
; 1 to print the page with "NO ORDERS" on it.
I 'YENKO,'SHELBY Q
S $P(ORLINE,"=",IOM+1)="",ORBOT=$S(IOSL<254:IOSL,1:254),Y=+ORVP
D END^ORUDPA
S ORREQ("O")=""
I '$G(ORSPG) S ORSPG=1 D
. 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
. D PTOP^ORPRS05(ORSPG,ORTIT,ORSHORT,ORSSTRT,ORSSTOP)
I '$O(^TMP("ORR",$J,ORLIST,0)) W !!?3,"No orders.",!!! D Q
. F I=$Y:1:ORBOT-5 W !
. I $E(IOST)="C" D Q
.. 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
... I Y'["^" W $C(7),!!,"Enter '^' to stop listing for current patient",!,"and '^^' to stop the entire report, or RETURN to continue"
. D PBOT^ORPRS05(1,ORBOT,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD),ORL(0),ORL(1))
. W @IOF
. I '$G(ORSEND) Q
. W !!!!!?(IOM-44)\2,"***** E N D O F R E P O R T ****",!
. W @IOF
. K ORSEND,ORSPG,ORCONT
S (ORLST,OREND)=0
F S ORLST=$O(^TMP("ORR",$J,ORLIST,ORLST)) Q:'ORLST!$D(DUOUT) D PRT^ORPRS04
K ORSEND,ORSPG,ORCONT
Q
ONE(ORIFN,ORSEQ,LENGTH) ;Single line format
N ORTX,OREL,ORSTS,ORASTS,ORSTRT,ORSTOP,ORFLAG,I,Z,X3
Q:'$D(^OR(100,ORIFN,3))
S ORSEQ=$G(ORSEQ),X3=^(3),ORSTS=$P(X3,"^",3),ORSTRT=$P(^(0),"^",8),ORSTOP=$P(^(0),"^",9),OREL=$S(ORSTS=11:1,1:"")
I $G(OACTION) I $D(^OR(100,ORIFN,8,OACTION,0)) S ORASTS=$P(^(0),"^",15)
D:'$D(ORTERM(5)) TERM^ORPRS01(IOST)
S ORFLAG=$$FLAG(ORIFN,ORTERM(5))
W !
S X=$P(ORTERM(5),"^")
S:ORFLAG X=$$INV^ORU
W ORSEQ_$S($L(ORSEQ)=1:" ",1:"")
S X=$P(ORTERM(5),"^",2)
S:ORFLAG X=$$INV^ORU
S X=$P(ORTERM(7),"^")
S:OREL X=$$INV^ORU
W $S($G(ORASTS)!(ORSTS):" "_$P(^ORD(100.01,$S($G(ORASTS):ORASTS,1:ORSTS),.1),"^"),1:" ")
S:'$G(LENGTH) LENGTH=45
D TEXT^ORQ12(.ORTX,$S($G(OACTION):ORIFN_";"_OACTION,1:ORIFN),LENGTH)
F I=0:0 S I=$O(ORTX(I)) Q:'I W:I>1 ! W ?14,ORTX(I)
S Z=$S($D(ORDAD):$S(ORDAD:2,1:1),1:1)
I Z=2 S ORSTRT=$$FMTE^XLFDT(ORSTRT,"2M"),ORSTOP=$$FMTE^XLFDT(ORSTOP,"2M") W:($X+9+$L(ORSTRT)+$S($L(ORSTOP):$L(ORSTOP)+8,1:0))>(LENGTH+14) !?14 W " Start: "_ORSTRT W:$L(ORSTOP) " Stop: "_ORSTOP
I OREL S X=$P(ORTERM(7),"^",3),X=$$INV^ORU
Q
PRT1(ORIFN,LENGTH) ;For kids sake
;ORIFN=Internal order # of parent order
;LENGTH=column width length
N ORCHLD
S ORCHLD=0
F S ORCHLD=$O(^OR(100,ORIFN,2,ORCHLD)) Q:ORCHLD<1 D:(($Y+5)>ORIOSL) WAIT Q:$G(OREND) D ONE(ORCHLD," ",$G(LENGTH))
Q
FLAG(ORIFN,INVERSE) ;Is order flagged?
S X=""
I $D(^OR(100,ORIFN,6)),$P(^(6),"^"),$L($P($G(INVERSE),"^")),$L($P($G(INVERSE),"^",2)) S X=1
Q X
WAIT ;
I $G(ORFOOT) D Q
. W ?(IOM-15),"(continued...)"
. D FOOT^ORPR01(ORFOOT)
. I '$G(OREND),$G(ORHEAD) D HEAD^ORPR01(ORHEAD) W !,"(...continued)"
Q:$E(IOST)'="C"
D PGBRK^ORUHDR,TIT^ORUHDR:$D(ORTIT)
W:'$D(ORTIT)&($G(ORIOF)]"") @ORIOF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORPRS03 3480 printed Sep 23, 2025@20:09:09 Page 2
ORPRS03 ; slc/dcm - (@) Formerly known as prints ;12/7/00 13:15
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,69,92**;Dec 17, 1997
EN ;Print orders
+1 IF $$S^%ZTLOAD
SET (ZTSTOP,OREND,DIROUT)=1
WRITE !!,"TASKED Report stopped by "_$PIECE(^VA(200,DUZ,0),U)
QUIT
+2 NEW DIRUT,DUOUT,ORBOT,ORSPG,ORLINE,YENKO,SHELBY,ORLST,ORREQ
+3 NEW ORAGE,ORDOB,ORL,ORNP,ORPNM,ORPV,ORSEX,ORSSN,ORTS,ORWARD
+4 IF $GET(ORNO)
IF '$ORDER(^TMP("ORR",$JOB,ORLIST,0))
QUIT
+5 SET YENKO=$$GET^XPAR("ALL","OR PRINT NO ORDERS ON SUM",1,"I")
SET SHELBY=$ORDER(^TMP("ORR",$JOB,ORLIST,0))
+6 ;YENKO=0 or "", if you don't want to print a page when no orders are present
+7 ; 1 to print the page with "NO ORDERS" on it.
+8 IF 'YENKO
IF 'SHELBY
QUIT
+9 SET $PIECE(ORLINE,"=",IOM+1)=""
SET ORBOT=$SELECT(IOSL<254:IOSL,1:254)
SET Y=+ORVP
+10 DO END^ORUDPA
+11 SET ORREQ("O")=""
+12 IF '$GET(ORSPG)
SET ORSPG=1
Begin DoDot:1
+13 IF $EXTRACT(IOST)="C"
DO CTOP^ORPRS05(ORSPG,$GET(ORSEND),$GET(ORSPG("EOP")),ORTIT,ORSHORT,ORL(0),ORL(1),ORWARD,ORPNM,ORSSN,ORDOB,ORAGE,$GET(ORPD))
QUIT
+14 DO PTOP^ORPRS05(ORSPG,ORTIT,ORSHORT,ORSSTRT,ORSSTOP)
End DoDot:1
+15 IF '$ORDER(^TMP("ORR",$JOB,ORLIST,0))
WRITE !!?3,"No orders.",!!!
Begin DoDot:1
+16 FOR I=$Y:1:ORBOT-5
WRITE !
+17 IF $EXTRACT(IOST)="C"
Begin DoDot:2
+18 KILL Y
FOR
if $GET(Y)["^"!($GET(Y)=-1)
QUIT
KILL DIR
SET DIR(0)="FO^1;2"
SET DIR("A")="Press RETURN to continue or '^' to exit"
DO ^DIR
if Y=""
SET Y=-1
KILL DIR
if Y<0
QUIT
Begin DoDot:3
+19 IF Y'["^"
WRITE $CHAR(7),!!,"Enter '^' to stop listing for current patient",!,"and '^^' to stop the entire report, or RETURN to continue"
End DoDot:3
End DoDot:2
QUIT
+20 DO PBOT^ORPRS05(1,ORBOT,ORPNM,ORSSN,ORDOB,ORAGE,$GET(ORPD),ORL(0),ORL(1))
+21 WRITE @IOF
+22 IF '$GET(ORSEND)
QUIT
+23 WRITE !!!!!?(IOM-44)\2,"***** E N D O F R E P O R T ****",!
+24 WRITE @IOF
+25 KILL ORSEND,ORSPG,ORCONT
End DoDot:1
QUIT
+26 SET (ORLST,OREND)=0
+27 FOR
SET ORLST=$ORDER(^TMP("ORR",$JOB,ORLIST,ORLST))
if 'ORLST!$DATA(DUOUT)
QUIT
DO PRT^ORPRS04
+28 KILL ORSEND,ORSPG,ORCONT
+29 QUIT
ONE(ORIFN,ORSEQ,LENGTH) ;Single line format
+1 NEW ORTX,OREL,ORSTS,ORASTS,ORSTRT,ORSTOP,ORFLAG,I,Z,X3
+2 if '$DATA(^OR(100,ORIFN,3))
QUIT
+3 SET ORSEQ=$GET(ORSEQ)
SET X3=^(3)
SET ORSTS=$PIECE(X3,"^",3)
SET ORSTRT=$PIECE(^(0),"^",8)
SET ORSTOP=$PIECE(^(0),"^",9)
SET OREL=$SELECT(ORSTS=11:1,1:"")
+4 IF $GET(OACTION)
IF $DATA(^OR(100,ORIFN,8,OACTION,0))
SET ORASTS=$PIECE(^(0),"^",15)
+5 if '$DATA(ORTERM(5))
DO TERM^ORPRS01(IOST)
+6 SET ORFLAG=$$FLAG(ORIFN,ORTERM(5))
+7 WRITE !
+8 SET X=$PIECE(ORTERM(5),"^")
+9 if ORFLAG
SET X=$$INV^ORU
+10 WRITE ORSEQ_$SELECT($LENGTH(ORSEQ)=1:" ",1:"")
+11 SET X=$PIECE(ORTERM(5),"^",2)
+12 if ORFLAG
SET X=$$INV^ORU
+13 SET X=$PIECE(ORTERM(7),"^")
+14 if OREL
SET X=$$INV^ORU
+15 WRITE $SELECT($GET(ORASTS)!(ORSTS):" "_$PIECE(^ORD(100.01,$SELECT($GET(ORASTS):ORASTS,1:ORSTS),.1),"^"),1:" ")
+16 if '$GET(LENGTH)
SET LENGTH=45
+17 DO TEXT^ORQ12(.ORTX,$SELECT($GET(OACTION):ORIFN_";"_OACTION,1:ORIFN),LENGTH)
+18 FOR I=0:0
SET I=$ORDER(ORTX(I))
if 'I
QUIT
if I>1
WRITE !
WRITE ?14,ORTX(I)
+19 SET Z=$SELECT($DATA(ORDAD):$SELECT(ORDAD:2,1:1),1:1)
+20 IF Z=2
SET ORSTRT=$$FMTE^XLFDT(ORSTRT,"2M")
SET ORSTOP=$$FMTE^XLFDT(ORSTOP,"2M")
if ($X+9+$LENGTH(ORSTRT)+$SELECT($LENGTH(ORSTOP)
WRITE !?14
WRITE " Start: "_ORSTRT
if $LENGTH(ORSTOP)
WRITE " Stop: "_ORSTOP
+21 IF OREL
SET X=$PIECE(ORTERM(7),"^",3)
SET X=$$INV^ORU
+22 QUIT
PRT1(ORIFN,LENGTH) ;For kids sake
+1 ;ORIFN=Internal order # of parent order
+2 ;LENGTH=column width length
+3 NEW ORCHLD
+4 SET ORCHLD=0
+5 FOR
SET ORCHLD=$ORDER(^OR(100,ORIFN,2,ORCHLD))
if ORCHLD<1
QUIT
if (($Y+5)>ORIOSL)
DO WAIT
if $GET(OREND)
QUIT
DO ONE(ORCHLD," ",$GET(LENGTH))
+6 QUIT
FLAG(ORIFN,INVERSE) ;Is order flagged?
+1 SET X=""
+2 IF $DATA(^OR(100,ORIFN,6))
IF $PIECE(^(6),"^")
IF $LENGTH($PIECE($GET(INVERSE),"^"))
IF $LENGTH($PIECE($GET(INVERSE),"^",2))
SET X=1
+3 QUIT X
WAIT ;
+1 IF $GET(ORFOOT)
Begin DoDot:1
+2 WRITE ?(IOM-15),"(continued...)"
+3 DO FOOT^ORPR01(ORFOOT)
+4 IF '$GET(OREND)
IF $GET(ORHEAD)
DO HEAD^ORPR01(ORHEAD)
WRITE !,"(...continued)"
End DoDot:1
QUIT
+5 if $EXTRACT(IOST)'="C"
QUIT
+6 DO PGBRK^ORUHDR
if $DATA(ORTIT)
DO TIT^ORUHDR
+7 if '$DATA(ORTIT)&($GET(ORIOF)]"")
WRITE @ORIOF
+8 QUIT
