1 | IMRSUDRX ;HCIOFO/NCA/FT/FAI-List Data on Outpatient Pharmacy Utilization ;07/17/00 15:40
|
---|
2 | ;;2.1;IMMUNOLOGY CASE REGISTRY;**5**;Feb 09, 1998
|
---|
3 | S X=$$RX1589^IMRUTL() ;get pharmacy archive date from File 158.9
|
---|
4 | DQ ; start report
|
---|
5 | K ^TMP($J) S (IMRPG,IMRUT)=0
|
---|
6 | D NOW^%DTC S IMRDTE=%,Y=IMRDTE D DD^%DT S IMRDTE=Y ;get report date/time
|
---|
7 | S IMRDTE=$P(IMRDTE,":",1,2)
|
---|
8 | 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
|
---|
9 | D ^IMRRXLA,RXPRNT^IMRRXL1
|
---|
10 | I '$D(^TMP($J)) W !!,"No data for this report.",!
|
---|
11 | D:'IMRUT EOP^IMRRXL1
|
---|
12 | Q
|
---|
13 | KILL Q
|
---|
14 | C1 ; Get the Outpatient Pharmacy Data
|
---|
15 | S ^TMP($J,IMR1C,"PAT",IMRDFN)=""
|
---|
16 | 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
|
---|
17 | Q
|
---|
18 | C2 ;
|
---|
19 | I 'IMRRXD1!('IMRXX1) Q ;check issue date and drug ien
|
---|
20 | S:'IMRUCST IMRUCST=IMRDU ;unit price of drugs=price per dispense units
|
---|
21 | S:IMRCL="" IMRCL="UNDEF" ;if no amis reporting stop code
|
---|
22 | S IMRY=0
|
---|
23 | I IMRFILDT>IMRSD,IMRFILDT'>IMRED S IMRY=1 D ;check if fill date is between start and end dates
|
---|
24 | .S ^(IMRRXDR)=$S($D(^TMP($J,IMR1C,"PAT",IMRDFN,IMRRXDR)):^(IMRRXDR),1:0)+1
|
---|
25 | .S ^("Q")=$S($D(^TMP($J,IMR1C,"PAT",IMRDFN,IMRRXDR,"Q")):^("Q"),1:0)+IMRQ
|
---|
26 | .Q
|
---|
27 | 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)
|
---|
28 | D RXF^IMRUTL ;get refill data
|
---|
29 | Q:'$D(IMRAR(52.1))
|
---|
30 | S IMRN=""
|
---|
31 | 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
|
---|
32 | Q
|
---|
33 | C3 ;
|
---|
34 | S IMRQ=$G(IMRAR(52.1,IMRN,1,"I")),IMRRCOST=$G(IMRAR(52.1,IMRN,1.2,"I"))
|
---|
35 | S:'IMRRCOST IMRRCOST=IMRUCST ;if no refill cost set it to unit price of drug
|
---|
36 | 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)
|
---|
37 | 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)
|
---|
38 | Q
|
---|