source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAMON.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1PSAMON ;BIR/LTL,JMB-Monthly Summary ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15**; 10/24/97
3 ;
4 ;References to ^PSDRUG( are covered by IA #2095
5 ;
6 ;This routine allows the user to print a report per pharmacy location
7 ;of the drug, beginning balance, ending balance, total received, total
8 ;dispensed, and total adjustments. Specific or all drugs can be selected
9 ;for the report. The report can be sent to the screen and printer.
10 ;
11LOC K ^TMP("PSAD",$J) S PSAHIS=1,(PSACNT,PSAOUT)=0
12 D LOC^PSALEVRP I $G(DIRUT) S PSAOUT=1 G END1
13 S PSACHK=$O(PSALOC(""))
14 I 'PSACNT,PSACHK="" W !,"There are no active pharmacy locations." G END1
15 I PSACNT=1 D
16 .S PSALOCN=$O(PSALOCA("")),PSALOC=$O(PSALOCA(PSALOCN,0)),PSALOC(PSALOCN,PSALOC)=PSALOCA(PSALOCN,PSALOC),PSAMENU(1,PSALOCN,PSALOC)="",PSASEL=1,PSATOT=0
17 .W:$L(PSALOCN)>76 !,$P(PSALOCN,"(IP)",1)_"(IP)",!?17,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<77 !,PSALOCN
18 D DT^DICRW S Y=$E(DT,1,5) X ^DD("DD") S PSAMON=Y
19 S DIR(0)="D:AEP",DIR("A")="Select month and year: ",DIR("B")=PSAMON D ^DIR K DIR I $D(DIRUT) S PSAOUT=1 G END1
20 S PSAMON=+($E(Y,1,5)*100),PSA=0,Y=PSAMON X ^DD("DD") S PSAMONN=Y,PSACNT=0
21 W ! F PSAPC=1:1 S PSAPICK=+$P(PSASEL,",",PSAPC) Q:'PSAPICK D
22 .S PSALOCN="" F S PSALOCN=$O(PSAMENU(PSAPICK,PSALOCN)) Q:PSALOCN=""!(PSAOUT) S PSALOC=0 F S PSALOC=$O(PSAMENU(PSAPICK,PSALOCN,PSALOC)) Q:'PSALOC!(PSAOUT) D
23 ..S PSACNT=PSACNT+1
24 ..W @IOF W:$L(PSALOCN)>79 !,$P(PSALOCN,"(IP)",1)_"(IP)",!?17,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<80 !,PSALOCN
25 ..I '$O(^PSD(58.8,+PSALOC,1,0)) W !!,"There are no drugs in ",$G(PSALOCN) S PSAOUT=1 Q
26 ..D DRUG Q:PSAOUT
27 I PSACNT=1!(PSAOUT) S PSATOT=0 G DEV
28 W ! S DIR(0)="Y",DIR("A")="Print summary report",DIR("B")="Y",DIR("?",1)="Enter YES to print a report of the total figures for each selected",DIR("?",2)="drug in all selected pharmacy locations."
29 S DIR("?")="Enter NO to print only the report per pharmacy location.",DIR("??")="^D SUMHELP^PSAMON" D ^DIR K DIR G:$G(DIRUT) END1 S PSATOT=+Y
30 G DEV
31 ;
32DRUG W !!,"Select one, several, or ^ALL drugs.",!
33 S PSADONE=0,DIC="^PSD(58.8,+PSALOC,1,",DIC(0)="AEMQ",DIC("A")="Select Drug: "
34 F D ^DIC S:$G(DTOUT)!(X="^") PSAOUT=1 Q:Y=-1&(X'="^A")&(X'="^ALL") D Q:PSAOUT!(PSADONE)
35 .I X'="^A",X'="^ALL",'+Y S PSAOUT=1 Q
36 .I X="^A"!(X="^ALL") D Q
37 ..W !,"Please wait." S PSA=0 F S PSA=$O(^PSD(58.8,+PSALOC,1,PSA)) Q:'PSA S:$G(^PSD(58.8,+PSALOC,1,+PSA,5,PSAMON,0))'="" ^TMP("PSAD",$J,PSALOCN,PSA)="" W:(PSA#500) "."
38 ..D END^PSAPROC S PSADONE=1
39 .I +Y,$G(^PSD(58.8,+PSALOC,1,+Y,5,PSAMON,0))="" W !!,"Sorry, no history for that month." Q
40 .S ^TMP("PSAD",$J,PSALOCN,+Y)=""
41 K DIC
42 Q
43 ;
44DEV ;asks device and queueing info
45 S PSA=$O(^TMP("PSAD",$J,"")) G:PSA=""!(PSAOUT) END1
46 K IO("Q") N IOP,POP S %ZIS="Q" W ! D ^%ZIS I POP W !,"NO DEVICE SELECTED OR OUTPUT PRINTED!" G END1
47 I $D(IO("Q")) D G END1
48 .K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
49 .S ZTRTN="START^PSAMON",ZTDESC="Drug Accountability Monthly Summary Report",ZTSAVE("PSA*")="",ZTSAVE("^TMP(""PSAD"",$J,")=""
50 .D ^%ZTLOAD,HOME^%ZIS
51 ;
52START ;compiles and prints output
53 S PSARPDT=$E($$HTFM^XLFDT($H),1,12),PSADT=$P(PSARPDT,".")
54 S PSARPDT=$E(PSADT,4,5)_"/"_$E(PSADT,6,7)_"/"_$E(PSADT,2,3)_"@"_$P(PSARPDT,".",2)
55 S (PSAOUT,PSAPG)=0,$P(PSADLN,"=",81)="",$P(PSASLN,"-",81)="",PSATABH=(66-($L(PSAMONN)+$L($E(PSALOCN,1,20))))/2
56 K ^TMP("PSAMON",$J)
57LOOP S PSALOCN="" F S PSALOCN=$O(^TMP("PSAD",$J,PSALOCN)) Q:PSALOCN=""!(PSAOUT) D
58 .D HEADER S PSALOC=$O(PSALOC(PSALOCN,0))
59 .F PSA=0:0 S PSA=+$O(^TMP("PSAD",$J,PSALOCN,PSA)) Q:'PSA D
60 ..I $D(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)) S ^TMP("PSAMON",$J,$P($G(^PSDRUG(PSA,0)),U))=PSA
61 .D PRINT K ^TMP("PSAMON",$J)
62 .I 'PSAOUT D:$Y+4>IOSL HEADER Q:PSAOUT W !,"TOTAL",?36,$J(PSATREC,6,0),?49,$J(PSATDISP,6,0),?60,$J(PSATADJ,6,0),?73,$J(PSATTF,6,0),!,PSADLN,!
63 G END
64 ;
65PRINT ;Prints in drug order.
66 S PSAX="",PSAX=$O(^TMP("PSAMON",$J,PSAX)) I PSAX="" W !!,"<< NO DATA WAS FOUND. >>" G END
67 S (PSATREC,PSATDISP,PSATADJ,PSATTF)=0
68 S PSADRUG="" F S PSADRUG=$O(^TMP("PSAMON",$J,PSADRUG)) Q:PSADRUG="" D Q:PSAOUT
69 .D:$Y+4>IOSL HEADER Q:PSAOUT S PSA=+^TMP("PSAMON",$J,PSADRUG)
70 .W !,PSADRUG
71 .W !?17 W:+$P($G(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,2) $J($P($G(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,2),6,0)
72 .I '+$P($G(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,2) S PSABAL=$P($G(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,4) W $J($S($G(PSABAL):PSABAL,1:0),6,0)
73 .W ?26,$J($S($P($G(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,4)]"":$P($G(^(0)),U,4),1:$P($G(^PSD(58.8,PSALOC,1,PSA,0)),U,4)),6,0)
74 .S PSAREC=$P($G(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,3),PSATREC=PSATREC+PSAREC W ?36,$J(PSAREC,6,0)
75 .S PSADISP=$P($G(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,6),PSATDISP=PSATDISP+PSADISP W ?49,$J(PSADISP,6,0)
76 .S PSADJ=$P($G(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,5),PSATADJ=PSATADJ+PSADJ W ?60,$J(PSADJ,6,0)
77 .S PSATF=$P($G(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,9),PSATTF=PSATTF+PSATF W ?73,$J(PSATF,6,0),!
78 .W:$O(^TMP("PSAMON",$J,PSADRUG))'="" PSASLN W:$O(^TMP("PSAMON",$J,PSADRUG))="" PSADLN
79 .I PSATOT D
80 ..S $P(^TMP("PSAG",$J,PSADRUG),"^")=$P($G(^TMP("PSAG",$J,PSADRUG)),"^")+PSAREC,$P(^(PSADRUG),"^",2)=$P($G(^(PSADRUG)),"^",2)+PSADISP
81 ..S $P(^TMP("PSAG",$J,PSADRUG),"^",3)=$P($G(^TMP("PSAG",$J,PSADRUG)),"^",3)+PSADJ,$P(^(PSADRUG),"^",4)=$P($G(^(PSADRUG)),"^",4)+PSATF
82 Q
83 ;
84END ;End of page
85 I $E($G(IOST))="C",'$G(PSAOUT) D
86 .S PSAS=22-$Y F PSASS=1:1:PSAS W !
87 .S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu." D ^DIR K DIR I $G(DIRUT) S PSAOUT=1
88 W @IOF I 'PSAOUT,PSATOT D ^PSAMON1
89 ;
90END1 ;Kills variables at end of report
91 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
92 K IO("Q"),^TMP("PSAD",$J),^TMP("PSAG",$J),^TMP("PSAMON",$J)
93 K %ZIS,DIC,DIRUT,DTOUT,DUOUT,PSA,PSABAL,PSACHK,PSACNT,PSACOMB,PSAD,PSADISP,PSADJ,PSADLN,PSADONE,PSADRUG,PSADT,PSAGADJ,PSAGDISP,PSAGREC,PSAGTF,PSAHIS
94 K PSAISIT,PSAISITN,PSALOC,PSALOCA,PSALOCN,PSAMENU,PSAMON,PSAMONN,PSANODE,PSANUM,PSAOSIT,PSAOSITN,PSAOUT,PSAPC,PSAPC1,PSAPCS,PSAPICK
95 K PSAREC,PSAPG,PSARPDT,PSAS,PSASEL,PSASLN,PSAS,PSASS,PSASUB,PSATABH,PSATADJ,PSATDISP,PSATF,PSATOT,PSATREC,PSATTF,PSAX,X,Y,ZTDESC,ZTRTN
96 Q
97 ;
98HEADER ;prints header info
99 I $E(IOST,1,2)="C-",PSAPG S DIR(0)="E" D Q:PSAOUT
100 .S PSAS=22-$Y F PSASS=1:1:PSAS W !
101 .S DIR(0)="E" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1
102 I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),U),"." S PSAOUT=1 Q
103 I $E(IOST,1,2)="C-" W @IOF
104 I $E(IOST)'="C",PSAPG W @IOF
105 S PSAPG=PSAPG+1 W:$E(IOST)'="C" !,PSARPDT W:$E(IOST,1,2)="C-" !
106 W ?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",?71,"PAGE: ",PSAPG
107 W !?22,"MONTHLY SUMMARY REPORT FOR "_PSAMONN
108 W:$L(PSALOCN)>79 !!,$P(PSALOCN,"(IP)",1)_"(IP)",!?17,$P(PSALOCN,"(IP)",2)
109 W:$L(PSALOCN)<80 !?((80-$L(PSALOCN))/2),PSALOCN
110 W !!,?14,"BEGINNING",?26,"ENDING",?36,"TOTAL",?48,"TOTAL",?60,"TOTAL",?72,"TOTAL"
111 W !,"DRUG",?16,"BALANCE",?25,"BALANCE",?34,"RECEIVED",?46,"DISPENSED",?58,"ADJUSTED",?69,"TRANSFERRED"
112 W !,PSADLN
113 Q
114 ;
115SUMHELP ;Extended help to 'Print summary report?'
116 W !!?5,"Enter YES to print a report with the totals for each selected drug",!?5,"in all the pharmacy locations that were selected. A total line will"
117 W !?5,"print for the total dispense units received, dispensed, adjusted,",!?5,"and transferrred during the selected month."
118 W !!?5,"Enter NO to print each pharmacy location's report without the",!?5,"summary report."
119 Q
Note: See TracBrowser for help on using the repository browser.