source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPRS11.m

ORPRS11 ; slc/dcm - Alternate lifestyle for Summary Reports ;12/7/00  13:13
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,92**;Dec 17, 1997
 ;Sorts by display group, using the Summary Order display group for
 ;the order.  Loops on the AW x-ref, sorted by forward Start date.
 ;Not currently in use!!!
 ;The lookup on the AW x-ref needs to be changed to call ^ORQ1 with
 ;the display group SUMMARY ORDER, then another sort needs to be done
 ;on the returned array to sort on the Summary Order sequence and
 ;the start time.
IN ;START
 Q  ;Not ready for primetime.
 S (OREND,ORANSI,ORSPG)=0
 D:$D(ORSCPAT)'>9 P^ORPRS01
 G:OREND!'$D(ORSCPAT) END
 D PRES^ORPRS09
 G:OREND END
 D SERV^ORPRS09
 G:OREND END
 D RANGE^ORPRS01()
 G:OREND END
 S ORTIT=$P(ORPRES,";",2)_" for "_ORGRP("NAM")_" SERVICES"
CONT ;
 D QUE^ORUTL1("EN1^ORPRS11","Alternate Order Summary Report"),END
 Q
EN1 ;Entry point for Batch Processing
 U IO
 I +ORPRES=2 S %DT="",X="T-1" D ^%DT S ORYD=Y
 I +ORPRES=6 S %DT="",X="T+1" D ^%DT S ORTMW=Y_".9999"
 I $E(IOST)'="C",$L($G(ORSWDN)) S ORSLTR=$E(ORSWDN,1,(IOM\15)) D ^ORSLTR
 S (NEXTP,OREND)=0
 F  S NEXTP=$O(ORSCPAT(NEXTP)) Q:NEXTP=""!(OREND=1)  S ORVP=+ORSCPAT(NEXTP)_";DPT(" D EN Q:OREND  D PGBRK^ORUHDR:$E(IOST)="C" Q:OREND
END ; Clean up variables
 K ^TMP("ORR",$J),ORSLTR,ORANSI,ORATTEND,ORDAD,ORDOG,ORDOGY,ORFLAG,ORI,ORSCPAT,ORSUM,ORTERM,ORYD,ORTMW,X2,X3,XQORSPEW,ORURMBD,ORPRTD,ORSHORT
 K I,II,J,K,NEXTP,NB,ND,NS,ORES,ODATE,ORAGE,ORDCFC,ORMD,ORDG,ORDIC,ORDOB,OREND,ORFT,ORGRP,ORH,ORH2,ORHI,ORIO,ORL,ORLST,ORODT,ORNP,ORPD,ORPFG,ORPNM,ORPRES,ORUSER,ORPV,ORREQ,ORSPG
 K ORSEL,ORSEQ,ORSEX,ORSP,ORSPAT,ORSPL,ORSSN,ORSSTOP,ORSSTRT,ORSTRT,ORSTOP,ORSTS,ORASTS,ORTIT,ORTM,ORTS,ORTX,ORVP,ORWARD,ORX,X,X1,Y,%,%DT,%IS,ORSWD,ORSWDN,ORRPG,ORIFN
 I $D(ZTSK) D KILL^%ZTLOAD K ZTSK
 Q
EN ;
 I '$D(^OR(100,"AW",ORVP)) W !!,"NO ORDERS FOUND",!! Q
 S Y=+ORVP,ORSPG("EOP")=0
 D END^ORUDPA
 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))
 I $E(IOST)'="C" D  Q:OREND
 . D PGCHK Q:OREND
 . D PTOP^ORPRS05(ORSPG,ORTIT,ORSHORT,ORSSTRT,ORSSTOP),PTHDR
 I ORSPG("EOP")'=1 D PGCHK Q:OREND
 K ORPRTD
 S ORSUM=$O(^ORD(100.98,"B","SUMMARY ORDER",0))
 Q:'ORSUM
 S ORDOG=0
 F  S ORDOG=$O(^ORD(100.98,ORSUM,1,ORDOG)) Q:'ORDOG  S ORDOGY=+^(ORDOG,0) I $D(^OR(100,"AW",ORVP,ORDOGY)) D  Q:OREND
 . D PGCHK,PGCHK1
 . W !!,$P(^ORD(100.98,ORDOGY,0),"^")
 . S X="",$P(X,"-",$L($P(^(0),"^"))+1)=""
 . W !,X
 . S ORTM=$S($D(ORSSTRT):+ORSSTRT,1:0)
 . F  S ORTM=$O(^OR(100,"AW",ORVP,ORDOGY,ORTM)) Q:'ORTM!(ORTM>+ORSSTOP)  D  Q:OREND
 .. S ORIFN=0
 .. F  S ORIFN=$O(^OR(100,"AW",ORVP,ORDOGY,ORTM,ORIFN)) Q:'ORIFN  D  Q:OREND
 ... D PGCHK,PGCHK1
 ... Q:OREND
 ... D PRT
 ... S ORPRTD=1
 I $G(ORPRTD),$E(IOST)'="C" S X="",$P(X,"-",IOM)="" W !,X D PBOT^ORPRS05(1,ORBOT,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD),ORL(0),ORL(1))
 Q
PRT ;Print order line
 K ORTX
 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(X0,"^",8),ORMD=$P(X3,"^",10)
 I $G(OACTION) I $D(^OR(100,ORIFN,8,OACTION,0)) S X=^(0),ORODT=+X,ORREQ=$P(X,"^",3),ORMD=$P(X,"^",4),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")
 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))
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))
 W !
 S X=$P(ORTERM(7),"^")
 S:OREL X=$$INV^ORU
 W:$L(ORODT) ?2,$E(ORODT,4,5),"/",$E(ORODT,6,7)
 W ?9,ORSTS
 W ?11,$S(ORDAD:"+",1:" ")
 W:$O(ORTX(0)) ORTX($O(ORTX(0)))
 W ?54,ORREQ
 W:$L(ORSTRT) ?64,$E(ORSTRT,4,5),"/",$E(ORSTRT,6,7)
 W:$L(ORSTOP) ?74,$E(ORSTOP,4,5),"/",$E(ORSTOP,6,7)
 W !?2,$$MTIM^ORPRS04(ORODT),?12
 S X=$O(ORTX(0))
 I X W:$O(ORTX(X)) ORTX($O(ORTX(X)))
 W ?67,$$MTIM^ORPRS04(ORSTRT),?74,$$MTIM^ORPRS04(ORSTOP)
 S X=0 F I=1:1 S X=$O(ORTX(X)) Q:X'>0  I I>2 W !?12,ORTX(X)
 I $D(^OR(100,ORIFN,5,0)) S J=0 F I=0:0 S J=$O(^OR(100,ORIFN,5,J)) Q:J<1  W !?12,^(J,0)
 I ORDAD D
 . S ORSEQ=0 D PRT1 K ORSEQ
 I OREL W !?66,"*UNRELEASED*" S X=$P(ORTERM(7),"^",3),X=$$INV^ORU
 K OREL Q
PGCHK ;
 S ORSPG("EOP")=0
 Q:(IOSL-$Y)'<8
 S ORSPG("EOP")=1
 I ORSPG("EOP"),$E(IOST)="C" D WAIT
 Q
PGCHK1 ;
 I $E(IOST)'="C",(IOSL-$Y)<8 S X="",$P(X,"-",IOM)="" W !,X D PBOT^ORPRS05(1,ORBOT,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD),ORL(0),ORL(1)),PTOP^ORPRS05(ORSPG,ORTIT,ORSHORT,ORSSTRT,ORSSTOP),PTHDR W !
 Q
WAIT ;
 W !!,"Press RETURN to continue, '^' to escape"
 R X:DTIME
 S:'$T X="^"
 S:X["^" OREND=1
 D:'OREND CTOP^ORPRS05(ORSPG,$G(ORSEND),$G(ORSPG("EOP")),ORTIT,ORSHORT,ORL(0),ORL(1),ORWARD,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD))
 W:OREND @IOF
 Q
PRT1 ;
 S OROSEQ=$G(ORSEQ),OROIFN=ORIFN,ORCHLD=0
 F I=0:0 S ORCHLD=$O(^OR(100,OROIFN,2,ORCHLD)) Q:ORCHLD<1  D PGCHK,PGCHK1 Q:OREND  S ORIFN=ORCHLD,ORSEQ="     " D ONE^ORPRS03(ORIFN,"     ")
 S ORIFN=OROIFN,ORSEQ=OROSEQ
 K OROIFN,OROSEQ,ORCHLD
 Q
PTHDR ;
 W !,ORPNM,"  "
 S X=$P(ORWARD,"^",2)_"  "_ORL(1)
 W ?(80-$L(X)/2),X,?68,$G(ORSSN)
 Q