source: FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOATRPP.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.9 KB
Line 
1PSOATRPP ;BIR/SJA - INTERNET REFILL REPORT SORTED BY PATIENT ;05/29/07 12:36pm
2 ;;7.0;OUTPATIENT PHARMACY;**264**;DEC 1997;Build 19
3 ;
4 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
5 I $D(IO("Q")) D K PSOION,ZTSK S PSOQUIT=1 G END
6 . N VAR K IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK S ZTRTN="START^PSOATRPP",ZTDESC="INTERNET REFILL REPORT SORTED BY PATIENT"
7 . F VAR="PSODS","PSOED","PSOEDX","PSOREP","PSORMZ","PSOSD","PSOSDX","RDATE" S:$D(@VAR) ZTSAVE(VAR)=""
8 . S ZTSAVE("PSODIV*")=""
9 . D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print !!"
10START U IO
11 N DFN,DIV,EOFLAG,LINE,PAGE,PNODE,PSA,PSAB,PSDD,PSO,PSOAB,PSOAFLAG,PSODFN,PSOERR,PSON,PSONAM
12 N PSOP6,PSOPAT,PSOP5,PSORXDV,PSORXIN,PSOSD1,PSOT,PSOQUIT,X,Y
13 K ^TMP($J,"PSOINT") S PAGE=1,PSOQUIT=0,$P(LINE,"-",$S($G(PSORMZ):130,1:79))=""
14 S (PSOERR,PSOAFLAG)=0
15 S PSOD=0 F S PSOD=$O(PSODIV(PSOD)) Q:'PSOD S ^TMP($J,"PSOINT",PSOD)=""
16 S (PSA,PSOD)=0 F S PSOD=$O(PSODIV(PSOD)) Q:'PSOD D Q:$G(PSODIV)="ALL"
17 .S ^TMP($J,"PSOINT",PSOD)=""
18 .S PSOSD1=PSOSD-1 F S PSOSD1=$O(^PS(52.43,"AD",PSOSD1)) Q:'PSOSD1 I PSOSD1'<PSOSD,PSOSD1'>PSOED D
19 ..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
20 ...S PSORXIN=$P(PSAB,"^",8),PSODFN=$P($G(^PSRX(PSORXIN,0)),"^",2),PSORXDV=$P($G(^PSRX(PSORXIN,2)),"^",9)
21 ...I $G(PSODIV)="ALL"!($$DIV^PSOATRP(PSORXIN,PSORXDV)) D SET
22 I PSODS="S" D SUMM G END ;print summary report only
23 S DIV=0 F S DIV=$O(^TMP($J,"PSOINT",DIV)) Q:'DIV!(PSOQUIT) D D FO W:$E(IOST)="P" @IOF
24 .S (PSO("TOT"),PSO(1),PSO(2))=0
25 .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
26 ..K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
27 .S PSONAM="" F S PSONAM=$O(^TMP($J,"PSOINT",DIV,PSONAM)) Q:PSONAM=""!(PSOQUIT) S PSOPAT=0 D D FO1
28 ..S (PSON,PSORXIN)=0 F S PSORXIN=$O(^TMP($J,"PSOINT",DIV,PSONAM,PSORXIN)) Q:'PSORXIN!(PSOQUIT) S PSDD=0 F S PSDD=$O(^TMP($J,"PSOINT",DIV,PSONAM,PSORXIN,PSDD)) Q:'PSDD!(PSOQUIT) D
29 ...S PSOPAT=PSOPAT+1,PSO("TOT")=PSO("TOT")+1,PSON=PSON+1,PSOAB=$G(^TMP($J,"PSOINT",DIV,PSONAM,PSORXIN,PSDD)) D PRT
30END D:$E(IOST)="C"&('$G(PSOQUIT))&('$G(PSOERR)) K ^TMP($J,"PSOINT") W:$E(IOST)="P" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
31 .W !!,"** END OF REPORT **"
32 .W !! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
33 ;
34HD ;PRINT PAGE HEADING
35 W:$G(PAGE)'=1!($E(IOST)="C") @IOF W !,"INTERNET REFILL REPORT BY PATIENT - "_$S(PSODS="D":"Detail",1:"Summary")
36 W ?45,$TR(RDATE,"@"," ") W ?$S($G(PSORMZ):120,1:68),"PAGE: "_PAGE
37 W !,$S(PSODS="D":"Not Filled - ",1:"")_"For date range "_$G(PSOSDX)_" through "_$G(PSOEDX)_" for "_$P(^PS(59,DIV,0),"^")
38 I PSODS="S" W !!,"Patient",?35,"Filled",?48,"Not Filled",?63,"Total"
39 E W !!,"Patient",?28,"Rx #",?42,"Date" W:'$G(PSORMZ) ! W ?$S($G(PSORMZ):56,1:20),"Reason"
40 W !,LINE S PAGE=PAGE+1
41 Q
42PRT ;PRINT REPORT
43 I PSODS="S" S PSOT(1)=PSOT(1)+PSO(1),PSOT(2)=PSOT(2)+PSO(2)
44 S EOFLAG=0 I ($Y+5)>IOSL D Q:PSOQUIT
45 .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
46 .I $E(IOST)'="C" S EOFLAG=1 D HD
47 I PSODS="S" W !,$P(PSOAB,"^",2)_" ("_$P(PSOAB,"^",3)_")",?35,PSO(1),?48,PSO(2),?63,(PSO(1)+PSO(2)) Q
48 S PNODE=$G(^PS(52.43,$P(PSOAB,"^"),0))
49 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
50 W !,$S(PSON=1:$E($P(PSOAB,"^",2),1,17)_" ("_$P(PSOAB,"^",3)_")",1:""),?28,$P(PNODE,"^",3),?42,PSOP5 W:'$G(PSORMZ) ! W ?$S($G(PSORMZ):56,1:20),$P(PNODE,"^",10)
51 Q
52FO I PSODS="S",$D(^TMP($J,"PSOINT",DIV))=11 W !!,"COUNT: ",?35,PSOT(1),?48,PSOT(2),?63,(PSOT(1)+PSOT(2)) G T1
53 Q:$D(^TMP($J,"PSOINT",DIV))'=11 D:PSODS="D"
54 .W !!,"Total transactions for date range "_$G(PSOSDX)_" through "_$G(PSOEDX)_" = "_PSO("TOT")
55T1 I $E(IOST)="C" W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
56 Q
57FO1 I $D(^TMP($J,"PSOINT",DIV))=11 W !," Total transactions for patient = ",PSOPAT
58 Q
59SET I PSODS="D",($P(PSAB,"^",6)=1) Q
60 S DFN=PSODFN D DEM^VADPT
61 S ^TMP($J,"PSOINT",PSORXDV,VADM(1),PSORXIN,PSOSD1)=PSA_"^"_VADM(1)_"^"_VA("BID")
62 Q
63SUMM ;
64 S DIV=0 F S DIV=$O(^TMP($J,"PSOINT",DIV)) Q:'DIV!(PSOQUIT) S (PSO(1),PSO(2),PSOT(1),PSOT(2))=0 D D FO W:$E(IOST)="P" @IOF
65 .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
66 ..K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR W @IOF
67 .S PSONAM="" F S PSONAM=$O(^TMP($J,"PSOINT",DIV,PSONAM)) Q:PSONAM=""!(PSOQUIT) S (PSO(1),PSO(2))=0 D D PRT
68 ..S PSORXIN=0 F S PSORXIN=$O(^TMP($J,"PSOINT",DIV,PSONAM,PSORXIN)) Q:'PSORXIN!(PSOQUIT) S PSDD=0 F S PSDD=$O(^TMP($J,"PSOINT",DIV,PSONAM,PSORXIN,PSDD)) Q:'PSDD!(PSOQUIT) D
69 ...S PSOAB=$G(^TMP($J,"PSOINT",DIV,PSONAM,PSORXIN,PSDD))
70 ...S PNODE=$G(^PS(52.43,$P(PSOAB,"^"),0)),PSOP6=$P(PNODE,"^",6),PSO(PSOP6)=PSO(PSOP6)+1
71 Q
Note: See TracBrowser for help on using the repository browser.