source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRARVLO.m@ 1608

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

initial load of WorldVistAEHR

File size: 5.0 KB
Line 
1IMRARVLO ;HIRMFO/FAI-HIV REGISTRY ARV REPORT-AT LEAST ONE ;07/05/00 16:00;
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**5**;Feb 09, 1998
3START D KILL
4 S (IMRC,IMCT,IMRCT,IMRRI,IMRONE,IMRTWO,IMRTHR,IMRFOR,IMRU,PTOT,LTOT)=0 D EN,DEVICE
5 Q
6DEVICE Q:$G(IMRHNBEG)=""
7 D IMRDEV^IMREDIT
8 G:POP KILL
9 I '$D(IO("Q")) D PRINT Q
10 I $D(IO("Q")) D G KILL
11 .S ZTRTN="DQ^IMRARVLO",ZTDESC="Local ARV Report-At Least ONE"
12 .S ZTSAVE("*")="",ZTIO=ION_";"_IOM_";"_IOSL
13 .D ^%ZTLOAD K ZTRTN,ZTDESC,ZTSAVE,ZTSK
14 .Q
15 Q
16EN ; *** Get parameters
17 D ^IMRDATE
18 Q:$G(IMRHNBEG)=""
19 W !!,"You have selected Antiretroviral Drugs as a search group. I will now search for",!,"patients who have had AT LEAST ONE of the drugs listed in this group.",!!
20 S DIR(0)="Y",DIR("A")="Do you want the unique patients listed by name (Y/N)?",DIR("B")="NO",DIR("?")="Answer YES to see a list of individual names." D ^DIR K DIR S IMR2C=Y
21 Q
22DQ D HEADER,RPT,RXFIND,COMPARE,LINES,INDIV,KILL
23 Q
24PRINT D HEADER,RPT,RXFIND,COMPARE,LINES,INDIV,KILL
25 Q
26RPT ; *** Get search strings
27 S RXNM="" F S RXNM=$O(^IMR(158.7,"B",RXNM)),DR="" Q:RXNM="" F S DR=$O(^IMR(158.7,"B",RXNM,DR)) Q:DR="" S NDFIEN=$P($G(^IMR(158.7,DR,0)),U,3),^TMP("ARV",$J,RXNM)=NDFIEN
28 Q
29RXFIND ; *** Find RX info
30 F IMRJ=0:0 S IMRJ=$O(^IMR(158,IMRJ)),IMRCAT="" Q:IMRJ'>0 S X=+^(IMRJ,0) D ^IMRXOR S (IMRDFN,IMRFN)=X,(FN,DFN,D0,DA)=IMRFN,IMRCAT=$P($G(^IMR(158,IMRJ,0)),U,42) D GETRX
31 Q
32GETRX Q:'$D(^PS(55,DFN,"P"))
33 S:IMRCAT="" IMRCAT="UNK"
34 S RXN=0 F S RXN=$O(^PS(55,DFN,"P",RXN)) Q:RXN="" Q:'$D(^PS(55,DFN,"P",RXN,0)) S PRSC=$P($G(^PS(55,DFN,"P",RXN,0)),U,1),FDT=$P($G(^PSRX(PRSC,2)),U,2) D NAME
35 Q
36NAME S RXNAME=$P($G(^PSRX(PRSC,0)),U,6) Q:RXNAME="" S DRUG=$P($G(^PSDRUG(RXNAME,0)),U,1),RXU=$P($G(^PSRX(PRSC,0)),U,1),NDF=$P($G(^PSDRUG(RXNAME,"ND")),U,1)
37 S:$G(NDF)'="" NDFP=$P($G(^PSNDF(50.6,NDF,0)),U,1)
38 S:$G(NDF)="" NDF="UNK",NDFP=$E(DRUG,1,15)
39 S:(FDT>IMRHNBEG)&(FDT<IMRHNEND) ^TMP("RXNAM",$J,NDFP,IMRDFN)=NDF_"^"_DRUG_"^"_FDT_"^"_IMRCAT
40 D REFILL,PARTIAL
41 Q
42REFILL ;Get the Refill Information
43 D GETS^DIQ(52,PRSC,"52*","I","IMRAR") ;refill
44 Q:'$D(IMRAR(52.1)) S IMRRI=0 ;get refill data
45 S IMRN="" F S IMRN=$O(IMRAR(52.1,IMRN)) Q:IMRN="" S IMRRXD=+$G(IMRAR(52.1,IMRN,.01,"I")) D
46 .S:(IMRRXD>IMRHNBEG)&(IMRRXD<IMRHNEND) ^TMP("RXNAM",$J,NDFP,IMRDFN)=NDF_"^"_DRUG_"^"_IMRRXD_"^"_IMRCAT
47 K IMRAR,IMRRXD
48 Q
49PARTIAL D GETS^DIQ(52,PRSC,"60*","I","IMRAR") ;refill
50 Q:'$D(IMRAR(52.2)) S IMRRI=0 ;get refill data
51 S IMNR="" F S IMNR=$O(IMRAR(52.2,IMNR)) Q:IMNR="" S IMRRPD=+$G(IMRAR(52.2,IMNR,.01,"I")) D
52 .S:(IMRRPD>IMRHNBEG)&(IMRRPD<IMRHNEND) ^TMP("RXNAM",$J,NDFP,IMRDFN)=NDF_"^"_DRUG_"^"_IMRRPD_"^"_IMRCAT
53 K IMRAR,IMRRPD
54 Q
55COMPARE ; compare RX to NDF
56 S (GONE,GTWO,GTHR,GFOUR,GLT,GUNK,IMRONE,IMRTWO,IMRTHR,IMRFOR,IMRU,LTOT,PTOT)=0
57 S ^TMP("IMRALO",$J)="0^0^0^0^0"
58 S NDFIEN=""
59 S NM="" F S NM=$O(^TMP("RXNAM",$J,NM)),DFN="" Q:NM="" F S DFN=$O(^TMP("RXNAM",$J,NM,DFN)) Q:DFN="" S IMREC=^TMP("RXNAM",$J,NM,DFN),NDFN=$P($G(IMREC),U,1),LOCNM=$P($G(IMREC),U,2),PDATE=$P($G(IMREC),U,3),IMRCAT=$P($G(IMREC),U,4) D COMP2
60 Q
61COMP2 S ARVRX="" F S ARVRX=$O(^TMP("ARV",$J,ARVRX)) Q:ARVRX="" S NIEN=$P($G(^TMP("ARV",$J,ARVRX)),U,1) D STORE
62 Q
63STORE I $G(NIEN)'="" Q:NDFN'=NIEN
64 I $G(NIEN)="" Q:LOCNM'[ARVRX
65 S TPAT=$P($G(^DPT(DFN,0)),U,1),SSN=$P($G(^DPT(DFN,0)),U,9),^TMP("IMRTOT",$J,TPAT,SSN)=IMRCAT
66 D TOTCAT^IMRARVCK
67 Q
68HEADER ; *** Print report header
69 W @IOF,?25,"Local Antiretroviral (ARV) Drug Report"
70 W !!,?3,"Number of VA HIV/AIDS Patients Receiving AT LEAST ONE of the ARV Drugs",!
71 W !,?20,IMRHRANG,!,?30,"Station Report",!!,"CAT1",?10,"CAT2",?20,"CAT3",?30,"CAT4",?40,"UNK",?50,"TOTAL",!
72 W "----",?10,"----",?20,"----",?30,"----",?40,"---",?50,"-----"
73 Q
74LINES I '$D(^TMP("IMRALO",$J)) W !!,"***NO DATA FOUND FOR THIS PERIOD***" Q
75 S REC=^TMP("IMRALO",$J),ONE=$P(REC,U,1),TWO=$P(REC,U,2),THR=$P(REC,U,3),FOUR=$P(REC,U,4),UNK=$P(REC,U,5) W !,?2,ONE,?11,TWO,?21,THR,?31,FOUR,?41,UNK S LTOT=ONE+TWO+THR+FOUR+UNK W ?51,LTOT
76 S GLT=GLT+LTOT,GONE=GONE+ONE,GTWO=GTWO+TWO,GTHR=GTHR+THR,GFOUR=GFOUR+FOUR,GUNK=GUNK+UNK
77 W !!,"TOTALS >>>>>>",!!,?2,GONE,?11,GTWO,?21,GTHR,?31,GFOUR,?41,GUNK,?51,GLT
78 Q
79INDIV W:IMR2C=1 !!!,?15,"******** UNIQUE PATIENTS ********",!!,"Patient",?23,"SSN",?37,"Category",!,"-------",?23,"---",?37,"--------",!
80 S DFN="" F S DFN=$O(^TMP("IMRTOT",$J,DFN)),SSN="" Q:DFN="" F S SSN=$O(^TMP("IMRTOT",$J,DFN,SSN)) Q:SSN="" S IMRCAT=$P($G(^TMP("IMRTOT",$J,DFN,SSN)),U,1) S PTOT=PTOT+1 D INDI2
81 W !!,?15,">>>>>> # of Unique Patients: "_PTOT_" <<<<<<"
82 Q
83INDI2 W:IMR2C=1 !,$E(DFN,1,20),?23,$E(SSN,6,9),?40,IMRCAT
84 Q
85KILL D ^%ZISC K ^TMP("IMRLO",$J),^TMP("IMRTOT",$J),^TMP("RXNAM",$J)
86 K ARVRX,DFN,DRUG,FN,GLT,IMRAV,IMRC,IMCT,IMREC,IMRRI,IMRONE,IMRTWO,IMRTHR,IMRFOR,IMRU,FDT,FOUR,GONE,GTWO,GTHR,GFOUR,GUNK,IMCT,IMNR
87 K IMRC,IMRCAT,IMRCT,IMRDFN,IMRFLG,IMRFN,IMRFOR,IMRH1HED,IMRH2HED,IMRHENGD,IMRHNBEG,IMRHNEND,IMRHQUIT,IMRHRANG,IMRHTART,IMRJ,IMRN
88 K IMRONE,IMRRI,IMRSG,IMRSTN,IMRTHR,IMRTWO,IMRU,IMRUCST,INRTHR,LOCNM,LTOT,NAM,NAME,NDF,NDFN,NDFP,NDFIEN,NIEN,NM,ONE,PDATE,PNAM,PRSC,PTOT,REC,RXN,RXNAME,RXNM,RXU,SSN,THR,TPAT,TWO,UNK,ZNAM
89 Q
Note: See TracBrowser for help on using the repository browser.