BKMQQCR4 ;PRXM/HC/BWF - BKMV Quality of Care Report; [ 1/19/2005 7:16 PM ] ; 13 Apr 2005 4:47 PM
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
; Quality of Care Audit Report
Q
ARVM03 ; EP - ARV Therapy
; M.03 TAXONOMIES
N ARVM03DT,SITETAX,NDCTAX,GLOBAL,TOTPTS,BKMDFN
S ARVM03DT=$$FMADD^XLFDT(EDATE,-122)
S SITETAX="BKMV NRTI MEDS"
S NDCTAX="BKMV NRTI MED NDCS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""ARVM03"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""ARVM03CNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.D MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,ARVM03DT,GLOBAL)
.D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,ARVM03DT,GLOBAL)
.; Store Medication refusals in same global as regular Medications.
.;D REFUSAL^BKMIXX2(BKMDFN,50,SITETAX,EDATE,ARVM03DT,GLOBAL)
.;D REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,ARVM03DT,GLOBAL)
.;
.I $D(@GLOB@("HIVCHK",BKMDFN,"ARVM03")) D MEDLP("ARVM03")
.;
.I $D(@GLOB@("HIVCHK",BKMDFN,"ARVM03")) S @TOTPTS=@TOTPTS+1
Q
ARVM02 ; EP - ARV Therapy
; M.02 TAXONOMIES
N ARVM02DT,SITETAX,NDCTAX,GLOBAL,TOTPTS,BKMDFN
S ARVM02DT=$$FMADD^XLFDT(EDATE,-122)
S SITETAX="BKMV NNRTI MEDS"
S NDCTAX="BKMV NNRTI MED NDCS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""ARVM02"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""ARVM02CNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.D MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,ARVM02DT,GLOBAL)
.D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,ARVM02DT,GLOBAL)
.; Store Medication refusals in same global as regular Medications.
.;D REFUSAL^BKMIXX2(BKMDFN,50,SITETAX,EDATE,ARVM02DT,GLOBAL)
.;D REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,ARVM02DT,GLOBAL)
.;
.I $D(@GLOB@("HIVCHK",BKMDFN,"ARVM02")) D MEDLP("ARVM02")
.;
.I $D(@GLOB@("HIVCHK",BKMDFN,"ARVM02")) S @TOTPTS=@TOTPTS+1
Q
ARVM01 ; EP - ARV Therapy
; M.01 TAXONOMIES
N ARVM01DT,SITETAX,NDCTAX,GLOBAL,TOTPTS,BKMDFN
S ARVM01DT=$$FMADD^XLFDT(EDATE,-122)
S SITETAX="BKMV MAC PROPH MEDS"
S NDCTAX="BKMV MAC PROPH MED NDCS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""ARVM01"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""ARVM01CNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.D MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,ARVM01DT,GLOBAL)
.D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,ARVM01DT,GLOBAL)
.; Store Medication refusals in same global as regular Medications.
.;D REFUSAL^BKMIXX2(BKMDFN,50,SITETAX,EDATE,ARVM01DT,GLOBAL)
.;D REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,ARVM01DT,GLOBAL)
.;
.I $D(@GLOB@("HIVCHK",BKMDFN,"ARVM01")) D MEDLP("ARVM01")
.;
.I $D(@GLOB@("HIVCHK",BKMDFN,"ARVM01")) S @TOTPTS=@TOTPTS+1
Q
ARVM05 ; EP - ARV Therapy
; M.05 TAXONOMIES
N ARVM05DT,SITETAX,NDCTAX,GLOBAL,TOTPTS,BKMDFN
S ARVM05DT=$$FMADD^XLFDT(EDATE,-122)
S SITETAX="BKMV PI MEDS"
S NDCTAX="BKMV PI MED NDCS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""ARVM05"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""ARVM05CNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.D MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,ARVM05DT,GLOBAL)
.D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,ARVM05DT,GLOBAL)
.; Store Medication refusals in same global as regular Medications.
.;D REFUSAL^BKMIXX2(BKMDFN,50,SITETAX,EDATE,ARVM05DT,GLOBAL)
.;D REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,ARVM05DT,GLOBAL)
.;
.I $D(@GLOB@("HIVCHK",BKMDFN,"ARVM05")) D MEDLP("ARVM05")
.;
.I $D(@GLOB@("HIVCHK",BKMDFN,"ARVM05")) S @TOTPTS=@TOTPTS+1
Q
ARVM09 ; EP - ARV Therapy
; M.09 TAXONOMIES
N ARVM09DT,SITETAX,NDCTAX,GLOBAL,TOTPTS,BKMDFN
S ARVM09DT=$$FMADD^XLFDT(EDATE,-122)
S SITETAX="BKMV EI MEDS"
S NDCTAX="BKMV EI MED NDCS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""ARVM09"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""ARVM09CNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.D MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,ARVM09DT,GLOBAL)
.D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,ARVM09DT,GLOBAL)
.; Store Medication refusals in same global as regular Medications.
.;D REFUSAL^BKMIXX2(BKMDFN,50,SITETAX,EDATE,ARVM09DT,GLOBAL)
.;D REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,ARVM09DT,GLOBAL)
.;
.I $D(@GLOB@("HIVCHK",BKMDFN,"ARVM09")) D MEDLP("ARVM09")
.;
.I $D(@GLOB@("HIVCHK",BKMDFN,"ARVM09")) S @TOTPTS=@TOTPTS+1
Q
ARVM10 ; EP - ARV Therapy
; M.10 TAXONOMIES
N ARVM10DT,SITETAX,NDCTAX,GLOBAL,TOTPTS,BKMDFN
S ARVM10DT=$$FMADD^XLFDT(EDATE,-122)
S SITETAX="BKMV II MEDS"
S NDCTAX="BKMV II MED NDCS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""ARVM10"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""ARVM10CNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.D MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,ARVM10DT,GLOBAL)
.D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,ARVM10DT,GLOBAL)
.; Store Medication refusals in same global as regular Medications.
.;D REFUSAL^BKMIXX2(BKMDFN,50,SITETAX,EDATE,ARVM10DT,GLOBAL)
.;D REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,ARVM10DT,GLOBAL)
.;
.I $D(@GLOB@("HIVCHK",BKMDFN,"ARVM10")) D MEDLP("ARVM10")
.;
.I $D(@GLOB@("HIVCHK",BKMDFN,"ARVM10")) S @TOTPTS=@TOTPTS+1
Q
ARVM11 ; EP - ARV Therapy
; M.11 TAXONOMIES
N ARVM11DT,SITETAX,NDCTAX,GLOBAL,TOTPTS,BKMDFN
S ARVM11DT=$$FMADD^XLFDT(EDATE,-122)
S SITETAX="BKMV NRTI/NNRTI MEDS"
S NDCTAX="BKMV NRTI/NNRTI MED NDCS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""ARVM11"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""ARVM11CNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.D MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,ARVM11DT,GLOBAL)
.D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,ARVM11DT,GLOBAL)
.; Store Medication refusals in same global as regular Medications.
.;D REFUSAL^BKMIXX2(BKMDFN,50,SITETAX,EDATE,ARVM11DT,GLOBAL)
.;D REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,ARVM11DT,GLOBAL)
.;
.I $D(@GLOB@("HIVCHK",BKMDFN,"ARVM11")) D MEDLP("ARVM11")
.;
.I $D(@GLOB@("HIVCHK",BKMDFN,"ARVM11")) S @TOTPTS=@TOTPTS+1
Q
ARVM12 ; EP - ARV Therapy
; M.12 TAXONOMIES
N ARVM12DT,SITETAX,NDCTAX,GLOBAL,TOTPTS,BKMDFN
S ARVM12DT=$$FMADD^XLFDT(EDATE,-122)
S SITETAX="BKMV NRTI COMBO MEDS"
S NDCTAX="BKMV NRTI COMBO MED NDCS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""ARVM12"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""ARVM12CNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.D MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,ARVM12DT,GLOBAL)
.D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,ARVM12DT,GLOBAL)
.;
.I $D(@GLOB@("HIVCHK",BKMDFN,"ARVM12")) D MEDLP("ARVM12")
.;
.I $D(@GLOB@("HIVCHK",BKMDFN,"ARVM12")) S @TOTPTS=@TOTPTS+1
Q
ARVM13 ; EP - ARV Therapy
; M.13 TAXONOMIES
N ARVM13DT,SITETAX,NDCTAX,GLOBAL,TOTPTS,BKMDFN
S ARVM13DT=$$FMADD^XLFDT(EDATE,-122)
S SITETAX="BKMV PI BOOSTER MEDS"
S NDCTAX="BKMV PI BOOSTER MED NDCS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""ARVM13"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""ARVM13CNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.D MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,ARVM13DT,GLOBAL)
.D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,ARVM13DT,GLOBAL)
.; Store Medication refusals in same global as regular Medications.
.;D REFUSAL^BKMIXX2(BKMDFN,50,SITETAX,EDATE,ARVM13DT,GLOBAL)
.;D REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,ARVM13DT,GLOBAL)
.;
.I $D(@GLOB@("HIVCHK",BKMDFN,"ARVM13")) D MEDLP("ARVM13")
.;
.I $D(@GLOB@("HIVCHK",BKMDFN,"ARVM13")) S @TOTPTS=@TOTPTS+1
Q
PCP ; EP - PCP Prophylaxis
N SITETAX,NDCTAX,GLOBAL,BKMDFN,VSTDT,TEST,RESULT,TOTPTS,FOUND
S SITETAX="BKMV PCP PROPH MEDS"
S NDCTAX="BKMV PCP PROPH MED NDCS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""PCP"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""PCPPTCNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.I '$D(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12")) Q
.S VSTDT=""
.S FOUND=0
.; Find earliest CD4 Absolute with results between 50 and 199.
.F S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12",VSTDT)) Q:VSTDT="" D Q:FOUND
..S TEST=""
..F S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12",VSTDT,TEST)) Q:TEST="" D Q:FOUND
...S RESULT=$P($G(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12",VSTDT,TEST)),U)
...I RESULT="" Q
...I RESULT'<200 Q
...;I RESULT<50 Q
...S FOUND=1
.I 'FOUND Q
.; select meds prescribed since the defined CD4 visit
.D MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,VSTDT,GLOBAL)
.D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,VSTDT,GLOBAL)
.I $D(@GLOB@("HIVCHK",BKMDFN,"PCP")) S @TOTPTS=@TOTPTS+1
Q
MAC ; EP - MAC Prophylaxis
N SITETAX,NDCTAX,GLOBAL,BKMDFN,VSTDT,TEST,RESULT,TOTPTS,FOUND
S SITETAX="BKMV MAC PROPH MEDS"
S NDCTAX="BKMV MAC PROPH MED NDCS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""MAC"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""MACPTCNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.I '$D(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12")) Q
.S VSTDT=""
.S FOUND=0
.; Find earliest CD4 Absolute with results less than 50.
.F S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12",VSTDT)) Q:VSTDT="" D Q:FOUND
..S TEST=""
..F S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12",VSTDT,TEST)) Q:TEST="" D Q:FOUND
...S RESULT=$G(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12",VSTDT,TEST))
...I RESULT="" Q
...I RESULT'<50 Q
...S FOUND=1
.I 'FOUND Q
.; select meds prescribed since the defined CD4 visit
.D MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,VSTDT,GLOBAL)
.D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,VSTDT,GLOBAL)
.I $D(@GLOB@("HIVCHK",BKMDFN,"MAC")) S @TOTPTS=@TOTPTS+1
Q
;
MEDLP(ARV) ; Loop through medications found and determine if they are active
NEW VSTDT,TEST
S (VSTDT,TEST)=""
F S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,ARV,VSTDT)) Q:'VSTDT D
. F S TEST=$O(@GLOB@("HIVCHK",BKMDFN,ARV,VSTDT,TEST)) Q:'TEST D
.. I '$$ACTMED(TEST) K @GLOB@("HIVCHK",BKMDFN,ARV,VSTDT,TEST)
Q
;
ACTMED(VMEDIEN) ;EP - Is this an active medication?
;*** only need VMEDIEN - all calls shd be revised ***
;
; Taken from APCHPMH3 and revised to be a self-contained extrinsic function
;
; Input:
; VMEDIEN - the V MEDICATION internal entry number
;
; Output:
; '1' if the rx is currently active
;
NEW VMEDDATA,PSIEN,DCDT,EDATE,EXPDT,RXIEN,STOP,ACT,STAT
I '$D(^AUPNVMED(VMEDIEN,0)) Q 0
S VMEDDATA=^AUPNVMED(VMEDIEN,0),PSIEN=$P(VMEDDATA,U,1) I PSIEN="" Q 0
I '$D(^PSDRUG(PSIEN)) Q 0
S EDATE=DT ; use only the current date for medications to reduce the risk of a prescribing error
S DCDT=$P(VMEDDATA,U,8) I DCDT'="",DCDT'>EDATE Q 0 ;date discontinued
;
S EXPDT=""
; Get Prescription ien
S RXIEN=$S($D(^PSRX("APCC",VMEDIEN)):$O(^PSRX("APCC",VMEDIEN,0)),1:0)
I RXIEN>0,'$D(^PSRX(RXIEN,"STA")) S ACT=0 D Q ACT
. ; Is this an expired prescription?
. S EXPDT=$P($G(^PSRX(RXIEN,2)),U,6)
. I EXPDT,$$EXPMED(EDATE,EXPDT) Q
. ; Calculate RX status if V6
. S STAT=$$RXSTAT(RXIEN,EDATE)
. I STAT=11 S ACT=1 Q ; EXPIRED within acceptable timeframe
. I STAT>10 Q
. I $P($G(^AUPNVMED(VMEDIEN,11)),U,8)'="" S ACT=1 Q ; OUTSIDE MEDICATION (AORX mnemonic in the pharmacy package)
. I STAT=0 S ACT=1 Q ; ACTIVE
. I STAT=3 S ACT=1 Q ; HOLD
. I STAT=5 S ACT=1 Q ; SUSPENDED
;
S STAT=$G(^PSRX(RXIEN,"STA")) ;Status is in "STA" node in V 7
;
I STAT=11,'$$EXPMED(RXIEN,EXPDT) Q 1 ;EXPIRED within acceptable timeframe
I $P($G(^AUPNVMED(VMEDIEN,11)),U,8)'="" Q 1 ; OUTSIDE MEDICATION (AORX mnemonic in the pharmacy package)
I STAT=0 Q 1 ;ACTIVE
I STAT=3 Q 1 ;HOLD
I STAT=5 Q 1 ;SUSPENDED
Q 0
;
RXSTAT(RX,DATE) ; EP - return status of rx
;
; Taken from APCHPMH3 and revised to be a self-contained extrinsic function
;... APCHPMH3 had taken this from the PSOFUNC routine
; Note: piece 15 of ^PSRX(RX,0) is not documented in ^DD (probably pre-V 7)
;
; Input:
; RX - the PRESCRIPTION internal entry number
; DATE - date against which to compare the prescription expiration date
;
NEW RX0,RX2,J,ST0,ST,ST1
I $D(^PSRX(RX,"STA")) Q "" ;USING V7
I RX'>0 Q ""
S DATE=$G(DATE,DT)
S RX0=$G(^PSRX(RX,0)),RX2=$G(^PSRX(RX,2))
S J=RX,ST0=$P(RX0,U,15) I ST0'="" S ST0=+ST0
I ST0<12 D
. S ST1=$O(^PS(52.5,"B",J,0)) Q:ST1=""
. I $D(^PS(52.5,ST1,0)),'$G(^PS(52.5,ST1,"P")) S ST0=5
I ST0<12,$P(RX2,U,6),$P(RX2,U,6)'>DATE S ST0=11
Q ST0
;
EXPMED(RXIEN,EXPDT) ; Is this an expired prescription?
; Chronic medications - greater than 120 days
; All other medications - greater than 14 days
;
NEW CHR
I 'EXPDT Q 0
S CHR=($$GET1^DIQ(52,RXIEN,9999999.02,"I")="Y")
I CHR,$$FMDIFF^XLFDT(EXPDT,DT)>120 Q 1
I 'CHR,$$FMDIFF^XLFDT(EXPDT,DT)>14 Q 1
Q 0
BKMQQCR4 ;PRXM/HC/BWF - BKMV Quality of Care Report; [ 1/19/2005 7:16 PM ] ; 13 Apr 2005 4:47 PM
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ; Quality of Care Audit Report
+3 QUIT
ARVM03 ; EP - ARV Therapy
+1 ; M.03 TAXONOMIES
+2 NEW ARVM03DT,SITETAX,NDCTAX,GLOBAL,TOTPTS,BKMDFN
+3 SET ARVM03DT=$$FMADD^XLFDT(EDATE,-122)
+4 SET SITETAX="BKMV NRTI MEDS"
+5 SET NDCTAX="BKMV NRTI MED NDCS"
+6 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""ARVM03"",VSTDT,TEST)"
+7 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""ARVM03CNT"")"
+8 SET BKMDFN=0
SET @TOTPTS=0
+9 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+10 DO MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,ARVM03DT,GLOBAL)
+11 DO NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,ARVM03DT,GLOBAL)
+12 ; Store Medication refusals in same global as regular Medications.
+13 ;D REFUSAL^BKMIXX2(BKMDFN,50,SITETAX,EDATE,ARVM03DT,GLOBAL)
+14 ;D REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,ARVM03DT,GLOBAL)
+15 ;
+16 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"ARVM03"))
DO MEDLP("ARVM03")
+17 ;
+18 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"ARVM03"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+19 QUIT
ARVM02 ; EP - ARV Therapy
+1 ; M.02 TAXONOMIES
+2 NEW ARVM02DT,SITETAX,NDCTAX,GLOBAL,TOTPTS,BKMDFN
+3 SET ARVM02DT=$$FMADD^XLFDT(EDATE,-122)
+4 SET SITETAX="BKMV NNRTI MEDS"
+5 SET NDCTAX="BKMV NNRTI MED NDCS"
+6 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""ARVM02"",VSTDT,TEST)"
+7 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""ARVM02CNT"")"
+8 SET BKMDFN=0
SET @TOTPTS=0
+9 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+10 DO MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,ARVM02DT,GLOBAL)
+11 DO NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,ARVM02DT,GLOBAL)
+12 ; Store Medication refusals in same global as regular Medications.
+13 ;D REFUSAL^BKMIXX2(BKMDFN,50,SITETAX,EDATE,ARVM02DT,GLOBAL)
+14 ;D REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,ARVM02DT,GLOBAL)
+15 ;
+16 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"ARVM02"))
DO MEDLP("ARVM02")
+17 ;
+18 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"ARVM02"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+19 QUIT
ARVM01 ; EP - ARV Therapy
+1 ; M.01 TAXONOMIES
+2 NEW ARVM01DT,SITETAX,NDCTAX,GLOBAL,TOTPTS,BKMDFN
+3 SET ARVM01DT=$$FMADD^XLFDT(EDATE,-122)
+4 SET SITETAX="BKMV MAC PROPH MEDS"
+5 SET NDCTAX="BKMV MAC PROPH MED NDCS"
+6 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""ARVM01"",VSTDT,TEST)"
+7 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""ARVM01CNT"")"
+8 SET BKMDFN=0
SET @TOTPTS=0
+9 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+10 DO MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,ARVM01DT,GLOBAL)
+11 DO NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,ARVM01DT,GLOBAL)
+12 ; Store Medication refusals in same global as regular Medications.
+13 ;D REFUSAL^BKMIXX2(BKMDFN,50,SITETAX,EDATE,ARVM01DT,GLOBAL)
+14 ;D REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,ARVM01DT,GLOBAL)
+15 ;
+16 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"ARVM01"))
DO MEDLP("ARVM01")
+17 ;
+18 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"ARVM01"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+19 QUIT
ARVM05 ; EP - ARV Therapy
+1 ; M.05 TAXONOMIES
+2 NEW ARVM05DT,SITETAX,NDCTAX,GLOBAL,TOTPTS,BKMDFN
+3 SET ARVM05DT=$$FMADD^XLFDT(EDATE,-122)
+4 SET SITETAX="BKMV PI MEDS"
+5 SET NDCTAX="BKMV PI MED NDCS"
+6 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""ARVM05"",VSTDT,TEST)"
+7 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""ARVM05CNT"")"
+8 SET BKMDFN=0
SET @TOTPTS=0
+9 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+10 DO MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,ARVM05DT,GLOBAL)
+11 DO NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,ARVM05DT,GLOBAL)
+12 ; Store Medication refusals in same global as regular Medications.
+13 ;D REFUSAL^BKMIXX2(BKMDFN,50,SITETAX,EDATE,ARVM05DT,GLOBAL)
+14 ;D REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,ARVM05DT,GLOBAL)
+15 ;
+16 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"ARVM05"))
DO MEDLP("ARVM05")
+17 ;
+18 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"ARVM05"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+19 QUIT
ARVM09 ; EP - ARV Therapy
+1 ; M.09 TAXONOMIES
+2 NEW ARVM09DT,SITETAX,NDCTAX,GLOBAL,TOTPTS,BKMDFN
+3 SET ARVM09DT=$$FMADD^XLFDT(EDATE,-122)
+4 SET SITETAX="BKMV EI MEDS"
+5 SET NDCTAX="BKMV EI MED NDCS"
+6 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""ARVM09"",VSTDT,TEST)"
+7 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""ARVM09CNT"")"
+8 SET BKMDFN=0
SET @TOTPTS=0
+9 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+10 DO MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,ARVM09DT,GLOBAL)
+11 DO NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,ARVM09DT,GLOBAL)
+12 ; Store Medication refusals in same global as regular Medications.
+13 ;D REFUSAL^BKMIXX2(BKMDFN,50,SITETAX,EDATE,ARVM09DT,GLOBAL)
+14 ;D REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,ARVM09DT,GLOBAL)
+15 ;
+16 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"ARVM09"))
DO MEDLP("ARVM09")
+17 ;
+18 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"ARVM09"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+19 QUIT
ARVM10 ; EP - ARV Therapy
+1 ; M.10 TAXONOMIES
+2 NEW ARVM10DT,SITETAX,NDCTAX,GLOBAL,TOTPTS,BKMDFN
+3 SET ARVM10DT=$$FMADD^XLFDT(EDATE,-122)
+4 SET SITETAX="BKMV II MEDS"
+5 SET NDCTAX="BKMV II MED NDCS"
+6 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""ARVM10"",VSTDT,TEST)"
+7 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""ARVM10CNT"")"
+8 SET BKMDFN=0
SET @TOTPTS=0
+9 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+10 DO MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,ARVM10DT,GLOBAL)
+11 DO NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,ARVM10DT,GLOBAL)
+12 ; Store Medication refusals in same global as regular Medications.
+13 ;D REFUSAL^BKMIXX2(BKMDFN,50,SITETAX,EDATE,ARVM10DT,GLOBAL)
+14 ;D REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,ARVM10DT,GLOBAL)
+15 ;
+16 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"ARVM10"))
DO MEDLP("ARVM10")
+17 ;
+18 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"ARVM10"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+19 QUIT
ARVM11 ; EP - ARV Therapy
+1 ; M.11 TAXONOMIES
+2 NEW ARVM11DT,SITETAX,NDCTAX,GLOBAL,TOTPTS,BKMDFN
+3 SET ARVM11DT=$$FMADD^XLFDT(EDATE,-122)
+4 SET SITETAX="BKMV NRTI/NNRTI MEDS"
+5 SET NDCTAX="BKMV NRTI/NNRTI MED NDCS"
+6 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""ARVM11"",VSTDT,TEST)"
+7 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""ARVM11CNT"")"
+8 SET BKMDFN=0
SET @TOTPTS=0
+9 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+10 DO MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,ARVM11DT,GLOBAL)
+11 DO NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,ARVM11DT,GLOBAL)
+12 ; Store Medication refusals in same global as regular Medications.
+13 ;D REFUSAL^BKMIXX2(BKMDFN,50,SITETAX,EDATE,ARVM11DT,GLOBAL)
+14 ;D REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,ARVM11DT,GLOBAL)
+15 ;
+16 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"ARVM11"))
DO MEDLP("ARVM11")
+17 ;
+18 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"ARVM11"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+19 QUIT
ARVM12 ; EP - ARV Therapy
+1 ; M.12 TAXONOMIES
+2 NEW ARVM12DT,SITETAX,NDCTAX,GLOBAL,TOTPTS,BKMDFN
+3 SET ARVM12DT=$$FMADD^XLFDT(EDATE,-122)
+4 SET SITETAX="BKMV NRTI COMBO MEDS"
+5 SET NDCTAX="BKMV NRTI COMBO MED NDCS"
+6 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""ARVM12"",VSTDT,TEST)"
+7 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""ARVM12CNT"")"
+8 SET BKMDFN=0
SET @TOTPTS=0
+9 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+10 DO MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,ARVM12DT,GLOBAL)
+11 DO NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,ARVM12DT,GLOBAL)
+12 ;
+13 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"ARVM12"))
DO MEDLP("ARVM12")
+14 ;
+15 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"ARVM12"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+16 QUIT
ARVM13 ; EP - ARV Therapy
+1 ; M.13 TAXONOMIES
+2 NEW ARVM13DT,SITETAX,NDCTAX,GLOBAL,TOTPTS,BKMDFN
+3 SET ARVM13DT=$$FMADD^XLFDT(EDATE,-122)
+4 SET SITETAX="BKMV PI BOOSTER MEDS"
+5 SET NDCTAX="BKMV PI BOOSTER MED NDCS"
+6 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""ARVM13"",VSTDT,TEST)"
+7 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""ARVM13CNT"")"
+8 SET BKMDFN=0
SET @TOTPTS=0
+9 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+10 DO MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,ARVM13DT,GLOBAL)
+11 DO NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,ARVM13DT,GLOBAL)
+12 ; Store Medication refusals in same global as regular Medications.
+13 ;D REFUSAL^BKMIXX2(BKMDFN,50,SITETAX,EDATE,ARVM13DT,GLOBAL)
+14 ;D REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,ARVM13DT,GLOBAL)
+15 ;
+16 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"ARVM13"))
DO MEDLP("ARVM13")
+17 ;
+18 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"ARVM13"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+19 QUIT
PCP ; EP - PCP Prophylaxis
+1 NEW SITETAX,NDCTAX,GLOBAL,BKMDFN,VSTDT,TEST,RESULT,TOTPTS,FOUND
+2 SET SITETAX="BKMV PCP PROPH MEDS"
+3 SET NDCTAX="BKMV PCP PROPH MED NDCS"
+4 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""PCP"",VSTDT,TEST)"
+5 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""PCPPTCNT"")"
+6 SET BKMDFN=0
SET @TOTPTS=0
+7 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+8 IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12"))
QUIT
+9 SET VSTDT=""
+10 SET FOUND=0
+11 ; Find earliest CD4 Absolute with results between 50 and 199.
+12 FOR
SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12",VSTDT))
IF VSTDT=""
QUIT
Begin DoDot:2
+13 SET TEST=""
+14 FOR
SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12",VSTDT,TEST))
IF TEST=""
QUIT
Begin DoDot:3
+15 SET RESULT=$PIECE($GET(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12",VSTDT,TEST)),U)
+16 IF RESULT=""
QUIT
+17 IF RESULT'<200
QUIT
+18 ;I RESULT<50 Q
+19 SET FOUND=1
End DoDot:3
IF FOUND
QUIT
End DoDot:2
IF FOUND
QUIT
+20 IF 'FOUND
QUIT
+21 ; select meds prescribed since the defined CD4 visit
+22 DO MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,VSTDT,GLOBAL)
+23 DO NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,VSTDT,GLOBAL)
+24 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"PCP"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+25 QUIT
MAC ; EP - MAC Prophylaxis
+1 NEW SITETAX,NDCTAX,GLOBAL,BKMDFN,VSTDT,TEST,RESULT,TOTPTS,FOUND
+2 SET SITETAX="BKMV MAC PROPH MEDS"
+3 SET NDCTAX="BKMV MAC PROPH MED NDCS"
+4 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""MAC"",VSTDT,TEST)"
+5 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""MACPTCNT"")"
+6 SET BKMDFN=0
SET @TOTPTS=0
+7 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+8 IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12"))
QUIT
+9 SET VSTDT=""
+10 SET FOUND=0
+11 ; Find earliest CD4 Absolute with results less than 50.
+12 FOR
SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12",VSTDT))
IF VSTDT=""
QUIT
Begin DoDot:2
+13 SET TEST=""
+14 FOR
SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12",VSTDT,TEST))
IF TEST=""
QUIT
Begin DoDot:3
+15 SET RESULT=$GET(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12",VSTDT,TEST))
+16 IF RESULT=""
QUIT
+17 IF RESULT'<50
QUIT
+18 SET FOUND=1
End DoDot:3
IF FOUND
QUIT
End DoDot:2
IF FOUND
QUIT
+19 IF 'FOUND
QUIT
+20 ; select meds prescribed since the defined CD4 visit
+21 DO MEDTAX^BKMIXX(BKMDFN,SITETAX,EDATE,VSTDT,GLOBAL)
+22 DO NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,VSTDT,GLOBAL)
+23 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"MAC"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+24 QUIT
+25 ;
MEDLP(ARV) ; Loop through medications found and determine if they are active
+1 NEW VSTDT,TEST
+2 SET (VSTDT,TEST)=""
+3 FOR
SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,ARV,VSTDT))
IF 'VSTDT
QUIT
Begin DoDot:1
+4 FOR
SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,ARV,VSTDT,TEST))
IF 'TEST
QUIT
Begin DoDot:2
+5 IF '$$ACTMED(TEST)
KILL @GLOB@("HIVCHK",BKMDFN,ARV,VSTDT,TEST)
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
ACTMED(VMEDIEN) ;EP - Is this an active medication?
+1 ;*** only need VMEDIEN - all calls shd be revised ***
+2 ;
+3 ; Taken from APCHPMH3 and revised to be a self-contained extrinsic function
+4 ;
+5 ; Input:
+6 ; VMEDIEN - the V MEDICATION internal entry number
+7 ;
+8 ; Output:
+9 ; '1' if the rx is currently active
+10 ;
+11 NEW VMEDDATA,PSIEN,DCDT,EDATE,EXPDT,RXIEN,STOP,ACT,STAT
+12 IF '$DATA(^AUPNVMED(VMEDIEN,0))
QUIT 0
+13 SET VMEDDATA=^AUPNVMED(VMEDIEN,0)
SET PSIEN=$PIECE(VMEDDATA,U,1)
IF PSIEN=""
QUIT 0
+14 IF '$DATA(^PSDRUG(PSIEN))
QUIT 0
+15 ; use only the current date for medications to reduce the risk of a prescribing error
SET EDATE=DT
+16 ;date discontinued
SET DCDT=$PIECE(VMEDDATA,U,8)
IF DCDT'=""
IF DCDT'>EDATE
QUIT 0
+17 ;
+18 SET EXPDT=""
+19 ; Get Prescription ien
+20 SET RXIEN=$SELECT($DATA(^PSRX("APCC",VMEDIEN)):$ORDER(^PSRX("APCC",VMEDIEN,0)),1:0)
+21 IF RXIEN>0
IF '$DATA(^PSRX(RXIEN,"STA"))
SET ACT=0
Begin DoDot:1
+22 ; Is this an expired prescription?
+23 SET EXPDT=$PIECE($GET(^PSRX(RXIEN,2)),U,6)
+24 IF EXPDT
IF $$EXPMED(EDATE,EXPDT)
QUIT
+25 ; Calculate RX status if V6
+26 SET STAT=$$RXSTAT(RXIEN,EDATE)
+27 ; EXPIRED within acceptable timeframe
IF STAT=11
SET ACT=1
QUIT
+28 IF STAT>10
QUIT
+29 ; OUTSIDE MEDICATION (AORX mnemonic in the pharmacy package)
IF $PIECE($GET(^AUPNVMED(VMEDIEN,11)),U,8)'=""
SET ACT=1
QUIT
+30 ; ACTIVE
IF STAT=0
SET ACT=1
QUIT
+31 ; HOLD
IF STAT=3
SET ACT=1
QUIT
+32 ; SUSPENDED
IF STAT=5
SET ACT=1
QUIT
End DoDot:1
QUIT ACT
+33 ;
+34 ;Status is in "STA" node in V 7
SET STAT=$GET(^PSRX(RXIEN,"STA"))
+35 ;
+36 ;EXPIRED within acceptable timeframe
IF STAT=11
IF '$$EXPMED(RXIEN,EXPDT)
QUIT 1
+37 ; OUTSIDE MEDICATION (AORX mnemonic in the pharmacy package)
IF $PIECE($GET(^AUPNVMED(VMEDIEN,11)),U,8)'=""
QUIT 1
+38 ;ACTIVE
IF STAT=0
QUIT 1
+39 ;HOLD
IF STAT=3
QUIT 1
+40 ;SUSPENDED
IF STAT=5
QUIT 1
+41 QUIT 0
+42 ;
RXSTAT(RX,DATE) ; EP - return status of rx
+1 ;
+2 ; Taken from APCHPMH3 and revised to be a self-contained extrinsic function
+3 ;... APCHPMH3 had taken this from the PSOFUNC routine
+4 ; Note: piece 15 of ^PSRX(RX,0) is not documented in ^DD (probably pre-V 7)
+5 ;
+6 ; Input:
+7 ; RX - the PRESCRIPTION internal entry number
+8 ; DATE - date against which to compare the prescription expiration date
+9 ;
+10 NEW RX0,RX2,J,ST0,ST,ST1
+11 ;USING V7
IF $DATA(^PSRX(RX,"STA"))
QUIT ""
+12 IF RX'>0
QUIT ""
+13 SET DATE=$GET(DATE,DT)
+14 SET RX0=$GET(^PSRX(RX,0))
SET RX2=$GET(^PSRX(RX,2))
+15 SET J=RX
SET ST0=$PIECE(RX0,U,15)
IF ST0'=""
SET ST0=+ST0
+16 IF ST0<12
Begin DoDot:1
+17 SET ST1=$ORDER(^PS(52.5,"B",J,0))
IF ST1=""
QUIT
+18 IF $DATA(^PS(52.5,ST1,0))
IF '$GET(^PS(52.5,ST1,"P"))
SET ST0=5
End DoDot:1
+19 IF ST0<12
IF $PIECE(RX2,U,6)
IF $PIECE(RX2,U,6)'>DATE
SET ST0=11
+20 QUIT ST0
+21 ;
EXPMED(RXIEN,EXPDT) ; Is this an expired prescription?
+1 ; Chronic medications - greater than 120 days
+2 ; All other medications - greater than 14 days
+3 ;
+4 NEW CHR
+5 IF 'EXPDT
QUIT 0
+6 SET CHR=($$GET1^DIQ(52,RXIEN,9999999.02,"I")="Y")
+7 IF CHR
IF $$FMDIFF^XLFDT(EXPDT,DT)>120
QUIT 1
+8 IF 'CHR
IF $$FMDIFF^XLFDT(EXPDT,DT)>14
QUIT 1
+9 QUIT 0
