- PSOATRR ;BIR/SJA - INTERNET REFILL REPORT SORTED BY RESULT ;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^PSOATRR",ZTDESC="INTERNET REFILL REPORT SORTED BY RESULT"
- . 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,PSODFN,PSOERR,PSON,PSOP5,PSOP6,PSOPAT
- N 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 (PSO("TOT"),PSO(1),PSO(2))=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
- .S PSODFN=0 F S PSODFN=$O(^TMP($J,"PSOINT",DIV,PSODFN)) Q:'PSODFN!(PSOQUIT) S PSOPAT=0 D
- ..S (PSON,PSORXIN)=0 F S PSORXIN=$O(^TMP($J,"PSOINT",DIV,PSODFN,PSORXIN)) Q:'PSORXIN!(PSOQUIT) S PSOAB=$G(^TMP($J,"PSOINT",DIV,PSODFN,PSORXIN)) D
- ...S PSOPAT=PSOPAT+1,PSO("TOT")=PSO("TOT")+1,PSON=PSON+1 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 REPORT BY RESULT"_" - "_$S(PSODS="D":"Detail",1:"Summary")
- W ?45,$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 !!,"Result",?30,"Count"
- E W !!,"Patient",?30,"Rx #",?44,"Date" W:'$G(PSORMZ) ! W ?$S($G(PSORMZ):58,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))
- S Y=$P(PNODE,"^",5),PSOP5=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3),PSOP6=$P(PNODE,"^",6),PSO(PSOP6)=PSO(PSOP6)+1
- W !,$S(PSON=1:$P(PSOAB,"^",2)_" ("_$P(PSOAB,"^",3)_")",1:""),?30,$P(PNODE,"^",3),?44,PSOP5 W:'$G(PSORMZ) ! W ?$S($G(PSORMZ):58,1:20),$P(PNODE,"^",10)
- Q
- FO I PSODS="S",$D(^TMP($J,"PSOINT",DIV))=11 W !!!,"Total: ",?30,(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)_" = "_PSO("TOT")
- .I $G(PSORST)="B" W !,"Filled = "_PSO(1)," Not Filled = ",PSO(2)
- T1 I $E(IOST)="C" W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
- W:$E(IOST)="P" @IOF
- Q
- SET I PSODS="D",($P(PSAB,"^",6)=1) Q
- S DFN=PSODFN D DEM^VADPT
- S ^TMP($J,"PSOINT",PSORXDV,PSODFN,PSORXIN)=PSA_"^"_VADM(1)_"^"_VA("BID")
- Q
- SUMM ;
- S DIV=0 F S DIV=$O(^TMP($J,"PSOINT",DIV)) Q:'DIV!(PSOQUIT) S (PSO(2),PSO(1),PSOT(1),PSOT(2))=0 D D PRTS,FO W:$E(IOST)="P" @IOF
- .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
- .S PSODFN=0 F S PSODFN=$O(^TMP($J,"PSOINT",DIV,PSODFN)) Q:'PSODFN!(PSOQUIT) D
- ..S PSORXIN=0 F S PSORXIN=$O(^TMP($J,"PSOINT",DIV,PSODFN,PSORXIN)) Q:'PSORXIN!(PSOQUIT) D
- ...S PSOAB=$G(^TMP($J,"PSOINT",DIV,PSODFN,PSORXIN)),PNODE=$G(^PS(52.43,$P(PSOAB,"^"),0))
- ...S PSOP6=$P(PNODE,"^",6) S PSO(PSOP6)=PSO(PSOP6)+1,PSOT(PSOP6)=PSOT(PSOP6)+1
- Q
- PRTS ;
- W:$D(^TMP($J,"PSOINT",DIV))=11 !,"Filled",?30,PSO(1),!,"Not Filled",?30,PSO(2)
- Q
- PSOATRR ;BIR/SJA - INTERNET REFILL REPORT SORTED BY RESULT ;05/29/07 12:36pm
- +1 ;;7.0;OUTPATIENT PHARMACY;**264**;DEC 1997;Build 19
- +2 ;
- +3 KILL IOP,%ZIS,POP
- SET PSOION=ION
- SET %ZIS="MQ"
- DO ^%ZIS
- IF POP
- SET IOP=PSOION
- DO ^%ZIS
- KILL PSOION
- SET PSOQUIT=1
- GOTO END
- +4 IF $DATA(IO("Q"))
- Begin DoDot:1
- +5 NEW VAR
- KILL IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK
- SET ZTRTN="START^PSOATRR"
- SET ZTDESC="INTERNET REFILL REPORT SORTED BY RESULT"
- +6 FOR VAR="PSODS","PSOED","PSOEDX","PSOREP","PSORMZ","PSOSD","PSOSDX","RDATE"
- IF $DATA(@VAR)
- SET ZTSAVE(VAR)=""
- +7 SET ZTSAVE("PSODIV*")=""
- +8 DO ^%ZTLOAD
- IF $DATA(ZTSK)
- WRITE !,"Report is Queued to print !!"
- End DoDot:1
- KILL PSOION,ZTSK
- SET PSOQUIT=1
- GOTO END
- START USE IO
- +1 NEW DFN,DIV,EOFLAG,LINE,PAGE,PNODE,PSA,PSAB,PSO,PSOAB,PSOAFLAG,PSODFN,PSOERR,PSON,PSOP5,PSOP6,PSOPAT
- +2 NEW PSOQUIT,PSORXDV,PSORXIN,PSOSD1,PSOT,X,Y
- +3 KILL ^TMP($JOB,"PSOINT")
- SET PAGE=1
- SET PSOQUIT=0
- SET $PIECE(LINE,"-",$SELECT($GET(PSORMZ):130,1:79))=""
- +4 SET (PSOERR,PSOAFLAG)=0
- +5 SET PSOD=0
- FOR
- SET PSOD=$ORDER(PSODIV(PSOD))
- IF 'PSOD
- QUIT
- SET ^TMP($JOB,"PSOINT",PSOD)=""
- +6 SET (PSA,PSOD)=0
- FOR
- SET PSOD=$ORDER(PSODIV(PSOD))
- IF 'PSOD
- QUIT
- Begin DoDot:1
- +7 SET ^TMP($JOB,"PSOINT",PSOD)=""
- +8 SET PSOSD1=PSOSD-1
- FOR
- SET PSOSD1=$ORDER(^PS(52.43,"AD",PSOSD1))
- IF 'PSOSD1
- QUIT
- IF PSOSD1'<PSOSD
- IF PSOSD1'>PSOED
- Begin DoDot:2
- +9 SET PSA=0
- FOR
- SET PSA=$ORDER(^PS(52.43,"AD",PSOSD1,PSA))
- IF 'PSA
- QUIT
- SET PSAB=$GET(^PS(52.43,PSA,0))
- IF $PIECE(PSAB,"^",6)>0
- Begin DoDot:3
- +10 SET PSORXIN=$PIECE(PSAB,"^",8)
- SET PSODFN=$PIECE($GET(^PSRX(PSORXIN,0)),"^",2)
- SET PSORXDV=$PIECE($GET(^PSRX(PSORXIN,2)),"^",9)
- +11 IF $GET(PSODIV)="ALL"!($$DIV^PSOATRP(PSORXIN,PSORXDV))
- DO SET
- End DoDot:3
- End DoDot:2
- End DoDot:1
- IF $GET(PSODIV)="ALL"
- QUIT
- +12 ;print summary report only
- IF PSODS="S"
- DO SUMM
- GOTO END
- +13 SET DIV=0
- FOR
- SET DIV=$ORDER(^TMP($JOB,"PSOINT",DIV))
- IF 'DIV!(PSOQUIT)
- QUIT
- Begin DoDot:1
- +14 SET (PSO("TOT"),PSO(1),PSO(2))=0
- +15 SET PAGE=1
- DO HD
- IF $DATA(^TMP($JOB,"PSOINT",DIV))'=11
- WRITE !!,"NO DATA FOUND TO PRINT FOR THIS RANGE.",!
- IF $EXTRACT(IOST)="C"
- Begin DoDot:2
- +16 KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- End DoDot:2
- SET PSOERR=1
- IF $EXTRACT(IOST)="P"
- WRITE @IOF
- +17 SET PSODFN=0
- FOR
- SET PSODFN=$ORDER(^TMP($JOB,"PSOINT",DIV,PSODFN))
- IF 'PSODFN!(PSOQUIT)
- QUIT
- SET PSOPAT=0
- Begin DoDot:2
- +18 SET (PSON,PSORXIN)=0
- FOR
- SET PSORXIN=$ORDER(^TMP($JOB,"PSOINT",DIV,PSODFN,PSORXIN))
- IF 'PSORXIN!(PSOQUIT)
- QUIT
- SET PSOAB=$GET(^TMP($JOB,"PSOINT",DIV,PSODFN,PSORXIN))
- Begin DoDot:3
- +19 SET PSOPAT=PSOPAT+1
- SET PSO("TOT")=PSO("TOT")+1
- SET PSON=PSON+1
- DO PRT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- DO FO
- IF $EXTRACT(IOST)="P"
- WRITE @IOF
- END IF $EXTRACT(IOST)="C"&('$GET(PSOQUIT))&('$GET(PSOERR))
- Begin DoDot:1
- +1 WRITE !!,"** END OF REPORT **"
- +2 WRITE !!
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- End DoDot:1
- KILL ^TMP($JOB,"PSOINT")
- IF $EXTRACT(IOST)="P"
- WRITE @IOF
- DO ^%ZISC
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +3 ;
- HD ;PRINT PAGE HEADING
- +1 IF $GET(PAGE)'=1!($EXTRACT(IOST)="C")
- WRITE @IOF
- WRITE !,"INTERNET REFILL REPORT BY RESULT"_" - "_$SELECT(PSODS="D":"Detail",1:"Summary")
- +2 WRITE ?45,$PIECE(RDATE,":",1,2)
- WRITE ?$SELECT($GET(PSORMZ):120,1:68),"PAGE: "_PAGE
- +3 WRITE !,$SELECT(PSODS="D":"Not Filled - ",1:"")_"For date range "_$GET(PSOSDX)_" through "_$GET(PSOEDX)_" for "_$PIECE(^PS(59,DIV,0),"^")
- +4 IF PSODS="S"
- WRITE !!,"Result",?30,"Count"
- +5 IF '$TEST
- WRITE !!,"Patient",?30,"Rx #",?44,"Date"
- IF '$GET(PSORMZ)
- WRITE !
- WRITE ?$SELECT($GET(PSORMZ):58,1:20),"Reason"
- +6 WRITE !,LINE
- SET PAGE=PAGE+1
- +7 QUIT
- PRT ;PRINT REPORT
- +1 SET EOFLAG=0
- IF ($Y+5)>IOSL
- Begin DoDot:1
- +2 IF $EXTRACT(IOST)="C"
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue,'^' to exit"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSOQUIT=1
- IF 'PSOQUIT
- SET EOFLAG=1
- DO HD
- +3 IF $EXTRACT(IOST)'="C"
- SET EOFLAG=1
- DO HD
- End DoDot:1
- IF PSOQUIT
- QUIT
- +4 SET PNODE=$GET(^PS(52.43,$PIECE(PSOAB,"^"),0))
- +5 SET Y=$PIECE(PNODE,"^",5)
- SET PSOP5=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
- SET PSOP6=$PIECE(PNODE,"^",6)
- SET PSO(PSOP6)=PSO(PSOP6)+1
- +6 WRITE !,$SELECT(PSON=1:$PIECE(PSOAB,"^",2)_" ("_$PIECE(PSOAB,"^",3)_")",1:""),?30,$PIECE(PNODE,"^",3),?44,PSOP5
- IF '$GET(PSORMZ)
- WRITE !
- WRITE ?$SELECT($GET(PSORMZ):58,1:20),$PIECE(PNODE,"^",10)
- +7 QUIT
- FO IF PSODS="S"
- IF $DATA(^TMP($JOB,"PSOINT",DIV))=11
- WRITE !!!,"Total: ",?30,(PSOT(1)+PSOT(2))
- GOTO T1
- +1 IF $DATA(^TMP($JOB,"PSOINT",DIV))'=11
- QUIT
- IF PSODS="D"
- Begin DoDot:1
- +2 WRITE !!,"Total transactions for date range "_$GET(PSOSDX)_" through "_$GET(PSOEDX)_" = "_PSO("TOT")
- +3 IF $GET(PSORST)="B"
- WRITE !,"Filled = "_PSO(1)," Not Filled = ",PSO(2)
- End DoDot:1
- T1 IF $EXTRACT(IOST)="C"
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- +1 IF $EXTRACT(IOST)="P"
- WRITE @IOF
- +2 QUIT
- SET IF PSODS="D"
- IF ($PIECE(PSAB,"^",6)=1)
- QUIT
- +1 SET DFN=PSODFN
- DO DEM^VADPT
- +2 SET ^TMP($JOB,"PSOINT",PSORXDV,PSODFN,PSORXIN)=PSA_"^"_VADM(1)_"^"_VA("BID")
- +3 QUIT
- SUMM ;
- +1 SET DIV=0
- FOR
- SET DIV=$ORDER(^TMP($JOB,"PSOINT",DIV))
- IF 'DIV!(PSOQUIT)
- QUIT
- SET (PSO(2),PSO(1),PSOT(1),PSOT(2))=0
- Begin DoDot:1
- +2 SET PAGE=1
- DO HD
- IF $DATA(^TMP($JOB,"PSOINT",DIV))'=11
- WRITE !!,"NO DATA FOUND TO PRINT FOR THIS RANGE.",!
- IF $EXTRACT(IOST)="C"
- Begin DoDot:2
- +3 KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- End DoDot:2
- SET PSOERR=1
- +4 SET PSODFN=0
- FOR
- SET PSODFN=$ORDER(^TMP($JOB,"PSOINT",DIV,PSODFN))
- IF 'PSODFN!(PSOQUIT)
- QUIT
- Begin DoDot:2
- +5 SET PSORXIN=0
- FOR
- SET PSORXIN=$ORDER(^TMP($JOB,"PSOINT",DIV,PSODFN,PSORXIN))
- IF 'PSORXIN!(PSOQUIT)
- QUIT
- Begin DoDot:3
- +6 SET PSOAB=$GET(^TMP($JOB,"PSOINT",DIV,PSODFN,PSORXIN))
- SET PNODE=$GET(^PS(52.43,$PIECE(PSOAB,"^"),0))
- +7 SET PSOP6=$PIECE(PNODE,"^",6)
- SET PSO(PSOP6)=PSO(PSOP6)+1
- SET PSOT(PSOP6)=PSOT(PSOP6)+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- DO PRTS
- DO FO
- IF $EXTRACT(IOST)="P"
- WRITE @IOF
- +8 QUIT
- PRTS ;
- +1 IF $DATA(^TMP($JOB,"PSOINT",DIV))=11
- WRITE !,"Filled",?30,PSO(1),!,"Not Filled",?30,PSO(2)
- +2 QUIT
