source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOFTDR.m@ 1119

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

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1PSOFTDR ;BHAM/MHA - free text dosage entry report ; 06/14/01
2 ;;7.0;OUTPATIENT PHARMACY;**80,90**;DEC 1997
3 ;External Ref. ^PSDRUG( is supp. by DBIA# 221
4 ;External reference to ^PS(50.607 supported by DBIA 2221
5BEG W !!,"This option provides a list of drugs for those prescriptions"
6 W !,"where the dosage field has a free text entry.",!
7 W ! S %DT(0)=-DT,%DT("A")="Beginning Date: ",%DT="APE" D ^%DT Q:Y<0!($D(DTOUT)) S (%DT(0),BEGDATE)=Y
8 W ! S %DT("A")="Ending Date: " D ^%DT Q:Y<0!($D(DTOUT)) S ENDDATE=Y D:+$E(Y,6,7)=0 DTC
9DEV K %ZIS,IOP,POP,ZTSK S PSOION=ION,%ZIS="QM" D ^%ZIS K %ZIS I POP S IOP=PSOION D ^%ZIS K IOP,PSOION W !,"Please try later!" Q
10 K PSOION I $D(IO("Q")) D Q
11 .S ZTDESC="Rx free text dosage report",ZTRTN="START^PSOFTDR" F G="BEGDATE","ENDDATE" S:$D(@G) ZTSAVE(G)=""
12 .K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print !!" K ZTSK
13START N PSOPG,PSODT,PSORXN,PSORF,PSODS,PSODR,PSODRN,PSORX0,PSOPR,PSOCNT,PSOJ,PSOL,PSOY,PSOC,TY,PSO2,PSOU
14 S TY="PSOFT" K ^TMP(TY,$J)
15 S PSODT=BEGDATE-.01,Q=0 W:$E(IOST)="C" !!!,"Hmm.. working hard - please wait.."
16ST1 F S PSODT=$O(^PSRX("AD",PSODT)) Q:'PSODT!(PSODT>(ENDDATE_".999999")) D Q:$D(DIRUT)
17 .S PSORXN=0 F S PSORXN=$O(^PSRX("AD",PSODT,PSORXN)) Q:'PSORXN D Q:$D(DIRUT)
18 ..S PSORF="" F S PSORF=$O(^PSRX("AD",PSODT,PSORXN,PSORF)) Q:PSORF="" D:'PSORF Q:$D(DIRUT)
19 ...Q:'$D(^PSRX(PSORXN,0)) S PSORX0=^(0),PSODR=+$P(PSORX0,"^",6)
20 ...Q:'$D(^PSDRUG(PSODR,0))
21 ...I $E(IOST)="C" S Q=Q+1 W:'(Q#50) "."
22 ...I $O(^PSRX(PSORXN,6,0)) S PSOJ=0 F S PSOJ=$O(^PSRX(PSORXN,6,PSOJ)) Q:'PSOJ I $P(^(PSOJ,0),"^")]"" S PSODS=$P(^(0),"^"),PSO2=$P(^(0),"^",2),PSOU=$P(^(0),"^",3) D:PSO2 FT1 D:'PSO2 FT2
23 U IO S PSOPG=1,PSOCNT=0 D HD
24 I '$D(^TMP(TY,$J,"B")) W !!,"***** No Records were found for this period *****",!! G EXIT
25DET S J="" F S J=$O(^TMP(TY,$J,"B",J)) Q:J="" D Q:$D(DIRUT)
26 .S L="",Q=0 F S L=$O(^TMP(TY,$J,"B",J,L)) Q:L="" D Q:$D(DIRUT)
27 ..S PSODR=$O(^TMP(TY,$J,"B",J,L,0))
28 ..W:'Q !,$E(J,1,30)_" ("_PSODR_")"
29 ..W:$L(L)>35 ?40,$E(L,1,35),!,?40,$E(L,36,99) W:$L(L)'>35 ?40,L
30 ..W ?75,+^TMP(TY,$J,"B",J,L,PSODR,0),!," " S Q=Q+1
31 ..S M=0 F S M=$O(^TMP(TY,$J,"B",J,L,PSODR,M)) Q:'M!($D(DIRUT)) S YY=^TMP(TY,$J,"B",J,L,PSODR,M) D
32 ...F I=1:1:$L(YY,";") S XX=$P(YY,";",I) D Q:$D(DIRUT)
33 ....S T=$P(^VA(200,+XX,0),"^")_":"_$P(XX,",",2)_" " W:($X+$L(T))>78 !," "
34 ....W T D HD:($Y+5)>IOSL Q:$D(DIRUT)
35 ...Q:$D(DIRUT) D HD:($Y+5)>IOSL
36 ..Q:$D(DIRUT)
37 ..W ! D HD:($Y+5)>IOSL
38EXIT W ! D ^%ZISC K DIR,DTOUT,DUOUT,DIROUT,DIRUT,^TMP(TY,$J),I,J,K,L,M,Q,T,X,XX,Y,YY,BEGDATE,ENDDATE
39 S:$D(ZTQUEUED) ZTREQ="@"
40 Q
41FT1 ;check for possible dosages. If does not match report
42 S PSOC=1,PSOL=0 F S PSOL=$O(^PSDRUG(PSODR,"DOS1",PSOL)) Q:'PSOL S:$P(^(PSOL,0),"^",2)=PSODS PSOC=0
43 I PSOC S PSODS=PSODS_$S(PSOU:$P($G(^PS(50.607,PSOU,0)),"^"),1:"") D PRD
44 Q
45FT2 ;check for local possible dosages. If does not exist report
46 I '$D(^PSDRUG(PSODR,"DOS2")) D PRD Q
47 S PSOC=1,PSOL=0 F S PSOL=$O(^PSDRUG(PSODR,"DOS2",PSOL)) Q:'PSOL S:$P(^(PSOL,0),"^")=PSODS PSOC=0
48 D:PSOC PRD
49 Q
50PRD ;
51 S PSODRN=$P(^PSDRUG(PSODR,0),"^"),PSOPR=+$P(PSORX0,"^",4)
52 Q:'PSOPR
53 I $D(^TMP(TY,$J,"B",PSODRN,PSODS,PSODR,0)) D
54 .S ^TMP(TY,$J,"B",PSODRN,PSODS,PSODR,0)=^TMP(TY,$J,"B",PSODRN,PSODS,PSODR,0)+1
55 E S ^TMP(TY,$J,"B",PSODRN,PSODS,PSODR,0)=1
56 I $O(^TMP(TY,$J,"B",PSODRN,PSODS,PSODR,0)) D GETR
57 E S ^TMP(TY,$J,"B",PSODRN,PSODS,PSODR,1)=PSOPR_",1"
58 Q
59GETR ;
60 S (J,K)=0
61 F S K=$O(^TMP(TY,$J,"B",PSODRN,PSODS,PSODR,K)) Q:'K!(J) D
62 .S Y=^TMP(TY,$J,"B",PSODRN,PSODS,PSODR,K)
63 .F I=1:1 S X=$P(Y,";",I) Q:'X!(J) D
64 ..I PSOPR=+X S J=$P(X,",",2)+1,$P(^TMP(TY,$J,"B",PSODRN,PSODS,PSODR,K),";",I)=PSOPR_","_J Q
65 .Q:J
66 .I $L(Y)+$L(";"_(PSOPR_",1"))<246 S ^TMP(TY,$J,"B",PSODRN,PSODS,PSODR,K)=Y_";"_(PSOPR_",1")
67 .E S ^TMP(TY,$J,"B",PSODRN,PSODS,PSODR,K+1)=PSOPR_",1",J=1
68 Q
69HD ;
70 I PSOPG>1,$E(IOST)="C" S DIR(0)="E",DIR("A")=" Press Return to Continue or ^ to Exit" D ^DIR K DIR
71 Q:$D(DIRUT)
72 I PSOPG=1,$E(IOST)="C" W @IOF
73 W:PSOPG>1 @IOF W "Run Date: " S Y=DT D DT^DIO2 W ?72,"Page "_PSOPG S PSOPG=PSOPG+1
74 W !,?20,"Free Text Dosage Entry Report",!,?15,"for the Period: "
75 S Y=BEGDATE D DT^DIO2 W " to " S Y=ENDDATE D DT^DIO2
76 W !,"Drug",?40,"Free Text Entry",?74,"Count",!," Provider:Count"
77 W ! F Y=1:1:79 W "-"
78 W ! Q
79DTC N DD,MM S DD=31,MM=+$E(Y,4,5) I MM'=12 S MM=MM+1,MM=$S(MM<10:"0",1:"")_MM,X2=Y,X1=$E(Y,1,3)_MM_"00" D ^%DTC S DD=X
80 S ENDDATE=Y+DD
81 Q
Note: See TracBrowser for help on using the repository browser.