source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUUD3.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1PSUUD3 ;BIR/TJH/,PDW - PBM UNIT DOSE OUTPUT ;25 AUG 1998
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3EN ;
4 ;
5NONE ; send "no data" message if nothing collected
6 I '$D(^XTMP(PSUUDSUB,"DETAIL")) D Q
7 .S ^XTMP("PSU_"_PSUJOB,"PSUNONE","UD")=""
8 .S NONE=1
9 .K PSUXMY,^XTMP(PSUUDSUB,"RECORDS")
10 .M PSUXMY=PSUXMYS1
11 .I PSUMASF!PSUPBMG M PSUXMY=PSUXMYH
12 .S ^XTMP(PSUUDSUB,"RECORDS",PSUSNDR,1)="No data to report"
13 .D EN^PSUUD4(.PSUMSGT)
14 .S ^XTMP("PSU_"_PSUJOB,"CONFIRM",PSUSNDR,PSUOPTN,"L")=0
15 .S ^XTMP("PSU_"_PSUJOB,"CONFIRM",PSUSNDR,PSUOPTN,"M")=1
16NONEQ ; routine does not pass this point if "no data" due to Quit at NONE+1
17 ;
18MMFULL ; send full detail to Hines if Master File update was selected
19 K PSUXMY,^XTMP(PSUUDSUB,"RECORDS")
20 M PSUXMY=PSUXMYH
21 M ^XTMP(PSUUDSUB,"RECORDS")=^XTMP(PSUUDSUB,"DETAIL")
22 D EN^PSUUD6 ;AMIS Summary report
23 I 'PSUSMRY D
24 .D EN^PSUUD4(.PSUMSGT)
25 .M ^XTMP("PSU_"_PSUJOB,"CONFIRM")=PSUMSGT
26 ;
27 ;
28MMSSUM ; statistical summary
29 N PSUUDFLG S PSUUDFLG=1 ;Flag for summary reports
30 S $P(SPACES," ",81)="",$P(DASH,"-",81)=""
31 K PSUXMY,^XTMP(PSUUDSUB,"RECORDS"),^XTMP(PSUUDSUB,"STATSUM")
32 M PSUXMY=PSUXMYS1
33 S PSUFACN=""
34 F S PSUFACN=$O(^XTMP(PSUUDSUB,"DIS",PSUFACN)) Q:PSUFACN="" D
35 .S PSUF2=$G(^XTMP(PSUUDSUB,"SSN",PSUFACN)) ; Total patients
36 .S PSUDIV=PSUFACN D GETDIV^PSUV3 I PSUDIVNM'="" D
37 ..S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVNM)=PSUF2
38 .I PSUDIVNM="" S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIV)=PSUF2
39 ;
40MMDRUG ; summary by drug
41 K ^XTMP(PSUUDSUB,"RECORDS"),^XTMP(PSUUDSUB,"DRUGSUM")
42 Q:PSUSMRY ;Don't print if user wants summary only
43 ;
44 K PSUXMY
45 M PSUXMY=PSUXMYS2
46 S PSUFACN=""
47 F S PSUFACN=$O(^XTMP(PSUUDSUB,"DRUG",PSUFACN)) Q:PSUFACN="" D
48 .S X="Unit Dose Statistical Data for "_PSURP("START")_" through "_PSURP("END")
49 .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,1)=X
50 .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,2)=" "
51 .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,3)=" "
52 .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,4)=$E(SPACES,1,50)_"Total"_$E(SPACES,1,11)_"Total"
53 .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,5)=$E(SPACES,1,50)_"Dispensed"_$E(SPACES,1,7)_"Dispensed"
54 .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,6)="Drug Name"_$E(SPACES,1,41)_"Units"_$E(SPACES,1,11)_"Cost"
55 .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,7)=$E(DASH,1,75)
56 .S PSUX="",PSULN=7,PSUGTC=0,PSUGTU=0
57 .F S PSUX=$O(^XTMP(PSUUDSUB,"DRUG",PSUFACN,PSUX)) Q:PSUX="" D
58 ..S PSUR=^XTMP(PSUUDSUB,"DRUG",PSUFACN,PSUX)
59 ..S PSUTU=$P(PSUR,U,1),PSUPPU=$P(PSUR,U,2),PSUNON=$P(PSUR,U,3),PSUNFI=$P(PSUR,U,4)
60 ..S PSUTC=PSUTU*PSUPPU,PSUGTC=PSUGTC+PSUTC,PSUGTU=PSUGTU+PSUTU
61 ..S PSUDN=$E(PSUX,1,40)_" "_$S(PSUNON="N/F":"*",1:"")_$S(PSUNFI=0:"#",1:"")
62 ..S PSULN=PSULN+1
63 ..S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSULN)=$E(PSUDN_SPACES,1,45)_$J(PSUTU,12,2)_" "_$J(PSUTC,12,2)
64 .S PSULN=PSULN+1
65 .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSULN)=$E(DASH,1,75)
66 .S PSULN=PSULN+1
67 .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSULN)="Totals:"_$E(SPACES,1,38)_$J(PSUGTU,12,2)_" "_$J(PSUGTC,12,2)
68 .S PSULN=PSULN+1
69 .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSULN)=" "
70 .S PSULN=PSULN+1
71 .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSULN)="* Non-Formulary"
72 .S PSULN=PSULN+1
73 .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSULN)="# Not on National Formulary"
74 M ^XTMP(PSUUDSUB,"RECORDS")=^XTMP(PSUUDSUB,"DRUGSUM")
75 D EN^PSUUD4(.PSUMSGT)
76 K ^XTMP(PSUUDSUB,"RECORDS")
77 ;
78 Q
Note: See TracBrowser for help on using the repository browser.