1 | PSUUD3 ;BIR/TJH/,PDW - PBM UNIT DOSE OUTPUT ;25 AUG 1998
|
---|
2 | ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
---|
3 | EN ;
|
---|
4 | ;
|
---|
5 | NONE ; 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
|
---|
16 | NONEQ ; routine does not pass this point if "no data" due to Quit at NONE+1
|
---|
17 | ;
|
---|
18 | MMFULL ; 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 | ;
|
---|
28 | MMSSUM ; 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 | ;
|
---|
40 | MMDRUG ; 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
|
---|