source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRRXL.m@ 1259

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

initial load of WorldVistAEHR

File size: 5.1 KB
Line 
1IMRRXL ;HCIOFO/NCA/FT/FAI-List Data on Outpatient Pharmacy Utilization ;07/17/00 16:54
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**5**;Feb 09, 1998
3 ;[IMR PHARM UTILIZATION LIST] - Pharmacy Prescription Utilization Data
4ASK ; date range for report
5 D ^IMRDATE Q:$G(IMRHNBEG)=""
6 S IMRSD=IMRHNBEG,IMRED=IMRHNEND
7 ;K %DT S %DT="AQEXP",%DT("A")=" Start Date for Period: " D ^%DT K %DT G:Y'>0 KILL S IMRSD=Y,%DT="AQEXP",%DT("A")=" End Date for Period: " D ^%DT K %DT G:Y'>0 KILL S IMRED=Y
8 I IMRED<IMRSD W !,$C(7),"END CAN NOT BE BEFORE START",! G ASK
9 K DIR S DIR(0)="N^1:999999",DIR("A")="Minimum number of fills to display",DIR("B")=2,DIR("?")="This determines the minimum number of fills for which a drug will be displayed in the listing by order of number of fills"
10 D ^DIR G:$D(DIRUT) KILL S IMRN1=X
11ASK1 ; minimum $ cost to display
12 K DIR S DIR(0)="N^1:999999",DIR("A")="Minimum dollar cost of dispensed fills to be display",DIR("B")=10
13 S DIR("?")="This determines the minimum cost of fills for which a drug will be displayed in the listing order of cost of drug dispensed"
14 D ^DIR G:$D(DIRUT) KILL
15 S IMRN2=X
16ASK2 ; print report by category?
17 K DIR S DIR(0)="Y",DIR("A")="Print Data by CATEGORY as well as totals",DIR("B")="NO",DIR("?")="Answer YES to get separate listings of utilization by HIV CATEGORY as well as the total population."
18 D ^DIR G:$D(DIRUT) KILL
19 K DIR S IMR2C=Y
20 S IMRRMAX=0 I $D(^XUSEC("IMRMGR",DUZ)) D ASKQ G:$D(DIRUT) KILL
21 S X=$$RX1589^IMRUTL() ;get pharmacy archive date from File 158.9
22 I X,X'<IMRSD,X'>IMRED D ASKN I $D(DIRUT) D KILL Q ;use nat'l registry?
23 I X,X'<IMRSD,X>IMRED D ASKN I $D(DIRUT) D KILL Q ;use nat'l registry?
24 I $D(^XUSEC("IMRMGR",DUZ)) D IMRDEV^IMREDIT G:POP KILL ;select device
25 I '$D(^XUSEC("IMRMGR",DUZ)) D ^%ZIS G:POP KILL
26 I $D(IO("Q")) D SAVE G KILL
27 U IO D DQ D ^%ZISC K %ZIS,IOP G KILL
28SAVE ; ZTSAVE the variables used
29 S ZTRTN="DQ^IMRRXL",ZTIO=ION_";"_IOM_";"_IOSL,ZTSAVE("IMRSD")="",ZTSAVE("IMRED")="",ZTSAVE("IMRN1")="",ZTSAVE("IMRN2")="",ZTSAVE("IMRRMAX")="",ZTSAVE("IMR2C")="",ZTDESC="RX Utility Activity Report"
30 D ^%ZTLOAD K IO("Q"),ZTRTN,ZTIO,ZTSAVE,ZTDESC,ZTSK
31 G KILL
32 Q
33DQ ; start report
34 K ^TMP($J) S (IMRPG,IMRUT)=0
35 D NOW^%DTC S IMRDTE=%,Y=IMRDTE D DD^%DT S IMRDTE=Y ;get report date/time
36 S IMRDTE=$P(IMRDTE,":",1,2)
37 F IMRRL=0:0 S IMRRL=$O(^IMR(158,IMRRL)) Q:IMRRL'>0 S X=+^(IMRRL,0),IMR1C=+$P(^(0),U,42) D XOR^IMRXOR S IMRDFN=X I $D(^DPT(IMRDFN,0)) F IMR0C=IMR1C,"T" I IMR2C!(IMR0C="T") S IMR1C="C"_IMR0C S DFN=IMRDFN D NS^IMRCALL K DFN D C1
38 D ^IMRRXLA,RXPRNT^IMRRXL1
39 S:$D(ZTQUEUED) ZTREQ="@"
40 I '$D(^TMP($J)) W !!,"No data for this report.",!
41 D:'IMRUT EOP^IMRRXL1
42 Q
43KILL D ^%ZISC K %,%DT,%I,IMRPG,IMRDTE,IMRFLG,IMRTOT,IMRTOTL,DIR,DIRUT,DIROUT,IMRCL,IMRDFN,IMRDR,IMRI,IMRRI,IMRM,IMRN,IMRQ,IMRRP,IMRRX,IMRRXDR,IMRRXD1,IMRUT,IMRY,IMRDSUP,DISYS
44 K IMRSSN,IMRNAM,DFN,IMRF,IMRR,IMRV,IMRCOM,IMRTP,IMRCR,IMRCP,IMRYES,IMRDL,IMRFILDT,IMRCMAC,IMRCTOT,IMRJ,IMRNMAX,IMRRCOST,IMRX,C1,IMRCMAX
45 K IMRSD,IMRS1,IMRED,IMRX,IMRD,IMRRL,IMRXX1,IMRRXD,IMREF,IMREC,IMRUCST,IMREXP,IMRDST,IMRDU,IMRAR,IMRPS,IMRPAT,IMRCRX,IMRDRX,IMRTTP,IMRN1,IMRN2,IMR0C,IMR1C,IMR2C,IMRLBL,^TMP($J),VAERR,%T,C,I,J,K,M,N,IMRRMAX,POP,Q,X,X1,X2,Y,Z,Z1
46 Q
47C1 ; Get the Outpatient Pharmacy Data
48 S ^TMP($J,IMR1C,"PAT",IMRDFN)=""
49 F IMRRP=0:0 S IMRRP=$O(^PS(55,IMRDFN,"P","A",IMRRP)) Q:IMRRP'>0 I IMRRP'<IMRSD F IMRR=0:0 S IMRR=$O(^PS(55,IMRDFN,"P","A",IMRRP,IMRR)) Q:IMRR'>0 D RX^IMRUTL,C2 ;RX^IMRUTL gets outpatient pharmacy data
50 Q
51C2 ;
52 I 'IMRRXD1!('IMRXX1) Q ;check issue date and drug ien
53 S:'IMRUCST IMRUCST=IMRDU ;unit price of drugs=price per dispense units
54 S:IMRCL="" IMRCL="UNDEF" ;if no amis reporting stop code
55 S IMRY=0
56 I IMRFILDT>IMRSD,IMRFILDT'>IMRED S IMRY=1 D ;check if fill date is between start and end dates
57 .S ^(IMRRXDR)=$S($D(^TMP($J,IMR1C,"PAT",IMRDFN,IMRRXDR)):^(IMRRXDR),1:0)+1
58 .S ^("Q")=$S($D(^TMP($J,IMR1C,"PAT",IMRDFN,IMRRXDR,"Q")):^("Q"),1:0)+IMRQ
59 .Q
60 I IMRY S ^("C")=$S($D(^TMP($J,IMR1C,"PAT",IMRDFN,IMRRXDR,"C")):^("C"),1:0)+(IMRQ*IMRUCST),^(IMRCL)=$S($D(^(IMRCL)):^(IMRCL),1:0)+1,^("Q")=$S($D(^(IMRCL,"Q")):^("Q"),1:0)+IMRQ,^("C")=$S($D(^("C")):^("C"),1:0)+(IMRQ*IMRUCST)
61 D RXF^IMRUTL ;get refill data
62 Q:'$D(IMRAR(52.1))
63 S IMRN=""
64 F S IMRN=$O(IMRAR(52.1,IMRN)) Q:IMRN="" S IMRRXD=+$G(IMRAR(52.1,IMRN,.01,"I")) I IMRRXD>IMRSD,IMRRXD'>IMRED D C3
65 Q
66C3 ;
67 S IMRQ=$G(IMRAR(52.1,IMRN,1,"I")),IMRRCOST=$G(IMRAR(52.1,IMRN,1.2,"I"))
68 S:'IMRRCOST IMRRCOST=IMRUCST ;if no refill cost set it to unit price of drug
69 S ^(IMRRXDR)=$S($D(^TMP($J,IMR1C,"PAT",IMRDFN,IMRRXDR)):^(IMRRXDR),1:0)+1,^("Q")=$S($D(^(IMRRXDR,"Q")):^("Q"),1:0)+IMRQ,^("C")=$S($D(^("C")):^("C"),1:0)+(IMRQ*IMRRCOST)
70 S ^(IMRCL)=$S($D(^TMP($J,IMR1C,"PAT",IMRDFN,IMRRXDR,IMRCL)):^(IMRCL),1:0)+1,^("Q")=$S($D(^(IMRCL,"Q")):^("Q"),1:0)+IMRQ,^("C")=$S($D(^("C")):^("C"),1:0)+(IMRQ*IMRRCOST)
71 Q
72ASKN ; Ask User whether they want to Query the National
73 S IMRYES=0 D ASKQ1^IMRNTL Q:'IMRYES S IMRDL="" D ASKQ2^IMRNTL Q:IMRDL="" D MSG^IMRNTL,PH^IMRNTL1
74 Q
75ASKQ K DIR S DIR(0)="N^0:999999",DIR("A")="How many of the highest users do you want identified",DIR("B")=0
76 S DIR("?")="This determines the number of individuals with the highest utilization of pharmacy fills you wish listed" D ^DIR K DIR Q:$D(DIRUT)
77 S IMRRMAX=X
78 Q
Note: See TracBrowser for help on using the repository browser.