1 | IMRARVCH ;HIRMFO/FAI-HIV REGISTRY PATIENT CLINICAL HISTORY ARV REPORT ;06/12/00 16:23;
|
---|
2 | ;;2.1;IMMUNOLOGY CASE REGISTRY;**5**;Feb 09, 1998
|
---|
3 | START S FLAG=0
|
---|
4 | D RPT,GETRX,COMPARE
|
---|
5 | W:FLAG=0 !!,"**NO DATA FOUND FOR THIS PERIOD**"
|
---|
6 | D KILL
|
---|
7 | Q
|
---|
8 | RPT ; *** Get search strings
|
---|
9 | 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
|
---|
10 | Q
|
---|
11 | GETRX I '$D(^PS(55,DFN,"P")) W !,"*** NO ACTIVE PHARMACY DATA ***" Q
|
---|
12 | S IMRDFN=DFN
|
---|
13 | 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
|
---|
14 | Q
|
---|
15 | NAME 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)
|
---|
16 | S:$G(NDF)'="" NDFP=$P($G(^PSNDF(50.6,NDF,0)),U,1)
|
---|
17 | S:$G(NDF)="" NDF="UNK",NDFP=$E(DRUG,1,15)
|
---|
18 | S:(FDT>IMRHNBEG)&(FDT<IMRHNEND) ^TMP("RXNAM",$J,NDFP,IMRDFN)=NDF_"^"_DRUG_"^"_FDT
|
---|
19 | D REFILL,PARTIAL
|
---|
20 | Q
|
---|
21 | REFILL ;Get the Refill Information
|
---|
22 | D GETS^DIQ(52,PRSC,"52*","I","IMRAR") ;refill
|
---|
23 | Q:'$D(IMRAR(52.1)) S IMRRI=0 ;get refill data
|
---|
24 | S IMRN="" F S IMRN=$O(IMRAR(52.1,IMRN)) Q:IMRN="" S IMRRXD=+$G(IMRAR(52.1,IMRN,.01,"I")) D
|
---|
25 | .S:(IMRRXD>IMRHNBEG)&(IMRRXD<IMRHNEND) ^TMP("RXNAM",$J,NDFP,IMRDFN)=NDF_"^"_DRUG_"^"_IMRRXD
|
---|
26 | K IMRAR,IMRRXD
|
---|
27 | Q
|
---|
28 | PARTIAL D GETS^DIQ(52,PRSC,"60*","I","IMRAR") ;refill
|
---|
29 | Q:'$D(IMRAR(52.2)) S IMRRI=0 ;get refill data
|
---|
30 | S IMNR="" F S IMNR=$O(IMRAR(52.2,IMNR)) Q:IMNR="" S IMRRPD=+$G(IMRAR(52.2,IMNR,.01,"I")) D
|
---|
31 | .S:(IMRRPD>IMRHNBEG)&(IMRRPD<IMRHNEND) ^TMP("RXNAM",$J,NDFP,IMRDFN)=NDF_"^"_DRUG_"^"_IMRRPD
|
---|
32 | K IMRAR,IMRRPD
|
---|
33 | Q
|
---|
34 | COMPARE ; compare RX to NDF
|
---|
35 | I '$D(^TMP("RXNAM",$J)) W !,"*** NO DATA FOUND ***" Q
|
---|
36 | S NDFIEN=""
|
---|
37 | S NAME="" F S NAME=$O(^TMP("RXNAM",$J,NAME)),DFN="" Q:NAME="" F S DFN=$O(^TMP("RXNAM",$J,NAME,DFN)) Q:DFN="" S IMREC=^TMP("RXNAM",$J,NAME,DFN),NDFN=$P($G(IMREC),U,1),LOCNM=$P($G(IMREC),U,2),PDATE=$P($G(IMREC),U,3) D COMP2
|
---|
38 | Q
|
---|
39 | COMP2 S ARVRX="" F S ARVRX=$O(^TMP("ARV",$J,ARVRX)) Q:ARVRX="" S NIEN=$P($G(^TMP("ARV",$J,ARVRX)),U,1) D STORE
|
---|
40 | Q
|
---|
41 | STORE ; expand on to include dosage if requested
|
---|
42 | I $G(NIEN)'="" Q:NDFN'=NIEN
|
---|
43 | I $G(NIEN)="" Q:LOCNM'[ARVRX
|
---|
44 | S FLAG=1
|
---|
45 | W !,NAME,?35,"Last Activity: "_$E(PDATE,4,5)_"/"_$E(PDATE,6,7)_"/"_$E(PDATE,2,3)
|
---|
46 | Q
|
---|
47 | KILL K ^TMP("ARV",$J),^TMP("RXNAM",$J)
|
---|
48 | K ARVRX,DRUG,FLAG,FN,GLT,IMRAV,IMRC,IMCT,IMREC,IMRRI,IMRONE,IMRTWO,IMRTHR,IMRFOR,IMRU,FDT,FOUR,GONE,GTWO,GTHR,GFOUR,GUNK,IMCT,IMNR
|
---|
49 | K IMRC,IMRCT,IMRDFN,IMRFLG,IMRFN,IMRFOR,IMRH1HED,IMRH2HED,IMRHENGD,IMRHNBEG,IMRHNEND,IMRHQUIT,IMRHRANG,IMRHTART,IMRJ,IMRN
|
---|
50 | K IMRONE,IMRRI,IMRSG,IMRSTN,IMRTHR,IMRTWO,IMRU,IMRUCST,INRTHR,LOCNM,LTOT,NAM,NAME,NDF,NDFN,NDFP,NDFIEN,NIEN,ONE,PDATE,PNAM,PRSC,PTOT,REC,RXN,RXNAME,RXNM,RXU,SSN,THR,TPAT,TWO,UNK,ZNAM
|
---|
51 | Q
|
---|