source: WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAOP2.m@ 1046

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

initial load of WorldVistAEHR
File size: 5.2 KB
RevLine 
[613]1PSAOP2 ;BIR/LTL-Outpatient Dispensing (All Drugs) ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,15**; 10/24/97
3 ;This routine gathers outpatient dispensing for all drugs in a location
4 ;from the PRESCRIPTION file. If present, the last outpatient dispensing
5 ;date is used as a starting point. Otherwise the user selected date is
6 ;used.
7 ;
8 ;References to ^PSDRUG( are covered by IA #2095
9 ;References to ^PSRX( are covered by IA #254
10 ;
11 D PSAWARN^PSAPSI I $D(PSAQUIT) K PSAQUIT Q
12 D Q
13 S $P(PSALN,"-",79)="-"
14LOOK D OP^PSADA
15 G:'$G(PSALOC) Q W !,$G(PSALOCN)
16 S DIR(0)="Y",DIR("A")="OK",DIR("B")="Yes",DIR("?")="Answering no will allow you to change Location." D ^DIR K DIR S:$D(DIRUT) PSAOUT=1 G:$D(DIRUT) Q I Y=0 K PSALOC D OP^PSADA G:'$G(PSALOC) Q
17 I '$O(^PSD(58.8,+PSALOC,1,0)) W !!,"There are no drugs in ",PSALOCN,!! G Q
18 D NOW^%DTC S PSADT=X,X="T-6000" D ^%DT S PSADT(1)=Y,(PSAPG,PSAOUT,PSADRUG)=0
19 S DIR(0)="D^"_PSADT(1)_":"_PSADT_":AEX",DIR("A")="How far back would you like to collect",DIR("B")="T-6000" D ^DIR K DIR S (PSADT(2),PSADT(22),PSAR,PSAP,PSAN)=Y,(PSADT(3),PSAR(1),PSAP(1),PSAN(1))=0 I Y<1 S PSAOUT=1 Q
20 S (PSAOP,PSAS)=$P($G(^PSD(58.8,+PSALOC,0)),U,10)
21 S DIR(0)="Y",DIR("A")="Would you like a report of daily dispensing totals",DIR("B")="Yes" D ^DIR K DIR S:$D(DIRUT) PSAOUT=1 G:$D(DIRUT) STOP
22 I Y=1 S PSADAILY=1
23DEV K IO("Q") K %ZIS,IOP,POP S %ZIS="Q" I Y=1 W ! D ^%ZIS
24 I $G(POP) W !,"NO DEVICE SELECTED OR ACTION TAKEN!" S PSAOUT=1 G Q
25 I $D(IO("Q")) K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK S ZTRTN="LUP^PSAOP2",ZTDESC="Drug Acct-Daily Drug Dispensing Log",ZTSAVE("PSA*")="" D ^%ZTLOAD G Q
26 ;
27LUP ;Starting point
28 S PSADRUG=0 W @IOF
29PROCESS F PSAHOW="AL","AJ","AM","AN" S PSADT=PSADT(22)-.00001 D LOOP
30 G DONE
31 ;
32LOOP ;
33 I $E(IOST)="C" W !,"Processing ",$S(PSAHOW="AL":"dispensing",PSAHOW="AJ":"returns",PSAHOW="AM":"partials",1:"returns")
34 ;
351 S PSADT=$O(^PSRX(PSAHOW,PSADT)) Q:PSADT'>0 K PSAIEN
362 S PSAIEN=$S('$D(PSAIEN):$O(^PSRX(PSAHOW,PSADT,0)),1:$O(^PSRX(PSAHOW,PSADT,PSAIEN))) G 1:PSAIEN'>0 K PSARX
373 S PSARX=$S('$D(PSARX):$O(^PSRX(PSAHOW,PSADT,PSAIEN,"")),1:$O(^PSRX(PSAHOW,PSADT,PSAIEN,PSARX))) G 2:PSARX="" W "."
38 I $D(^PSRX("AR",PSADT,PSAIEN,PSARX)) G 3
39 S PSADRUG=$P($G(^PSRX(PSAIEN,0)),"^",6) I $G(PSADRUG)="" G 3
40 S PSADRUGN=$P($G(^PSDRUG(PSADRUG,0)),"^")
41 I '$D(^PSD(58.8,PSALOC,1,PSADRUG)) G 3
42 I $P($G(^PSRX(PSAIEN,2)),"^",9)'=PSAS G 3
43 ;
44 S PSAQTY=$S(+PSARX:$P($G(^PSRX(PSAIEN,1,PSARX,0)),"^",4),1:$P($G(^PSRX(PSAIEN,0)),"^",7)) ;either refill or fill
45 ;
46 I '$D(^TMP("PSA",$J,PSADRUGN,$E(PSADT,1,7))) S ^TMP("PSA",$J,PSADRUGN,$E(PSADT,1,7))=""
47 S DATA=^TMP("PSA",$J,PSADRUGN,$E(PSADT,1,7))
48 S $P(^TMP("PSA",$J,PSADRUGN,$E(PSADT,1,7)),"^",1)=$S(PSAHOW="AL":$P(DATA,"^")+PSAQTY,PSAHOW="AJ":$P(DATA,"^")-PSAQTY,PSAHOW="AM":$P(DATA,"^")+$P($G(^PSRX(PSAIEN,"P",PSARX,0)),"^",4),1:$P(DATA,"^")-$P($G(^PSRX(PSAIEN,"P",PSARX,0)),"^",4))
49 ;
50 S $P(^TMP("PSA",$J,PSADRUGN,$E(PSADT,1,7)),"^",$S(PSAHOW="AL":2,PSAHOW="AJ":4,PSAHOW="AM":6,1:8))=PSAIEN
51 S $P(^TMP("PSA",$J,PSADRUGN,$E(PSADT,1,7)),"^",$S(PSAHOW="AL":3,PSAHOW="AJ":5,PSAHOW="AM":7,1:9))=PSARX
52 G 3
53 ;
54DONE ;All dispensing data retrieved, print it.
55 D HEADER
56 S XX=0 F S XX=$O(^PSD(58.88,PSALOC,1,XX)) Q:XX'>0 S XXX=$P($G(^PSDRUG,XX),"^") I '$D(^TMP("PSA",$J,XXX)) S ^TMP("PSA",$J,XXX)=0
57 S PSADRUGN=0
584 S PSADRUGN=$O(^TMP("PSA",$J,PSADRUGN)) G STOP:PSADRUGN=""
59 S PSADRUG=$O(^PSDRUG("B",PSADRUGN,0))
60 I $Y>(IOSL+4) D HEADER G Q:$G(PSAOUT)=1
61 I '$D(^TMP("PSA",$J,PSADRUGN)) W !,PSADRUGN,?36,"has not been dispensed since: " S Y=$S($P($G(^PSD(58.8,PSALOC,1,PSADRUG,6)),"^"):$P(^PSD(58.8,PSALOC,1,PSADRUG,6),"^"),1:PSADT(22)) X ^DD("DD") W Y,"." G 4
62 W !,PSADRUGN
63 K PNTDATA,PSADATE,PSATTLP,DAYS
645 S PSADATE=$S('$D(PSADATE):$O(^TMP("PSA",$J,PSADRUGN,0)),1:$O(^TMP("PSA",$J,PSADRUGN,PSADATE))) G PNTQ:PSADATE'>0 S DATA=^TMP("PSA",$J,PSADRUGN,PSADATE) S DAYS=$G(DAYS)+1
65 S Y=PSADATE X ^DD("DD") S PRINTDT=Y
66 S PSAQTY=$P(DATA,"^")
67 ;
68 S PSAPRICE=$P($G(^PSDRUG(PSADRUG,660)),"^",6) ;Price per dispense Unit
69 S PSADISPU=$P($G(^PSDRUG(PSADRUG,660)),"^",8) ;Dispense Unit
70 ;
71 S Y=PSAQTY,X2=0 D COMMA^%DTC S PNTQTY=Y
72 S TTLQTY=$G(TTLQTY)+PSAQTY ;total quantity
73 S PSAPRICE(2)=$G(PSAPRICE(2))+(PSAPRICE*PSAQTY) ;Total Cost
74 S Y=PSAPRICE,X2="3$" D COMMA^%DTC S PNTPRICE=Y
75 S Y=PSAPRICE*PSAQTY,X2="3$" D COMMA^%DTC S PSAQP=Y
76 I $D(PSADAILY) W !,$G(DAYS),?3,PRINTDT,?23,PNTQTY,?40,PNTPRICE,"/",PSADISPU,?63,PSAQP K PSAQP G 5
77 G 5
78 ;
79PNTQ W !,PSALN,!,DAYS," DAY TOTALS: " S Y=TTLQTY,X2="2$" D COMMA^%DTC W Y S Y=PSAPRICE(2),X2="2$" D COMMA^%DTC W ?63,Y
80 K TTLQTY,PSAPRICE,PSAQTY,PNTQTY
81 G 4
82 ;
83HEADER I $E(IOST,1,2)'="P-",$G(PSAPG) S DIR(0)="E" D ^DIR K DIR I '+Y S PSAOUT=1 Q
84 I $$S^%ZTLOAD S PSAOUT=1 Q
85 W:$Y @IOF S PSAPG=$G(PSAPG)+1 W ?2,"DAILY DISPENSING TOTALS FOR ",$E($G(PSALOCN),1,30),?70,"PAGE: ",PSAPG,!,PSALN,!
86 W " DATE",?23,"TOTAL",?45,"$/DISP",?67,"TOTAL",!," DISPENSED",?23,"DISP",?46,"UNIT",?68,"COST",!,PSALN
87 Q
88Q D ^%ZISC K PNTDATA,PNTDATE,PNTPRICE,PNTQTY,POP,PRINTDT,PSA,PSADAILY,PSADATE,PDADISPU,PSADR,PSADREC,PSADRUG,PSACNT,PSAPG,PSAOSIT
89 K PSADRUGN,PSADT,PSAG,PSAHOW,PSAIEN,PSALN,PSALOC,PSALOCN,PSAN,PSAOP,PSAOUT,PSAP,PSAPRICE,PSAQ,PSAQTY,PSAR,PSAREC,PSARELDT,PSARX,PSAS,PSAT,PSATTLP,TTLQTY,^TMP("PSA",$J),^TMP($J)
90 Q
91STOP W:$E(IOST)'="C" @IOF
92 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")
93 I $O(^TMP("PSA",$J,0)) D ^PSAOP4
94 G Q
Note: See TracBrowser for help on using the repository browser.