- 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 Feb 18, 2025@23:59:23 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
