source: WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSADJR.m@ 660

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

initial load of WorldVistAEHR
File size: 4.2 KB
Line 
1PSADJR ;BIR/LTL,JMB-Balance Adjustments History ;8/21/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15**; 10/24/97
3 ;This routine reviews adjustment transactions for drugs.
4 ;
5 ;References to ^PSDRUG( are covered by IA #2095
6 ;
7LOOK ;Get locations to display
8 S (PSACNT,PSAOUT)=0 D ^PSAUTL3 G:PSAOUT EXIT
9 S PSACNT=0,PSACHK=$O(PSALOC(""))
10 I PSACHK="",'PSALOC W !,"There are no active pharmacy locations." G EXIT
11 I '$O(^PSD(58.8,PSALOC,1,0)) W !!,"There are no drugs in ",PSALOCN S PSAOUT=1 G EXIT
12 S DIC="^PSD(58.8,PSALOC,1,",DIC(0)="AEMQZ",DIC("A")="Select drug for history: ",DA(1)=PSALOC,DIC("W")="I $S($P($G(^(0)),U,14):$P($G(^(0)),U,14)'>DT,1:0) W $C(7),"" ***INACTIVE ***""" W !
13 D ^DIC K DIC S PSA=+Y I PSA<0 S PSAOUT=1 G EXIT
14 I '$O(^PSD(58.81,"F",+Y,"")) W !!,"There have been no adjustments for this drug.",!! S PSAOUT=1 G EXIT
15 W ! S DIR(0)="D:AEP",DIR("A")="How far back in time do you want to go: ",DIR("B")="T-6M" D ^DIR K DIR I $D(DIRUT) S PSAOUT=1 G EXIT
16 S PSAT=Y
17DEV ;asks device and queueing info
18 K IO("Q") N %ZIS,IOP,POP S %ZIS="Q" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR OUTPUT PRINTED!" S PSAOUT=1 G EXIT
19 I $D(IO("Q")) N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK S ZTRTN="START^PSADJR",ZTDESC="Drug Acct. - Drug adjustment review",ZTSAVE("PSA*")="" D ^%ZTLOAD,HOME^%ZIS S PSAOUT=1 G EXIT
20START ;compiles and prints output
21 D SITES^PSAUTL1 S PSALOCN=$P(^PSD(58.8,PSALOC,0),"^")_PSACOMB
22 S PSADRG=$P($G(^PSDRUG(PSA,0)),"^"),PSATAB=(80-$L(PSADRG))/2
23 N %DT,PSASLN,PSAPG,PSAOUT,PSARPDT S (PSAPG,PSAOUT)=0,$P(PSASLN,"-",81)="",Y=DT D DD^%DT S PSARPDT=Y,PSAR=0 D HEADER
24LOOP F S PSAR=+$O(^PSD(58.81,"F",PSA,PSAR)) Q:'PSAR I $P($G(^PSD(58.81,PSAR,0)),"^",4)'<PSAT,$P($G(^(0)),"^",2)=9!($P($G(^(0)),"^",2)=24),$P($G(^(0)),"^",3)=PSALOC D Q:PSAOUT
25 .I $P($G(^PSD(58.81,PSAR,0)),"^",2)=9,$Y+4>IOSL D HEADER Q:PSAOUT
26 .I $P($G(^PSD(58.81,PSAR,0)),"^",2)=24,$Y+6>IOSL D HEADER Q:PSAOUT
27 .S Y=$P($G(^PSD(58.81,PSAR,0)),"^",4) X ^DD("DD") W !,$E(Y,1,17)
28 .W:$P($G(^PSD(58.81,PSAR,0)),"^",2)=9 ?22 W:$P($G(^PSD(58.81,PSAR,0)),"^",2)=24 ?30 W $J($P($G(^PSD(58.81,PSAR,0)),"^",6),5,0)
29 .W ?37,$E($P($G(^VA(200,+$P($G(^PSD(58.81,PSAR,0)),"^",7),0)),"^"),1,20)
30 .I $P($G(^PSD(58.81,PSAR,0)),"^",2)=9 W !?37,$P($G(^PSD(58.81,PSAR,0)),"^",16),! Q
31 .S PSATRANL=$P($G(^PSD(58.81,+$P($G(^PSD(58.81,PSAR,0)),"^",17),0)),"^",3),PSAHOLD=PSALOC,PSAHOLDN=PSALOCN,PSALOC=PSATRANL
32 .I PSALOC="" W !?37,"TRANSFER DATA MISSING",! S PSALOC=PSAHOLD,PSALOCN=PSAHOLDN Q
33 .D SITES^PSAUTL1 S PSALOCN=$P(^PSD(58.8,PSALOC,0),"^")_PSACOMB
34 .I $P($G(^PSD(58.81,PSAR,0)),"^",6)<0 W:$L(PSALOCN)<42 !?37,"TO "_PSALOCN,! I $L(PSALOCN)>43 S PSATF="T" W !?37,"TO " D TRAN
35 .I $P($G(^PSD(58.81,PSAR,0)),"^",6)>0 W:$L(PSALOCN)<42 !?37,"FROM "_PSALOCN,! I $L(PSALOCN)>43 S PSATF="F" W !?37,"FROM " D TRAN
36 .S PSALOC=PSAHOLD,PSALOCN=PSAHOLDN
37EXIT W:$E(IOST)'="C" @IOF
38 I $E(IOST,1,2)="C-",'$G(PSAOUT) D
39 .S PSASS=21-$Y F PSAKK=1:1:PSASS W !
40 .S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu." D ^DIR W @IOF
41 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")
42 K DA,DIC,DIR,DIRUT,DTOUT,DUOUT,PSA,PSACHK,PSACNT,PSACOMB,PSADRG,PSAHOLD,PSAHOLDN,PSAKK,PSALOC,PSALOCA,PSALOCN,PSAOUT,PSAR,PSASEL,PSASS,PSAT,PSATAB,PSATF,PSATRAN,PSATRANL,X,Y
43 Q
44HEADER ;prints header info
45 I $E(IOST,1,2)="C-",PSAPG D Q:PSAOUT
46 .S PSASS=21-$Y F PSAKK=1:1:PSASS W !
47 .S DIR(0)="E" D ^DIR K DIR I 'Y S PSAOUT=1 Q
48 I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),"^"),"." S PSAOUT=1
49 W:$Y @IOF S PSAPG=PSAPG+1
50 W:$E(IOST)'="C" !,PSARPDT,?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE"
51 W !?22,"HISTORY OF ADJUSTMENTS AND TRANSFERS",?70,"PAGE: ",PSAPG,!
52 W:$L(PSALOCN)>76 ?2,$P(PSALOCN,"(IP)",1)_"(IP)",!?19,$P(PSALOCN,"(IP)",2),! W:$L(PSALOCN)<77 ?((80-$L(PSALOCN))/2),PSALOCN,!?PSATAB,PSADRG,!
53 I $P($G(^PSD(58.8,PSALOC,1,PSA,0)),"^",14),$P($G(^(0)),"^",14)'>DT W ?20,"** INACTIVE DRUG IN PHARMACY LOCATION **",!
54 W !,"DATE",?22,"ADJUST",?30,"TRANS",?37,"TRANSACTOR & REASON",!,PSASLN
55 Q
56TRAN ;
57 I $E(PSALOCN)="I" W $P($P(PSALOCN,":",2),"(IP)"),!
58 I $E(PSALOCN)="O" W $P($P(PSALOCN,":",2),"(OP)"),!
59 I $E(PSALOCN)="C" W "COMBINED:"_$P($P(PSALOCN,":",2),"(IP)",1)_"(IP)",! W:PSATF="T" ?49 W:PSATF="F" ?51 W $P($P(PSALOCN,":",2),"(IP)",2),!
60 Q
Note: See TracBrowser for help on using the repository browser.