PSOATRD ;BIR/SJA - INTERNET REFILL BY DATE ;05/29/07 12:36pm
 ;;7.0;OUTPATIENT PHARMACY;**264**;DEC 1997;Build 19
 ;
 K IOP,%ZIS,POP S PSOION=ION,%ZIS="MQ" D ^%ZIS I POP S IOP=PSOION D ^%ZIS K PSOION S PSOQUIT=1 G END
 I $D(IO("Q")) D  K PSOION,ZTSK S PSOQUIT=1 G END
 . N VAR K IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK S ZTRTN="START^PSOATRD",ZTDESC="INTERNET REFILL REPORT BY DATE"
 . F VAR="PSODS","PSOED","PSOEDX","PSOREP","PSORMZ","PSOSD","PSOSDX","RDATE" S:$D(@VAR) ZTSAVE(VAR)=""
 . S ZTSAVE("PSODIV*")=""
 . D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print !!"
START U IO
 N DFN,DIV,EOFLAG,LINE,PAGE,PNODE,PSA,PSAB,PSO,PSOAB,PSOAFLAG,PSOD,PSODFN,PSOERR
 N PSON,PSOP6,PSOQUIT,PSORXDV,PSORXIN,PSOSD1,PSOT,X,Y
 K ^TMP($J,"PSOINT") S PAGE=1,PSOQUIT=0,$P(LINE,"-",$S($G(PSORMZ):130,1:79))=""
 S (PSOERR,PSOAFLAG)=0
 S PSOD=0 F  S PSOD=$O(PSODIV(PSOD)) Q:'PSOD  S ^TMP($J,"PSOINT",PSOD)=""
 S (PSA,PSOD)=0 F  S PSOD=$O(PSODIV(PSOD)) Q:'PSOD  D  Q:$G(PSODIV)="ALL"
 .S ^TMP($J,"PSOINT",PSOD)=""
 .S PSOSD1=PSOSD-1 F  S PSOSD1=$O(^PS(52.43,"AD",PSOSD1)) Q:'PSOSD1  I PSOSD1'<PSOSD,PSOSD1'>PSOED D
 ..S PSA=0 F  S PSA=$O(^PS(52.43,"AD",PSOSD1,PSA)) Q:'PSA  S PSAB=$G(^PS(52.43,PSA,0)) D:$P(PSAB,"^",6)>0
 ...S PSORXIN=$P(PSAB,"^",8),PSODFN=$P($G(^PSRX(PSORXIN,0)),"^",2),PSORXDV=$P($G(^PSRX(PSORXIN,2)),"^",9)
 ...I $G(PSODIV)="ALL"!($$DIV^PSOATRP(PSORXIN,PSORXDV)) D SET
 I PSODS="S" D SUMM G END ;print summary report only
 S DIV=0 F  S DIV=$O(^TMP($J,"PSOINT",DIV)) Q:'DIV!(PSOQUIT)  D  D FO W:$E(IOST)="P" @IOF
 .S (PSOT(1),PSOT(2),PSO(1),PSO(2),PSOT(10),PSOT(20))=0
 .S PAGE=1 D HD I $D(^TMP($J,"PSOINT",DIV))'=11 W !!,"NO DATA FOUND TO PRINT FOR THIS RANGE.",! D:$E(IOST)="C"  S PSOERR=1 W:$E(IOST)="P" @IOF
 ..K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR W @IOF
 .S PSOSD=0 F  S PSOSD=$O(^TMP($J,"PSOINT",DIV,PSOSD)) Q:'PSOSD!(PSOQUIT)  D PRTD S (PSOT(1),PSOT(2),PSOT(10),PSOT(20),PSODFN)=0 D  D FO1
 ..F  S PSODFN=$O(^TMP($J,"PSOINT",DIV,PSOSD,PSODFN)) Q:'PSODFN!(PSOQUIT)  S (PSON,PSORXIN)=0 D
 ...F  S PSORXIN=$O(^TMP($J,"PSOINT",DIV,PSOSD,PSODFN,PSORXIN)) Q:'PSORXIN!(PSOQUIT)  D SET1 D PRT
END D:$E(IOST)="C"&('$G(PSOQUIT))&('$G(PSOERR))  K ^TMP($J,"PSOINT") W:$E(IOST)="P" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
 .W !!,"** END OF REPORT **"
 .W !! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
 ;
HD ;PRINT PAGE HEADING
 W:$G(PAGE)'=1!($E(IOST)="C") @IOF W !,"INTERNET REFILL BY DATE - "_$S(PSODS="D":" Detail",1:"Summary")
 W ?41,$P(RDATE,":",1,2) W ?$S($G(PSORMZ):120,1:68),"PAGE: "_PAGE
 W !,$S(PSODS="D":"Not Filled - ",1:"")_"For date range "_$G(PSOSDX)_" through "_$G(PSOEDX)_" for "_$P(^PS(59,DIV,0),"^")
 I PSODS="S" W !!,"Date Processed",?35,"Filled",?48,"Not Filled",?63,"Total"
 E  W !!,"Patient",?30,"Rx #" W:'$G(PSORMZ) ! W ?$S($G(PSORMZ):56,1:20),"Reason"
 W !,LINE S PAGE=PAGE+1
 Q
PRT ;PRINT REPORT
 S EOFLAG=0 I ($Y+5)>IOSL D  Q:PSOQUIT
 .I $E(IOST)="C" W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue,'^' to exit" D ^DIR K DIR S:'Y PSOQUIT=1 I 'PSOQUIT S EOFLAG=1 D HD
 .I $E(IOST)'="C" S EOFLAG=1 D HD
 S PNODE=$G(^PS(52.43,$P(PSOAB,"^"),0)),PSOP6=$P(PNODE,"^",6)
 I PSODS="S" W ?35,PSO(1),?48,PSO(2),?63,(PSO(1)+PSO(2))
 E  W !,$S(PSON=1:$P(PSOAB,"^",2)_" ("_$P(PSOAB,"^",3)_")",1:""),?30,$P(PNODE,"^",3) W:'$G(PSORMZ) ! W ?$S($G(PSORMZ):56,1:20),$P(PNODE,"^",10)
 Q
PRTD S Y=PSOSD D DD^%DT W !,Y
 Q
FO I PSODS="S",$D(^TMP($J,"PSOINT",DIV))=11 W !!,"COUNT: ",?35,PSOT(1),?48,PSOT(2),?63,(PSOT(1)+PSOT(2)) G T1
 Q:$D(^TMP($J,"PSOINT",DIV))'=11  D:PSODS="D"
 .W !!,"Total transactions for date range "_$G(PSOSDX)_" through "_$G(PSOEDX)_" = "_(PSOT(10)+PSOT(20))
T1 I $E(IOST)="C" W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
 Q
FO1 ;
 S PSOT(10)=PSOT(10)+PSO(1),PSOT(20)=PSOT(20)+PSO(2)
 I $D(^TMP($J,"PSOINT",DIV))=11 W !,"Count: ",PSOT(2),!
 Q
SET I PSODS="D",($P(PSAB,"^",6)=1) Q
 S DFN=PSODFN D DEM^VADPT
 S ^TMP($J,"PSOINT",PSORXDV,PSOSD1,PSODFN,PSORXIN)=PSA_"^"_VADM(1)_"^"_VA("BID")
 Q
SET1 K PSPC
 S PSOAB=$G(^TMP($J,"PSOINT",DIV,PSOSD,PSODFN,PSORXIN)),PNODE=$G(^PS(52.43,$P(PSOAB,"^"),0))
 S PSPC=$P(PNODE,"^",6),PSO(PSPC)=PSO(PSPC)+1,PSOT(PSPC)=PSOT(PSPC)+1,PSON=PSON+1
 Q
SUMM ;
 S DIV=0 F  S DIV=$O(^TMP($J,"PSOINT",DIV)) Q:'DIV!(PSOQUIT)  D  D FO W:$E(IOST)="P" @IOF
 .S (PSOT(1),PSOT(2),PSO(1),PSO(2),PSOT(10),PSOT(20))=0
 .S PAGE=1 D HD I $D(^TMP($J,"PSOINT",DIV))'=11 W !!,"NO DATA FOUND TO PRINT FOR THIS RANGE.",! D:$E(IOST)="C"  S PSOERR=1
 ..K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR W @IOF
 .S PSOSD=0 F  S PSOSD=$O(^TMP($J,"PSOINT",DIV,PSOSD)) Q:'PSOSD!(PSOQUIT)  D PRTD S (PSO(1),PSO(2),PSOT(10),PSOT(20),PSODFN)=0 D  D PRT
 ..F  S PSODFN=$O(^TMP($J,"PSOINT",DIV,PSOSD,PSODFN)) Q:'PSODFN!(PSOQUIT)  S (PSON,PSORXIN)=0 D
 ...F  S PSORXIN=$O(^TMP($J,"PSOINT",DIV,PSOSD,PSODFN,PSORXIN)) Q:'PSORXIN!(PSOQUIT)  D SET1 S PSOT(10)=PSOT(1),PSOT(20)=PSOT(2)
 Q