source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPRS04.m@ 1397

ORPRS04 ; slc/dcm - Print Order summaries (SHRIVELED) ;11/28/00  15:39
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,69,92,121**;Dec 17, 1997
EN ;Print orders
 I $$S^%ZTLOAD S (ZTSTOP,DIROUT,OREND)=1 W !!,"TASKED Report stopped by WHILE RUNNING." Q
 N DIRUT,DUOUT,ORCONT,ORLINE,ORLSTO,ORDAD,ORLST,OREND,YENKO,SHELBY
 K ORSPG
 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,ORDAD="",OREND=0
 D END^ORUDPA
 S ORREQ("O")=""
 I $Y+11>IOSL,$E(IOST)="P" W @IOF
 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)
 D PTHDR
 I '$O(^TMP("ORR",$J,ORLIST,0)) W !!?3,"No orders.",!,ORLINE D  Q
 . S ORSPG("EOP")=1
 . 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"
 . D PBOT^ORPRS05(1,ORBOT,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD),ORL(0),ORL(1),$G(ORSHORT))
 . I '$G(ORSEND) Q
 . W !!!!!?(IOM-44)\2,"*****    E N D    O F    R E P O R T    ****",!
 . K ORSEND,ORSPG,ORCONT
 S ORCONT=1,ORLSTO=0,ORLST=0
 F  S ORLST=$O(^TMP("ORR",$J,ORLIST,ORLST)) Q:'ORLST!$D(DUOUT)  D PRT Q:OREND
 Q:OREND!$D(DUOUT)!$D(DTOUT)!$G(ORSPG("LAST"))
 S ORLSTO=1
 D PGCHK()
 Q
PRT ;Print order line
 N ORXPND,OACTION,ORIFN,ORASTS,ORSTS,ORTX,ORODT,ORSTOP,ORUSER,ORSTRT,ORMD,OREL,ORFLAG,ORNAT
 S ORIFN=+^TMP("ORR",$J,ORLIST,ORLST),OACTION=$P(^(ORLST),";",2)
 I ORSHORT,$G(ORSPG("EOP")) S ORREQ("O")="" D PTOP^ORPRS05(ORSPG,ORTIT,ORSHORT,ORSSTRT,ORSSTOP),PTHDR S ORSPG("EOP")=0
 I 'ORSHORT,$G(ORSPG("EOP")) D:$E(IOST)="C" CTOP^ORPRS05(ORSPG,$G(ORSEND),$G(ORSPG("EOP")),ORTIT,ORSHORT,ORL(0),ORL(1),ORWARD,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD)) S ORSPG("EOP")=ORSPG
 I $G(ORSPG(0))'=ORSPG S (ORREQ("O"),ORREQ("TIT",0))="",ORSPG(0)=ORSPG
 Q:'$D(^OR(100,ORIFN,0))  S X=^(0),X3=$S($D(^(3)):^(3),1:""),ORDAD=$O(^(2,0))
 S ORREQ=$P(X,"^",4),ORODT=$P(X,"^",7),ORSTOP=$P(X,"^",9),ORUSER=$P(X,"^",6),ORSTS=$P(X3,"^",3),ORSTRT=$P(X,"^",8),ORMD=$P(X3,"^",13),OREL=$S(ORSTS=11:1,1:"")
 I $D(^OR(100,ORIFN,8,OACTION,0)) S X=^(0),ORODT=+X,ORREQ=$P(X,"^",3),ORMD=$P(X,"^",4),ORNAT=$P(X,"^",12),ORUSER=$P(X,"^",13),ORASTS=$P(X,"^",15),OREL=$S(ORASTS=11:1,1:"")
 S ORREQ=$S(ORREQ:$S($D(^VA(200,ORREQ,0)):$P(^(0),"^"),1:"UNKNOWN"),1:"UNKNOWN"),ORREQ("TIT")=" " I ORREQ'="UNKNOWN" S X=$P(^(0),U,9),ORREQ("TIT")=$P($G(^DIC(3.1,+X,0)),U) I ORREQ("TIT")']"" S ORREQ("TIT")=" "
 D TEXT^ORQ12(.ORTX,$S($G(OACTION):ORIFN_";"_OACTION,1:ORIFN),40)
 S X=$P(ORREQ,",",2),ORREQ=$E($P(ORREQ,","),1,8)_","_$S($E(X)=" ":$E(X,$F(X,"")),1:$E(X))
 S:ORREQ'=ORREQ("O") ORREQ("O")=ORREQ,ORREQ("F")=1,ORREQ("TIT",0)=""
 S:'ORREQ("F")&(ORREQ=ORREQ("O")) ORREQ="    """
 S ORREQ("F")=0
 S:ORREQ("TIT")'=$G(ORREQ("TIT",0)) ORREQ("TIT",0)=ORREQ("TIT"),ORREQ("F")=1
 S:'ORREQ("F")&(ORREQ("TIT")=ORREQ("TIT",0)) ORREQ("TIT")="    """
 S ORREQ("F")=0
STS ;
 S ORSTS=$S($G(ORASTS)!(ORSTS):" "_$P(^ORD(100.01,$S($G(ORASTS):ORASTS,1:ORSTS),.1),"^"),1:" ")
 D:'$D(ORTERM(5)) TERM^ORPRS01(IOST)
 S ORFLAG=$$FLAG^ORPRS03(ORIFN,ORTERM(5))
 S ORXPND=$O(ORTX(""),-1)
 D PGCHK(ORXPND+1)
 Q:OREND
 W !!
 S X=$P(ORTERM(7),"^")
 S:OREL X=$$INV^ORU
 W:$L(ORODT) $E(ORODT,4,5)_"/"_$E(ORODT,6,7)_"/"_$E(ORODT,2,3)
 W ?8,ORSTS,?12,$S(ORDAD:"+",1:" ")
 W:$O(ORTX(0)) ORTX($O(ORTX(0)))
 W ?54,ORREQ W:$L(ORSTRT) ?65,$E(ORSTRT,4,5)_"/"_$E(ORSTRT,6,7)_"/"_$E(ORSTRT,2,3)
 W:$L(ORSTOP) ?75,$E(ORSTOP,4,5)_"/"_$E(ORSTOP,6,7)
 W !?3,$$MTIM(ORODT),?13
 S X=$O(ORTX(0))
 I X W:$O(ORTX(X)) ORTX($O(ORTX(X)))
 W ?54,$E(ORREQ("TIT"),1,10),?68,$$MTIM(ORSTRT),?75,$$MTIM(ORSTOP)
 S X=0 F I=1:1 S X=$O(ORTX(X)) Q:'X  I I>2 W !?13,ORTX(X) D:($Y>(IOSL-5)) PGCHK(ORXPND-I) Q:OREND
 Q:OREND
 W !
 I $$GET^XPAR("ALL","ORPF INITIALS ON SUMMARY",1,"I"),ORUSER W ?1,$P($G(^VA(200,ORUSER,0)),"^",2)
 I $D(^OR(100,ORIFN,8,OACTION,0)) S X=^(0) D
 . N NATURE,SIGSTS,NURSE,REVIEW
 . S SIGSTS=$P(X,"^",4),NATURE=$P(X,"^",12),NURSE=$P(X,"^",8),REVIEW=$P(X,"^",18)
 . I $L(SIGSTS) S SIGSTS=$$SET(100.008,4,SIGSTS)
 . I NATURE S NATURE=$P(^ORD(100.02,NATURE,0),"^")
 . I NURSE S NURSE=$P($G(^VA(200,NURSE,0)),"^",2)
 . I REVIEW S REVIEW=$P($G(^VA(200,REVIEW,0)),"^",2)
 . W:$L(NURSE) ?9,"Nrs:"_NURSE
 . W:$L(REVIEW) ?19,"Chrt:"_REVIEW
 . W:$L(NATURE) ?30,"Typ:"_$E(NATURE,1,18)
 . W:$L(SIGSTS) ?54,"Sgn:"_$E(SIGSTS,1,25)
 I $D(^OR(100,ORIFN,5,0)) S J=0 F  S J=$O(^OR(100,ORIFN,5,J)) Q:'J  W !?13,^(J,0)
 I ORDAD D  Q:OREND
 . N I,ORSEQ
 . S I=0,ORSEQ=0,ORTIT(0)=ORTIT
 . D KIDS(ORIFN)
 . S ORTIT=ORTIT(0)
 I OREL W !?66,"*UNRELEASED*" S X=$P(ORTERM(7),U,3),X=$$INV^ORU
 S ORSPG("LAST")='$O(^TMP("ORR",$J,ORLIST,ORLST)),ORCONT='ORSPG("LAST")
 D PGCHK()
 Q
PGCHK(CNT) ;
 N DIR,X,I
 S:'$D(CNT) CNT=0
 I $G(ORSPG("LAST")) W !!,?32,"* END OF ORDERS *" W:'$G(ORSHORT) !,ORLINE D
 . I $E(IOST)="P" D PBOT^ORPRS05(ORSPG,IOSL,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD),ORL(0),ORL(1),$G(ORSHORT)) I '$G(ORSHORT)!($Y+15>IOSL) W @IOF
 . I $E(IOST)="C" W ! S DIR(0)="FO^1;2",DIR("A")="Press RETURN to continue, '^' to exit" D ^DIR I $D(DUOUT) S OREND=1 Q
 I $G(ORSEND),$G(ORLSTO) D  K ORSEND,ORCONT Q
 . W !?(IOM-44)\2,"*****    E N D    O F    R E P O R T    ****",!
 . I $E(IOST)="C" W ! S DIR(0)="FO^1;2",DIR("A")="Press RETURN to continue, '^' to exit" D ^DIR I $D(DUOUT) S OREND=1 Q
 I $G(ORSPG("LAST")) Q
 I $E(IOST)="C" D  Q
 . I ((IOSL-$Y)>(4+CNT))!(CNT+4>(IOSL-3)) Q
 . S ORSPG=$G(ORSPG)+1
 . W !
 . S DIR(0)="FO^1;2",DIR("A")="Press RETURN to continue or '^' to exit"
 . D ^DIR
 . I $D(DUOUT) K ORSEND,ORCONT S OREND=1 Q
 . D CTOP^ORPRS05(ORSPG,$G(ORSEND),$G(ORSPG("EOP")),ORTIT,ORSHORT,ORL(0),ORL(1),ORWARD,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD))
 . S ORSPG=0
 . I $G(ORCONT) D PTHDR
 I ((IOSL-$Y)>(6+CNT))!(CNT+6>(IOSL-5)) Q
 D PBOT^ORPRS05(ORSPG,IOSL,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD),ORL(0),ORL(1),$G(ORSHORT))
 S ORSPG=ORSPG+1
 W @IOF
 D PTOP^ORPRS05(ORSPG,ORTIT,ORSHORT,ORSSTRT,ORSSTOP)
 I $G(ORCONT) D PTHDR
 Q
PTHDR ;
 W !,ORPNM_"   "_$G(ORSSN)_" "_$S($G(ORCONT):"(cont.)",1:"")_" "
 S X=$P(ORWARD,"^",2)_"  "_ORL(1)
 W ?(80-$L(X))\2,X
 Q
KIDS(ORIFN,LENGTH) ;Print child orders
 N ORCHLD,OROIFN
 S OROIFN=ORIFN,ORCHLD=0
 F I=0:0 S ORCHLD=$O(^OR(100,OROIFN,2,ORCHLD)) Q:ORCHLD<1  D PGCHK() Q:OREND  S ORIFN=ORCHLD D ONE^ORPRS03(ORCHLD,"         ",$G(LENGTH))
 Q
MTIM(X) ;Format time from Fileman date in X
 I '$G(X) Q ""
 S X=$P(X,".",2)
 Q:'$L(X) ""
 S X=$E(X,1,2)_$E("00",0,2-$L($E(X,1,2)))_":"_$E(X,3,4)_$E("00",0,2-$L($E(X,3,4)))
 Q X
SET(FILE,FIELD,RESULT) ;Interpret set of codes
 S X=$P(^DD(FILE,FIELD,0),"^",3),X=$P($P(";"_X,";"_RESULT_":",2),";")
 Q X