AZAXCAD ;IHS/PHXAO/AEF - CAD/STATIN STUDY DATA EXTRACT
;;1.0;ANNE'S SPECIAL ROUTINES;;MAR 23, 2004
;;
;;
;;THIS IS THE MODIFIED ROUTINE TO GET ALL PATIENTS WITH THE
;;SPECIFIED DIAGNOSES REGARDLESS OF WHETHER THEY ARE TAKING
;;STATIN DRUGS OR NOT
;;
DESC ;----- PROGRAM DESCRIPTION
;;
;; This routine loops through the VISIT file for the specified
;; date range and finds all patients who have a heart related
;; diagnosis and who are taking statin drugs.
;;
;;$$END
Q
EN ;----- MAIN ENTRY POINT
;
N AZAXD,AZAXDTS,AZAXI,AZAXP,AZAXPDTS,AZAXY
;
D ^XBKVAR
D HOME^%ZIS
;
K ^TMP("AZAX",$J)
;
D TXT
;
D DATES("VISIT DATE",.AZAXY)
Q:'AZAXY
S AZAXDTS=AZAXY
;
D DATES("DISPENSED DATE",.AZAXY)
Q:'AZAXY
S AZAXPDTS=AZAXY
;
D WAIT^DICD
;
D BLD(.AZAXI,.AZAXP,.AZAXD)
;
D LOOP1(AZAXDTS,.AZAXI,.AZAXP)
;
D LOOP2(AZAXPDTS,.AZAXD)
;
D LOOP3(AZAXPDTS,.AZAXD)
;
D FILE
;
K ^TMP("AZAX",$J)
;
Q
LOOP1(AZAXDTS,AZAXI,AZAXP) ;
;----- LOOP THROUGH VISIT FILE AND FIND ALL PATIENTS WITH HEART DX
;
; INCOMING:
; AZAXDTS = DATE RANGE IN BEG^END FORMAT
; AZAXI = ARRAY OF ICD DIAGNOSIS CODES TO BE SEARCHED FOR
; AZAXP = ARRAY OF ICD PROCEDURE CODES TO BE SEARCHED FOR
;
N AZAXBEG,AZAXDFN,AZAXDT,AZAXEND,AZAXICD0,AZAXICNA,AZAXVSD0
;
S AZAXBEG=$P(AZAXDTS,U)
S AZAXEND=$P(AZAXDTS,U,2)
S AZAXDT=AZAXBEG-1
;
F S AZAXDT=$O(^AUPNVSIT("B",AZAXDT)) Q:'AZAXDT Q:AZAXDT>AZAXEND D
. S AZAXVSD0=0
. F S AZAXVSD0=$O(^AUPNVSIT("B",AZAXDT,AZAXVSD0)) Q:'AZAXVSD0 D
. . S AZAXDFN=$P($G(^AUPNVSIT(AZAXVSD0,0)),U,5)
. . S AZAXICD0=$P($G(^AUPNVSIT(AZAXVSD0,11)),U,7) ;CODED CHIEF COMPLAINT
. . S AZAXICNA=$$ICD^AZAXCADU(AZAXICD0)
. . I $P(AZAXICNA,".")]"",$D(AZAXI($P(AZAXICNA,"."))) D SET1(AZAXVSD0,AZAXDFN,AZAXICNA)
. . D POV(AZAXVSD0,AZAXDFN,.AZAXI) ;CHECK PURPOSE OF VISITS
. . D PROC(AZAXVSD0,AZAXDFN,.AZAXP) ;CHECK PROCEDURES
Q
POV(AZAXVSD0,AZAXDFN,AZAXI) ;
;----- CHECK V POV FILE FOR PURPOSE OF VISITS
;
; INCOMING:
; AZAXDFN = PATIENT IEN
; AZAXI = ARRAY CONTAINING ICD DIAGNOSIS CODES
; AZAXVSD0 = VISIT IEN
;
N AZAXD0,AZAXICD0,AZAXICDNA
;
S AZAXD0=0
F S AZAXD0=$O(^AUPNVPOV("AD",AZAXVSD0,AZAXD0)) Q:'AZAXD0 D
. S AZAXICD0=$P($G(^AUPNVPOV(AZAXD0,0)),U)
. S AZAXICNA=$$ICD^AZAXCADU(AZAXICD0)
. Q:$P(AZAXICNA,".")']""
. Q:'$D(AZAXI($P(AZAXICNA,".")))
. D SET1(AZAXVSD0,AZAXDFN,AZAXICNA)
Q
PROC(AZAXVSD0,AZAXDFN,AZAXP) ;
;----- CHECK V PROCEDURE FILE FOR PROCEDURES
;
; INCOMING:
; AZAXDFN = PATIENT IEN
; AZAXP = ARRAY CONTAINING ICD PROCEDURE CODES
; AZAXVSD0 = VISIT IEN
;
N AZAXD0,AZAXICD0,AZAXICNA
;
S AZAXD0=0
F S AZAXD0=$O(^AUPNVPRC("AD",AZAXVSD0,AZAXD0)) Q:'AZAXD0 D
. S AZAXICD0=$P($G(^AUPNVPRC(AZAXD0,0)),U)
. S AZAXICNA=$$PICD^AZAXCADU(AZAXICD0)
. Q:AZAXICNA']""
. Q:'$D(AZAXP(AZAXICNA))
. D SET1(AZAXVSD0,AZAXDFN,AZAXICNA)
Q
SET1(AZAXVSD0,AZAXDFN,AZAXICNA) ;
;----- SET ICD DX DATA INTO ^TMP GLOBAL
;
; NOTE: The actual ICD name is being used to set this global
; since the ICD code could either be a diagnosis or
; procedure code. Using the IEN could cause problems
; as 2 different files are involved, i.e., the
; ICD DIAGNOSIS and the ICD OPERATION/PROCEDURE, could
; possibly share the same IEN for a diagnosis and procedure.
;
; INCOMING:
; AZAXDFN = PATIENT IEN
; AZAXVSD0 = VISIT IEN
; AZAXICNA = ICD CODE NAME (DX OR PROCEDURE)
;
N AZAXLOC,AZAXVSDT,Z
;
S AZAXVSDT=$$VISDT^AZAXCADU(AZAXVSD0)
S AZAXVSDT=$P(AZAXVSDT,".")
S AZAXLOC=$$LOC^AZAXCADU(AZAXVSD0)
;
S Z=""
S $P(Z,U)=$$UID^AZAXCADU(AZAXDFN) ;1-UNIQUE PATIENT ID
S $P(Z,U,2)=$$SEX^AZAXCADU(AZAXDFN) ;2-SEX
S $P(Z,U,3)=$$AGE^AZAXCADU(AZAXDFN) ;3-AGE
S $P(Z,U,4)=AZAXICNA ;4-ICD CODE
S $P(Z,U,5)=$$LOCN^AZAXCADU(AZAXLOC) ;5-LOCATION NAME
S $P(Z,U,6)=$$SLDATE^AZAXCADU(AZAXVSDT) ;6-VISIT DATE
S $P(Z,U,7)=$$SCAT^AZAXCADU($$SCATV^AZAXCADU(AZAXVSD0)) ;7-SERVICE CATEGORY
;
Q:'AZAXDFN
Q:'AZAXVSD0
Q:AZAXICNA']""
;
S ^TMP("AZAX",$J,$$SITE^AZAXCADU,AZAXDFN,"ICDS",AZAXVSD0,AZAXICNA,0)=Z
S ^TMP("AZAX",$J,$$SITE^AZAXCADU,"ICDS",0)=$G(^TMP("AZAX",$J,$$SITE^AZAXCADU,"ICDS",0))+1
Q
LOOP2(AZAXPDTS,AZAXD) ;
;----- LOOP THROUGH PRESCRIPTION FILE AND FIND ALL PATIENTS IN LOOP1
; WHO ARE PRESCRIBED THE SPECIFIED DRUGS
;
; INCOMING:
; AZAXPDTS = DISPENSED DATE RANGE IN BEG^END FORMAT
; AZAXD = ARRAY OF DRUG NAMES TO BE SEARCHED
;
; VARIABLES USED IN THIS SUBROUTINE:
; AZAXDFN = PATIENT IEN
; AZAXDGD0 = DRUG IEN
; AZAXDGNA = DRUG NAME
; AZAXPSD1 = PRESCRIPTION PROFILE IEN FROM PHARMACY PATIENT FILE
; AZAXRXD0 = PRESCRIPTION IEN
;
N AZAXDFN,AZAXPSD1,AZAXRXD0
;
Q:'$D(^TMP("AZAX",$J,"X"))
;
S AZAXDFN=0
F S AZAXDFN=$O(^TMP("AZAX",$J,"X",$$SITE^AZAXCADU,AZAXDFN)) Q:'AZAXDFN D
. S AZAXPSD1=0
. F S AZAXPSD1=$O(^PS(55,AZAXDFN,"P",AZAXPSD1)) Q:'AZAXPSD1 D
. . S AZAXRXD0=$G(^PS(55,AZAXDFN,"P",AZAXPSD1,0))
. . Q:'AZAXRXD0
. . Q:'$D(^TMP("AZAX",$J,$$SITE^AZAXCADU,AZAXDFN,"ICDS")) ;DON'T GET IF DOESN'T HAVE DX
. . D INITIAL(AZAXRXD0,AZAXPDTS)
. . D REFILLS(AZAXRXD0,AZAXPDTS)
. . D PARTIAL(AZAXRXD0,AZAXPDTS)
;
Q
INITIAL(AZAXRXD0,AZAXPDTS) ;
;----- PROCESS INITIAL PRESCRIPTION
;
N AZAXDGD0,AZAXDGNA,AZAXDSP
;
S AZAXDSP=$P($G(^PSRX(AZAXRXD0,2)),U,5)
Q:AZAXDSP<$P(AZAXPDTS,U)
Q:AZAXDSP>$P(AZAXPDTS,U,2)
;
S AZAXDGD0=$P($G(^PSRX(AZAXRXD0,0)),U,6)
Q:'AZAXDGD0
;
S AZAXDGNA=$$DRUG^AZAXCADU(AZAXDGD0)
Q:AZAXDGNA']""
Q:'$D(AZAXD($P(AZAXDGNA," ")))
;
D SET2A(AZAXRXD0)
Q
REFILLS(AZAXD0,AZAXPDTS) ;
;----- LOOP THROUGH PRESCRIPTION REFILLS
;
; AZAXD0 = PRESCRIPTION FILE IEN
;
N AZAXD1,AZAXDSP
;
S AZAXD1=0
F S AZAXD1=$O(^PSRX(AZAXD0,1,AZAXD1)) Q:'AZAXD1 D
. S AZAXDSP=$P($G(^PSRX(AZAXD0,1,AZAXD1,0)),U,19)
. Q:AZAXDSP<$P(AZAXPDTS,U)
. Q:AZAXDSP>$P(AZAXPDTS,U,2)
. D SET2B(AZAXD0,AZAXD1)
Q
PARTIAL(AZAXD0,AZAXPDTS) ;
;----- LOOP THROUGH PARTIAL PRESCRIPTION FILLS
;
; AZAXD0 = PRESCRIPTION FILE IEN
;
N AZAXD1,AZAXDSP
;
S AZAXD1=0
F S AZAXD1=$O(^PSRX(AZAXD0,"P",AZAXD1)) Q:'AZAXD1 D
. S AZAXDSP=$P($G(^PSRX(AZAXD0,"P",AZAXD1,0)),U,13)
. Q:AZAXDSP<$P(AZAXPDTS,U)
. Q:AZAXDSP>$P(AZAXPDTS,U,2)
. D SET2C(AZAXD0,AZAXD1)
Q
SET2A(AZAXD0) ;
;----- SET RX DATA INTO ^TMP GLOBAL
;
; INCOMING:
; AZAXD0 = PRESCRIPTION FILE IEN
;
N AZAXDATA,AZAXDFN,AZAXDSP,Z
;
S AZAXDATA=$G(^PSRX(AZAXD0,0))
S AZAXDFN=$P(AZAXDATA,U,2)
;
S Z=""
S $P(Z,U)=$$UID^AZAXCADU(AZAXDFN) ;1-UNIQUE PATIENT ID
S $P(Z,U,2)=$$DRUG^AZAXCADU($P(AZAXDATA,U,6)) ;2-DRUG NAME
S $P(Z,U,4)=$P(AZAXDATA,U,8) ;4-DAYS SUPPLIED
S $P(Z,U,6)=$P(AZAXDATA,U,7) ;6-QUANTITY
S $P(Z,U,7)=$P(AZAXDATA,U,10) ;7-SIG
S $P(Z,U,8)=$$LOCN^AZAXCADU($$LOCP^AZAXCADU(AZAXD0)) ;8-LOCATION
S $P(Z,U,9)=$$SCATP^AZAXCADU(AZAXD0) ;9-SERVICE CATEGORY
;
S AZAXDATA=$G(^PSRX(AZAXD0,2))
S AZAXDSP=$P(AZAXDATA,U,5)
;
S $P(Z,U,3)=$$SLDATE^AZAXCADU(AZAXDSP) ;3-DISPENSED DATE
S $P(Z,U,5)=$P(AZAXDATA,U,7) ;5-NDC
;
Q:'AZAXDFN
Q:'AZAXD0
Q:'AZAXDSP
;
S ^TMP("AZAX",$J,$$SITE^AZAXCADU,AZAXDFN,"DRUG",AZAXD0,AZAXDSP,0)=Z
S ^TMP("AZAX",$J,$$SITE^AZAXCADU,"DRUG",0)=$G(^TMP("AZAX",$J,$$SITE^AZAXCADU,"DRUG",0))+1
;
Q
SET2B(AZAXD0,AZAXD1) ;
;----- SET RX REFILL DATA INTO ^TMP GLOBAL
;
; INCOMING:
; AZAXD0 = PRESCRIPTION FILE IEN
; AZAXD1 = REFILL IEN
;
N AZAXDATA,AZAXDFN,AZAXDSP,Z
;
S AZAXDATA=$G(^PSRX(AZAXD0,0))
S AZAXDFN=$P(AZAXDATA,U,2)
;
S Z=""
S $P(Z,U)=$$UID^AZAXCADU(AZAXDFN) ;1-UNIQUE PATIENT ID
S $P(Z,U,2)=$$DRUG^AZAXCADU($P(AZAXDATA,U,6)) ;2-DRUG NAME
S $P(Z,U,7)=$P(AZAXDATA,U,10) ;7-SIG
S $P(Z,U,8)=$$LOCN^AZAXCADU($$LOCR^AZAXCADU(AZAXD0,AZAXD1)) ;8-LOCATION
S $P(Z,U,9)=$$SCATR^AZAXCADU(AZAXD0,AZAXD1) ;9-SERVICE CATEGORY
;
S AZAXDATA=$G(^PSRX(AZAXD0,1,AZAXD1,0))
S AZAXDSP=$P(AZAXDATA,U,19)
;
S $P(Z,U,3)=$$SLDATE^AZAXCADU(AZAXDSP) ;3-DISPENSED DATE
S $P(Z,U,4)=$P(AZAXDATA,U,10) ;4-DAYS SUPPLY
S $P(Z,U,5)=$P(AZAXDATA,U,13) ;5-NDC
S $P(Z,U,6)=$P(AZAXDATA,U,4) ;6-QTY
;
Q:'AZAXDFN
Q:'AZAXD0
Q:'AZAXDSP
;
S ^TMP("AZAX",$J,$$SITE^AZAXCADU,AZAXDFN,"DRUG",AZAXD0,AZAXDSP,0)=Z
S ^TMP("AZAX",$J,$$SITE^AZAXCADU,"DRUG",0)=$G(^TMP("AZAX",$J,$$SITE^AZAXCADU,"DRUG",0))+1
;
Q
SET2C(AZAXD0,AZAXD1) ;
;---- SET RX PARTIAL FILL DATA INTO ^TMP GLOBAL
;
; INCOMING:
; AZAXD0 = PRESCRIPTION FILE IEN
; AZAXD1 = PARTIAL FILL IEN
;
N AZAXDATA,AZAXDFN,AZAXDSP,Z
;
S AZAXDATA=$G(^PSRX(AZAXD0,0))
S AZAXDFN=$P(AZAXDATA,U,2)
;
S Z=""
S $P(Z,U)=$$UID^AZAXCADU(AZAXDFN) ;1-UNIQUE PATIENT ID
S $P(Z,U,2)=$$DRUG^AZAXCADU($P(AZAXDATA,U,6)) ;2-DRUG NAME
S $P(Z,U,7)=$P(AZAXDATA,U,10) ;7-SIG
;
S AZAXDATA=$G(^PSRX(AZAXD0,"P",AZAXD1,0))
S AZAXDSP=$P(AZAXDATA,U,13)
;
S $P(Z,U,3)=$$SLDATE^AZAXCADU(AZAXDSP) ;3-DISPENSED DATE
S $P(Z,U,4)=$P(AZAXDATA,U,10) ;4-DAYS SUPPLY
S $P(Z,U,5)=$P(AZAXDATA,U,12) ;5-NDC
S $P(Z,U,6)=$P(AZAXDATA,U,4) ;6-QTY
;
Q:'AZAXDFN
Q:'AZAXD0
Q:'AZAXDSP
;
S ^TMP("AZAX",$J,$$SITE^AZAXCADU,AZAXDFN,"DRUG",AZAXD0,AZAXDSP,0)=Z
S ^TMP("AZAX",$J,$$SITE^AZAXCADU,"DRUG",0)=$G(^TMP("AZAX",$J,$$SITE^AZAXCADU,"DRUG",0))+1
;
Q
LOOP3(AZAXPDTS,AZAXD) ;
;----- LOOP THROUGH VISIT FILE AND FIND PATIENTS TAKING SPECIFIED DRUGS
;
; INPUT:
; AZAXPDTS = PRESCRIPTION DATE RANGE IN BEG^END FORMAT
; AZAXD = ARRAY OF DRUGS NAMES TO BE SEARCHED
;
N AZAXBEG,AZAXDATA,AZAXDFN,AZAXDGNA,AZAXDT,AZAXEND,AZAXVMD0,AZAXVSD0
;
S AZAXBEG=$P(AZAXPDTS,U)
S AZAXEND=$P(AZAXPDTS,U,2)
S AZAXDT=AZAXBEG-1
;
F S AZAXDT=$O(^AUPNVSIT("B",AZAXDT)) Q:'AZAXDT Q:AZAXDT>AZAXEND D
. S AZAXVSD0=0
. F S AZAXVSD0=$O(^AUPNVSIT("B",AZAXDT,AZAXVSD0)) Q:'AZAXVSD0 D
. . S AZAXVMD0=0
. . F S AZAXVMD0=$O(^AUPNVMED("AD",AZAXVSD0,AZAXVMD0)) Q:'AZAXVMD0 D
. . . S AZAXDATA=$G(^AUPNVMED(AZAXVMD0,0))
. . . S AZAXDFN=$P(AZAXDATA,U,2)
. . . S AZAXDGNA=$$DRUG^AZAXCADU($P(AZAXDATA,U))
. . . Q:AZAXDGNA']""
. . . Q:'$D(AZAXD($P(AZAXDGNA," ")))
. . . Q:'$D(^TMP("AZAX",$J,$$SITE^AZAXCADU,AZAXDFN,"ICDS")) ;DON'T GET IF DOESN'T HAVE DX
. . . D SET3(AZAXVMD0)
;
Q
SET3(AZAXVMD0) ;
;----- SET V MEDICATION DATA INTO ^TMP GLOBAL
;
; INPUT:
; AZAXVMD0 = V MEDICATION FILE IEN
;
N AZAXDATA,AZAXDFN,AZAXDSP,Z
;
S AZAXDATA=$G(^AUPNVMED(AZAXVMD0,0))
S AZAXDFN=$P(AZAXDATA,U,2)
S AZAXDSP=$$VISDT^AZAXCADU($P(AZAXDATA,U,3))
;
S Z=""
S $P(Z,U)=$$UID^AZAXCADU(AZAXDFN) ;1-UNIQUE PATIENT ID
S $P(Z,U,2)=$$DRUG^AZAXCADU($P(AZAXDATA,U)) ;2-DRUG NAME
S $P(Z,U,3)=$$SLDATE^AZAXCADU($P(AZAXDSP,".")) ;3-DISPENSED DATE
S $P(Z,U,4)=$P(AZAXDATA,U,7) ;4-DAYS SUPPLIED
S $P(Z,U,5)=$$NDC^AZAXCADU($P(AZAXDATA,U)) ;5-NDC
S $P(Z,U,6)=$P(AZAXDATA,U,6) ;6-QUANTITY
S $P(Z,U,7)=$P(AZAXDATA,U,5) ;7-SIG
S $P(Z,U,8)=$$LOCN^AZAXCADU($$LOCVM^AZAXCADU(AZAXVMD0)) ;8-LOCATION
S $P(Z,U,9)=$$SCATVM^AZAXCADU(AZAXVMD0) ;9-SERVICE CATEGORY
;
Q:'AZAXDFN
Q:'AZAXVMD0
Q:'AZAXDSP
;
S ^TMP("AZAX",$J,$$SITE^AZAXCADU,AZAXDFN,"DRUG",AZAXVMD0,AZAXDSP,0)=Z
S ^TMP("AZAX",$J,$$SITE^AZAXCADU,"DRUG",0)=$G(^TMP("AZAX",$J,$$SITE^AZAXCADU,"DRUG",0))+1
Q
FILE ;
;----- WRITE ^TMP GLOBAL TO DATA FILES
;
N AZAXTYPE
;
F AZAXTYPE="DRUG","ICDS" D PUT(AZAXTYPE)
;
Q
PUT(AZAXTYPE) ;
;----- WRITE DATA FROM ^TMP FILE TO DATA FILE
;
N %FILE,AZAXD0,AZAXD1,AZAXD2,AZAXD3,AZAXFILE,AZAXOUT,AZAXPATH,X
;
I '$G(^TMP("AZAX",$J,$$SITE^AZAXCADU,AZAXTYPE,0)) D Q
. W !,"NO "_AZAXTYPE_" DATA FOUND!"
;
S AZAXFILE=$$FNAME^AZAXCADU(AZAXTYPE)
Q:AZAXFILE']""
;
S AZAXPATH=$$PATH^AZAXCADU($$SITE^AZAXCADU)
Q:AZAXPATH']""
;
D HFS^AZAXCADU(AZAXPATH,AZAXFILE,.%FILE,.AZAXOUT)
Q:$G(AZAXOUT)
;
U %FILE
;
S AZAXD0=0
F S AZAXD0=$O(^TMP("AZAX",$J,AZAXD0)) Q:'AZAXD0 D
. S AZAXD1=0
. F S AZAXD1=$O(^TMP("AZAX",$J,AZAXD0,AZAXD1)) Q:'AZAXD1 D
. . S AZAXD2=0
. . F S AZAXD2=$O(^TMP("AZAX",$J,AZAXD0,AZAXD1,AZAXTYPE,AZAXD2)) Q:'AZAXD2 D
. . . S AZAXD3=0
. . . F S AZAXD3=$O(^TMP("AZAX",$J,AZAXD0,AZAXD1,AZAXTYPE,AZAXD2,AZAXD3)) Q:'AZAXD3 D
. . . . S X=$G(^TMP("AZAX",$J,AZAXD0,AZAXD1,AZAXTYPE,AZAXD2,AZAXD3,0))
. . . . S X=$$FORMAT^AZAXCADU(X)
. . . . Q:X']""
. . . . W X
. . . . W !
;
D ^%ZISC
;
I $E($G(IOST),1,2)="C-" W !?5,"FILE "_AZAXFILE_" HAS BEEN CREATED"
;
Q
DATES(AZAXTXT,AZAXY) ;
;----- ASK DATE RANGE
;
; INPUT:
; AZAXTXT = PROMPT TEXT
;
; OUTPUT:
; AZAXY = BEGIN^END DATES
;
DL ;----- DATE LOOP
;
N AZAXBEG,AZAXEND,DIR,DIRUT,DTOUT,DUOUT,X,Y
;
W !
S AZAXY=""
S DIR(0)="DO^::E"
S DIR("A")="Begin with "_AZAXTXT
S DIR("?")="The "_AZAXTXT_" to include in the range"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
Q:Y=""
S AZAXBEG=Y
S DIR("A")="End with "_AZAXTXT
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
Q:Y=""
S AZAXEND=Y
I AZAXEND<AZAXBEG D G DL
. W *7,!?5,"ENDING DATE cannot be less than BEGINNING DATE"
S AZAXY=AZAXBEG_U_AZAXEND
Q
TXT ;----- PRINT OPTION TEXT
;
N I,X
F I=1:1 S X=$P($T(DESC+I),";",3) Q:X["$$END" W !,X
Q
BLD(AZAXI,AZAXP,AZAXD) ;
;----- BUILD ICD DX CODE, PROCEDURE CODE AND DRUG ARRAYS
;
N I,X
;
K AZAXICD,AZAXPRC,AZAXDRG
;
F I=1:1 S X=$P($T(I+I),";",3) Q:X']"" Q:X["$$END" S AZAXI(X)=""
F I=1:1 S X=$P($T(P+I),";",3) Q:X']"" Q:X["$$END" S AZAXP(X)=""
F I=1:1 S X=$P($T(D+I),";",3) Q:X']"" Q:X["$$END" S AZAXD(X)=""
Q
I ;----- ICD DIAGNOSIS CODES BEING SEARCHED:
;;410;ACUTE MYOCARDIAL INFARCTION
;;411;UNSTABLE ANGINA PECTORIS
;;412;PREVIOUS ACUTE MYOCARDIAL INFARCTION
;;413;ANGINA PECTORIS
;;414;OTHER CHRONIC ISCHEMIC HEART DISEASE
;;$$END
;
P ;----- ICD PROCEDURE CODES BEING SEARCHED:
;;45.82;PERCUTANEOUS TRANSLUMINAL CORONARY ANGIOPLASTY
;;$$END
;
D ;----- DRUGS BEING SEARCHED:
;;ATORVASTATIN;LIPITOR
;;LOVASTATIN;MEVACOR
;;ROSUVASTATIN;CRESTOR
;;PRAVASTATIN;PRAVACHOL
;;SIMVASTATIN;ZOCOR
;;FLUVASTATIN;LESCOL
;;CERIVASTATIN;BAYCOL
;;$$END
AZAXCAD ;IHS/PHXAO/AEF - CAD/STATIN STUDY DATA EXTRACT
+1 ;;1.0;ANNE'S SPECIAL ROUTINES;;MAR 23, 2004
+2 ;;
+3 ;;
+4 ;;THIS IS THE MODIFIED ROUTINE TO GET ALL PATIENTS WITH THE
+5 ;;SPECIFIED DIAGNOSES REGARDLESS OF WHETHER THEY ARE TAKING
+6 ;;STATIN DRUGS OR NOT
+7 ;;
DESC ;----- PROGRAM DESCRIPTION
+1 ;;
+2 ;; This routine loops through the VISIT file for the specified
+3 ;; date range and finds all patients who have a heart related
+4 ;; diagnosis and who are taking statin drugs.
+5 ;;
+6 ;;$$END
+7 QUIT
EN ;----- MAIN ENTRY POINT
+1 ;
+2 NEW AZAXD,AZAXDTS,AZAXI,AZAXP,AZAXPDTS,AZAXY
+3 ;
+4 DO ^XBKVAR
+5 DO HOME^%ZIS
+6 ;
+7 KILL ^TMP("AZAX",$JOB)
+8 ;
+9 DO TXT
+10 ;
+11 DO DATES("VISIT DATE",.AZAXY)
+12 IF 'AZAXY
QUIT
+13 SET AZAXDTS=AZAXY
+14 ;
+15 DO DATES("DISPENSED DATE",.AZAXY)
+16 IF 'AZAXY
QUIT
+17 SET AZAXPDTS=AZAXY
+18 ;
+19 DO WAIT^DICD
+20 ;
+21 DO BLD(.AZAXI,.AZAXP,.AZAXD)
+22 ;
+23 DO LOOP1(AZAXDTS,.AZAXI,.AZAXP)
+24 ;
+25 DO LOOP2(AZAXPDTS,.AZAXD)
+26 ;
+27 DO LOOP3(AZAXPDTS,.AZAXD)
+28 ;
+29 DO FILE
+30 ;
+31 KILL ^TMP("AZAX",$JOB)
+32 ;
+33 QUIT
LOOP1(AZAXDTS,AZAXI,AZAXP) ;
+1 ;----- LOOP THROUGH VISIT FILE AND FIND ALL PATIENTS WITH HEART DX
+2 ;
+3 ; INCOMING:
+4 ; AZAXDTS = DATE RANGE IN BEG^END FORMAT
+5 ; AZAXI = ARRAY OF ICD DIAGNOSIS CODES TO BE SEARCHED FOR
+6 ; AZAXP = ARRAY OF ICD PROCEDURE CODES TO BE SEARCHED FOR
+7 ;
+8 NEW AZAXBEG,AZAXDFN,AZAXDT,AZAXEND,AZAXICD0,AZAXICNA,AZAXVSD0
+9 ;
+10 SET AZAXBEG=$PIECE(AZAXDTS,U)
+11 SET AZAXEND=$PIECE(AZAXDTS,U,2)
+12 SET AZAXDT=AZAXBEG-1
+13 ;
+14 FOR
SET AZAXDT=$ORDER(^AUPNVSIT("B",AZAXDT))
IF 'AZAXDT
QUIT
IF AZAXDT>AZAXEND
QUIT
Begin DoDot:1
+15 SET AZAXVSD0=0
+16 FOR
SET AZAXVSD0=$ORDER(^AUPNVSIT("B",AZAXDT,AZAXVSD0))
IF 'AZAXVSD0
QUIT
Begin DoDot:2
+17 SET AZAXDFN=$PIECE($GET(^AUPNVSIT(AZAXVSD0,0)),U,5)
+18 ;CODED CHIEF COMPLAINT
SET AZAXICD0=$PIECE($GET(^AUPNVSIT(AZAXVSD0,11)),U,7)
+19 SET AZAXICNA=$$ICD^AZAXCADU(AZAXICD0)
+20 IF $PIECE(AZAXICNA,".")]""
IF $DATA(AZAXI($PIECE(AZAXICNA,".")))
DO SET1(AZAXVSD0,AZAXDFN,AZAXICNA)
+21 ;CHECK PURPOSE OF VISITS
DO POV(AZAXVSD0,AZAXDFN,.AZAXI)
+22 ;CHECK PROCEDURES
DO PROC(AZAXVSD0,AZAXDFN,.AZAXP)
End DoDot:2
End DoDot:1
+23 QUIT
POV(AZAXVSD0,AZAXDFN,AZAXI) ;
+1 ;----- CHECK V POV FILE FOR PURPOSE OF VISITS
+2 ;
+3 ; INCOMING:
+4 ; AZAXDFN = PATIENT IEN
+5 ; AZAXI = ARRAY CONTAINING ICD DIAGNOSIS CODES
+6 ; AZAXVSD0 = VISIT IEN
+7 ;
+8 NEW AZAXD0,AZAXICD0,AZAXICDNA
+9 ;
+10 SET AZAXD0=0
+11 FOR
SET AZAXD0=$ORDER(^AUPNVPOV("AD",AZAXVSD0,AZAXD0))
IF 'AZAXD0
QUIT
Begin DoDot:1
+12 SET AZAXICD0=$PIECE($GET(^AUPNVPOV(AZAXD0,0)),U)
+13 SET AZAXICNA=$$ICD^AZAXCADU(AZAXICD0)
+14 IF $PIECE(AZAXICNA,".")']""
QUIT
+15 IF '$DATA(AZAXI($PIECE(AZAXICNA,".")))
QUIT
+16 DO SET1(AZAXVSD0,AZAXDFN,AZAXICNA)
End DoDot:1
+17 QUIT
PROC(AZAXVSD0,AZAXDFN,AZAXP) ;
+1 ;----- CHECK V PROCEDURE FILE FOR PROCEDURES
+2 ;
+3 ; INCOMING:
+4 ; AZAXDFN = PATIENT IEN
+5 ; AZAXP = ARRAY CONTAINING ICD PROCEDURE CODES
+6 ; AZAXVSD0 = VISIT IEN
+7 ;
+8 NEW AZAXD0,AZAXICD0,AZAXICNA
+9 ;
+10 SET AZAXD0=0
+11 FOR
SET AZAXD0=$ORDER(^AUPNVPRC("AD",AZAXVSD0,AZAXD0))
IF 'AZAXD0
QUIT
Begin DoDot:1
+12 SET AZAXICD0=$PIECE($GET(^AUPNVPRC(AZAXD0,0)),U)
+13 SET AZAXICNA=$$PICD^AZAXCADU(AZAXICD0)
+14 IF AZAXICNA']""
QUIT
+15 IF '$DATA(AZAXP(AZAXICNA))
QUIT
+16 DO SET1(AZAXVSD0,AZAXDFN,AZAXICNA)
End DoDot:1
+17 QUIT
SET1(AZAXVSD0,AZAXDFN,AZAXICNA) ;
+1 ;----- SET ICD DX DATA INTO ^TMP GLOBAL
+2 ;
+3 ; NOTE: The actual ICD name is being used to set this global
+4 ; since the ICD code could either be a diagnosis or
+5 ; procedure code. Using the IEN could cause problems
+6 ; as 2 different files are involved, i.e., the
+7 ; ICD DIAGNOSIS and the ICD OPERATION/PROCEDURE, could
+8 ; possibly share the same IEN for a diagnosis and procedure.
+9 ;
+10 ; INCOMING:
+11 ; AZAXDFN = PATIENT IEN
+12 ; AZAXVSD0 = VISIT IEN
+13 ; AZAXICNA = ICD CODE NAME (DX OR PROCEDURE)
+14 ;
+15 NEW AZAXLOC,AZAXVSDT,Z
+16 ;
+17 SET AZAXVSDT=$$VISDT^AZAXCADU(AZAXVSD0)
+18 SET AZAXVSDT=$PIECE(AZAXVSDT,".")
+19 SET AZAXLOC=$$LOC^AZAXCADU(AZAXVSD0)
+20 ;
+21 SET Z=""
+22 ;1-UNIQUE PATIENT ID
SET $PIECE(Z,U)=$$UID^AZAXCADU(AZAXDFN)
+23 ;2-SEX
SET $PIECE(Z,U,2)=$$SEX^AZAXCADU(AZAXDFN)
+24 ;3-AGE
SET $PIECE(Z,U,3)=$$AGE^AZAXCADU(AZAXDFN)
+25 ;4-ICD CODE
SET $PIECE(Z,U,4)=AZAXICNA
+26 ;5-LOCATION NAME
SET $PIECE(Z,U,5)=$$LOCN^AZAXCADU(AZAXLOC)
+27 ;6-VISIT DATE
SET $PIECE(Z,U,6)=$$SLDATE^AZAXCADU(AZAXVSDT)
+28 ;7-SERVICE CATEGORY
SET $PIECE(Z,U,7)=$$SCAT^AZAXCADU($$SCATV^AZAXCADU(AZAXVSD0))
+29 ;
+30 IF 'AZAXDFN
QUIT
+31 IF 'AZAXVSD0
QUIT
+32 IF AZAXICNA']""
QUIT
+33 ;
+34 SET ^TMP("AZAX",$JOB,$$SITE^AZAXCADU,AZAXDFN,"ICDS",AZAXVSD0,AZAXICNA,0)=Z
+35 SET ^TMP("AZAX",$JOB,$$SITE^AZAXCADU,"ICDS",0)=$GET(^TMP("AZAX",$JOB,$$SITE^AZAXCADU,"ICDS",0))+1
+36 QUIT
LOOP2(AZAXPDTS,AZAXD) ;
+1 ;----- LOOP THROUGH PRESCRIPTION FILE AND FIND ALL PATIENTS IN LOOP1
+2 ; WHO ARE PRESCRIBED THE SPECIFIED DRUGS
+3 ;
+4 ; INCOMING:
+5 ; AZAXPDTS = DISPENSED DATE RANGE IN BEG^END FORMAT
+6 ; AZAXD = ARRAY OF DRUG NAMES TO BE SEARCHED
+7 ;
+8 ; VARIABLES USED IN THIS SUBROUTINE:
+9 ; AZAXDFN = PATIENT IEN
+10 ; AZAXDGD0 = DRUG IEN
+11 ; AZAXDGNA = DRUG NAME
+12 ; AZAXPSD1 = PRESCRIPTION PROFILE IEN FROM PHARMACY PATIENT FILE
+13 ; AZAXRXD0 = PRESCRIPTION IEN
+14 ;
+15 NEW AZAXDFN,AZAXPSD1,AZAXRXD0
+16 ;
+17 IF '$DATA(^TMP("AZAX",$JOB,"X"))
QUIT
+18 ;
+19 SET AZAXDFN=0
+20 FOR
SET AZAXDFN=$ORDER(^TMP("AZAX",$JOB,"X",$$SITE^AZAXCADU,AZAXDFN))
IF 'AZAXDFN
QUIT
Begin DoDot:1
+21 SET AZAXPSD1=0
+22 FOR
SET AZAXPSD1=$ORDER(^PS(55,AZAXDFN,"P",AZAXPSD1))
IF 'AZAXPSD1
QUIT
Begin DoDot:2
+23 SET AZAXRXD0=$GET(^PS(55,AZAXDFN,"P",AZAXPSD1,0))
+24 IF 'AZAXRXD0
QUIT
+25 ;DON'T GET IF DOESN'T HAVE DX
IF '$DATA(^TMP("AZAX",$JOB,$$SITE^AZAXCADU,AZAXDFN,"ICDS"))
QUIT
+26 DO INITIAL(AZAXRXD0,AZAXPDTS)
+27 DO REFILLS(AZAXRXD0,AZAXPDTS)
+28 DO PARTIAL(AZAXRXD0,AZAXPDTS)
End DoDot:2
End DoDot:1
+29 ;
+30 QUIT
INITIAL(AZAXRXD0,AZAXPDTS) ;
+1 ;----- PROCESS INITIAL PRESCRIPTION
+2 ;
+3 NEW AZAXDGD0,AZAXDGNA,AZAXDSP
+4 ;
+5 SET AZAXDSP=$PIECE($GET(^PSRX(AZAXRXD0,2)),U,5)
+6 IF AZAXDSP<$PIECE(AZAXPDTS,U)
QUIT
+7 IF AZAXDSP>$PIECE(AZAXPDTS,U,2)
QUIT
+8 ;
+9 SET AZAXDGD0=$PIECE($GET(^PSRX(AZAXRXD0,0)),U,6)
+10 IF 'AZAXDGD0
QUIT
+11 ;
+12 SET AZAXDGNA=$$DRUG^AZAXCADU(AZAXDGD0)
+13 IF AZAXDGNA']""
QUIT
+14 IF '$DATA(AZAXD($PIECE(AZAXDGNA," ")))
QUIT
+15 ;
+16 DO SET2A(AZAXRXD0)
+17 QUIT
REFILLS(AZAXD0,AZAXPDTS) ;
+1 ;----- LOOP THROUGH PRESCRIPTION REFILLS
+2 ;
+3 ; AZAXD0 = PRESCRIPTION FILE IEN
+4 ;
+5 NEW AZAXD1,AZAXDSP
+6 ;
+7 SET AZAXD1=0
+8 FOR
SET AZAXD1=$ORDER(^PSRX(AZAXD0,1,AZAXD1))
IF 'AZAXD1
QUIT
Begin DoDot:1
+9 SET AZAXDSP=$PIECE($GET(^PSRX(AZAXD0,1,AZAXD1,0)),U,19)
+10 IF AZAXDSP<$PIECE(AZAXPDTS,U)
QUIT
+11 IF AZAXDSP>$PIECE(AZAXPDTS,U,2)
QUIT
+12 DO SET2B(AZAXD0,AZAXD1)
End DoDot:1
+13 QUIT
PARTIAL(AZAXD0,AZAXPDTS) ;
+1 ;----- LOOP THROUGH PARTIAL PRESCRIPTION FILLS
+2 ;
+3 ; AZAXD0 = PRESCRIPTION FILE IEN
+4 ;
+5 NEW AZAXD1,AZAXDSP
+6 ;
+7 SET AZAXD1=0
+8 FOR
SET AZAXD1=$ORDER(^PSRX(AZAXD0,"P",AZAXD1))
IF 'AZAXD1
QUIT
Begin DoDot:1
+9 SET AZAXDSP=$PIECE($GET(^PSRX(AZAXD0,"P",AZAXD1,0)),U,13)
+10 IF AZAXDSP<$PIECE(AZAXPDTS,U)
QUIT
+11 IF AZAXDSP>$PIECE(AZAXPDTS,U,2)
QUIT
+12 DO SET2C(AZAXD0,AZAXD1)
End DoDot:1
+13 QUIT
SET2A(AZAXD0) ;
+1 ;----- SET RX DATA INTO ^TMP GLOBAL
+2 ;
+3 ; INCOMING:
+4 ; AZAXD0 = PRESCRIPTION FILE IEN
+5 ;
+6 NEW AZAXDATA,AZAXDFN,AZAXDSP,Z
+7 ;
+8 SET AZAXDATA=$GET(^PSRX(AZAXD0,0))
+9 SET AZAXDFN=$PIECE(AZAXDATA,U,2)
+10 ;
+11 SET Z=""
+12 ;1-UNIQUE PATIENT ID
SET $PIECE(Z,U)=$$UID^AZAXCADU(AZAXDFN)
+13 ;2-DRUG NAME
SET $PIECE(Z,U,2)=$$DRUG^AZAXCADU($PIECE(AZAXDATA,U,6))
+14 ;4-DAYS SUPPLIED
SET $PIECE(Z,U,4)=$PIECE(AZAXDATA,U,8)
+15 ;6-QUANTITY
SET $PIECE(Z,U,6)=$PIECE(AZAXDATA,U,7)
+16 ;7-SIG
SET $PIECE(Z,U,7)=$PIECE(AZAXDATA,U,10)
+17 ;8-LOCATION
SET $PIECE(Z,U,8)=$$LOCN^AZAXCADU($$LOCP^AZAXCADU(AZAXD0))
+18 ;9-SERVICE CATEGORY
SET $PIECE(Z,U,9)=$$SCATP^AZAXCADU(AZAXD0)
+19 ;
+20 SET AZAXDATA=$GET(^PSRX(AZAXD0,2))
+21 SET AZAXDSP=$PIECE(AZAXDATA,U,5)
+22 ;
+23 ;3-DISPENSED DATE
SET $PIECE(Z,U,3)=$$SLDATE^AZAXCADU(AZAXDSP)
+24 ;5-NDC
SET $PIECE(Z,U,5)=$PIECE(AZAXDATA,U,7)
+25 ;
+26 IF 'AZAXDFN
QUIT
+27 IF 'AZAXD0
QUIT
+28 IF 'AZAXDSP
QUIT
+29 ;
+30 SET ^TMP("AZAX",$JOB,$$SITE^AZAXCADU,AZAXDFN,"DRUG",AZAXD0,AZAXDSP,0)=Z
+31 SET ^TMP("AZAX",$JOB,$$SITE^AZAXCADU,"DRUG",0)=$GET(^TMP("AZAX",$JOB,$$SITE^AZAXCADU,"DRUG",0))+1
+32 ;
+33 QUIT
SET2B(AZAXD0,AZAXD1) ;
+1 ;----- SET RX REFILL DATA INTO ^TMP GLOBAL
+2 ;
+3 ; INCOMING:
+4 ; AZAXD0 = PRESCRIPTION FILE IEN
+5 ; AZAXD1 = REFILL IEN
+6 ;
+7 NEW AZAXDATA,AZAXDFN,AZAXDSP,Z
+8 ;
+9 SET AZAXDATA=$GET(^PSRX(AZAXD0,0))
+10 SET AZAXDFN=$PIECE(AZAXDATA,U,2)
+11 ;
+12 SET Z=""
+13 ;1-UNIQUE PATIENT ID
SET $PIECE(Z,U)=$$UID^AZAXCADU(AZAXDFN)
+14 ;2-DRUG NAME
SET $PIECE(Z,U,2)=$$DRUG^AZAXCADU($PIECE(AZAXDATA,U,6))
+15 ;7-SIG
SET $PIECE(Z,U,7)=$PIECE(AZAXDATA,U,10)
+16 ;8-LOCATION
SET $PIECE(Z,U,8)=$$LOCN^AZAXCADU($$LOCR^AZAXCADU(AZAXD0,AZAXD1))
+17 ;9-SERVICE CATEGORY
SET $PIECE(Z,U,9)=$$SCATR^AZAXCADU(AZAXD0,AZAXD1)
+18 ;
+19 SET AZAXDATA=$GET(^PSRX(AZAXD0,1,AZAXD1,0))
+20 SET AZAXDSP=$PIECE(AZAXDATA,U,19)
+21 ;
+22 ;3-DISPENSED DATE
SET $PIECE(Z,U,3)=$$SLDATE^AZAXCADU(AZAXDSP)
+23 ;4-DAYS SUPPLY
SET $PIECE(Z,U,4)=$PIECE(AZAXDATA,U,10)
+24 ;5-NDC
SET $PIECE(Z,U,5)=$PIECE(AZAXDATA,U,13)
+25 ;6-QTY
SET $PIECE(Z,U,6)=$PIECE(AZAXDATA,U,4)
+26 ;
+27 IF 'AZAXDFN
QUIT
+28 IF 'AZAXD0
QUIT
+29 IF 'AZAXDSP
QUIT
+30 ;
+31 SET ^TMP("AZAX",$JOB,$$SITE^AZAXCADU,AZAXDFN,"DRUG",AZAXD0,AZAXDSP,0)=Z
+32 SET ^TMP("AZAX",$JOB,$$SITE^AZAXCADU,"DRUG",0)=$GET(^TMP("AZAX",$JOB,$$SITE^AZAXCADU,"DRUG",0))+1
+33 ;
+34 QUIT
SET2C(AZAXD0,AZAXD1) ;
+1 ;---- SET RX PARTIAL FILL DATA INTO ^TMP GLOBAL
+2 ;
+3 ; INCOMING:
+4 ; AZAXD0 = PRESCRIPTION FILE IEN
+5 ; AZAXD1 = PARTIAL FILL IEN
+6 ;
+7 NEW AZAXDATA,AZAXDFN,AZAXDSP,Z
+8 ;
+9 SET AZAXDATA=$GET(^PSRX(AZAXD0,0))
+10 SET AZAXDFN=$PIECE(AZAXDATA,U,2)
+11 ;
+12 SET Z=""
+13 ;1-UNIQUE PATIENT ID
SET $PIECE(Z,U)=$$UID^AZAXCADU(AZAXDFN)
+14 ;2-DRUG NAME
SET $PIECE(Z,U,2)=$$DRUG^AZAXCADU($PIECE(AZAXDATA,U,6))
+15 ;7-SIG
SET $PIECE(Z,U,7)=$PIECE(AZAXDATA,U,10)
+16 ;
+17 SET AZAXDATA=$GET(^PSRX(AZAXD0,"P",AZAXD1,0))
+18 SET AZAXDSP=$PIECE(AZAXDATA,U,13)
+19 ;
+20 ;3-DISPENSED DATE
SET $PIECE(Z,U,3)=$$SLDATE^AZAXCADU(AZAXDSP)
+21 ;4-DAYS SUPPLY
SET $PIECE(Z,U,4)=$PIECE(AZAXDATA,U,10)
+22 ;5-NDC
SET $PIECE(Z,U,5)=$PIECE(AZAXDATA,U,12)
+23 ;6-QTY
SET $PIECE(Z,U,6)=$PIECE(AZAXDATA,U,4)
+24 ;
+25 IF 'AZAXDFN
QUIT
+26 IF 'AZAXD0
QUIT
+27 IF 'AZAXDSP
QUIT
+28 ;
+29 SET ^TMP("AZAX",$JOB,$$SITE^AZAXCADU,AZAXDFN,"DRUG",AZAXD0,AZAXDSP,0)=Z
+30 SET ^TMP("AZAX",$JOB,$$SITE^AZAXCADU,"DRUG",0)=$GET(^TMP("AZAX",$JOB,$$SITE^AZAXCADU,"DRUG",0))+1
+31 ;
+32 QUIT
LOOP3(AZAXPDTS,AZAXD) ;
+1 ;----- LOOP THROUGH VISIT FILE AND FIND PATIENTS TAKING SPECIFIED DRUGS
+2 ;
+3 ; INPUT:
+4 ; AZAXPDTS = PRESCRIPTION DATE RANGE IN BEG^END FORMAT
+5 ; AZAXD = ARRAY OF DRUGS NAMES TO BE SEARCHED
+6 ;
+7 NEW AZAXBEG,AZAXDATA,AZAXDFN,AZAXDGNA,AZAXDT,AZAXEND,AZAXVMD0,AZAXVSD0
+8 ;
+9 SET AZAXBEG=$PIECE(AZAXPDTS,U)
+10 SET AZAXEND=$PIECE(AZAXPDTS,U,2)
+11 SET AZAXDT=AZAXBEG-1
+12 ;
+13 FOR
SET AZAXDT=$ORDER(^AUPNVSIT("B",AZAXDT))
IF 'AZAXDT
QUIT
IF AZAXDT>AZAXEND
QUIT
Begin DoDot:1
+14 SET AZAXVSD0=0
+15 FOR
SET AZAXVSD0=$ORDER(^AUPNVSIT("B",AZAXDT,AZAXVSD0))
IF 'AZAXVSD0
QUIT
Begin DoDot:2
+16 SET AZAXVMD0=0
+17 FOR
SET AZAXVMD0=$ORDER(^AUPNVMED("AD",AZAXVSD0,AZAXVMD0))
IF 'AZAXVMD0
QUIT
Begin DoDot:3
+18 SET AZAXDATA=$GET(^AUPNVMED(AZAXVMD0,0))
+19 SET AZAXDFN=$PIECE(AZAXDATA,U,2)
+20 SET AZAXDGNA=$$DRUG^AZAXCADU($PIECE(AZAXDATA,U))
+21 IF AZAXDGNA']""
QUIT
+22 IF '$DATA(AZAXD($PIECE(AZAXDGNA," ")))
QUIT
+23 ;DON'T GET IF DOESN'T HAVE DX
IF '$DATA(^TMP("AZAX",$JOB,$$SITE^AZAXCADU,AZAXDFN,"ICDS"))
QUIT
+24 DO SET3(AZAXVMD0)
End DoDot:3
End DoDot:2
End DoDot:1
+25 ;
+26 QUIT
SET3(AZAXVMD0) ;
+1 ;----- SET V MEDICATION DATA INTO ^TMP GLOBAL
+2 ;
+3 ; INPUT:
+4 ; AZAXVMD0 = V MEDICATION FILE IEN
+5 ;
+6 NEW AZAXDATA,AZAXDFN,AZAXDSP,Z
+7 ;
+8 SET AZAXDATA=$GET(^AUPNVMED(AZAXVMD0,0))
+9 SET AZAXDFN=$PIECE(AZAXDATA,U,2)
+10 SET AZAXDSP=$$VISDT^AZAXCADU($PIECE(AZAXDATA,U,3))
+11 ;
+12 SET Z=""
+13 ;1-UNIQUE PATIENT ID
SET $PIECE(Z,U)=$$UID^AZAXCADU(AZAXDFN)
+14 ;2-DRUG NAME
SET $PIECE(Z,U,2)=$$DRUG^AZAXCADU($PIECE(AZAXDATA,U))
+15 ;3-DISPENSED DATE
SET $PIECE(Z,U,3)=$$SLDATE^AZAXCADU($PIECE(AZAXDSP,"."))
+16 ;4-DAYS SUPPLIED
SET $PIECE(Z,U,4)=$PIECE(AZAXDATA,U,7)
+17 ;5-NDC
SET $PIECE(Z,U,5)=$$NDC^AZAXCADU($PIECE(AZAXDATA,U))
+18 ;6-QUANTITY
SET $PIECE(Z,U,6)=$PIECE(AZAXDATA,U,6)
+19 ;7-SIG
SET $PIECE(Z,U,7)=$PIECE(AZAXDATA,U,5)
+20 ;8-LOCATION
SET $PIECE(Z,U,8)=$$LOCN^AZAXCADU($$LOCVM^AZAXCADU(AZAXVMD0))
+21 ;9-SERVICE CATEGORY
SET $PIECE(Z,U,9)=$$SCATVM^AZAXCADU(AZAXVMD0)
+22 ;
+23 IF 'AZAXDFN
QUIT
+24 IF 'AZAXVMD0
QUIT
+25 IF 'AZAXDSP
QUIT
+26 ;
+27 SET ^TMP("AZAX",$JOB,$$SITE^AZAXCADU,AZAXDFN,"DRUG",AZAXVMD0,AZAXDSP,0)=Z
+28 SET ^TMP("AZAX",$JOB,$$SITE^AZAXCADU,"DRUG",0)=$GET(^TMP("AZAX",$JOB,$$SITE^AZAXCADU,"DRUG",0))+1
+29 QUIT
FILE ;
+1 ;----- WRITE ^TMP GLOBAL TO DATA FILES
+2 ;
+3 NEW AZAXTYPE
+4 ;
+5 FOR AZAXTYPE="DRUG","ICDS"
DO PUT(AZAXTYPE)
+6 ;
+7 QUIT
PUT(AZAXTYPE) ;
+1 ;----- WRITE DATA FROM ^TMP FILE TO DATA FILE
+2 ;
+3 NEW %FILE,AZAXD0,AZAXD1,AZAXD2,AZAXD3,AZAXFILE,AZAXOUT,AZAXPATH,X
+4 ;
+5 IF '$GET(^TMP("AZAX",$JOB,$$SITE^AZAXCADU,AZAXTYPE,0))
Begin DoDot:1
+6 WRITE !,"NO "_AZAXTYPE_" DATA FOUND!"
End DoDot:1
QUIT
+7 ;
+8 SET AZAXFILE=$$FNAME^AZAXCADU(AZAXTYPE)
+9 IF AZAXFILE']""
QUIT
+10 ;
+11 SET AZAXPATH=$$PATH^AZAXCADU($$SITE^AZAXCADU)
+12 IF AZAXPATH']""
QUIT
+13 ;
+14 DO HFS^AZAXCADU(AZAXPATH,AZAXFILE,.%FILE,.AZAXOUT)
+15 IF $GET(AZAXOUT)
QUIT
+16 ;
+17 USE %FILE
+18 ;
+19 SET AZAXD0=0
+20 FOR
SET AZAXD0=$ORDER(^TMP("AZAX",$JOB,AZAXD0))
IF 'AZAXD0
QUIT
Begin DoDot:1
+21 SET AZAXD1=0
+22 FOR
SET AZAXD1=$ORDER(^TMP("AZAX",$JOB,AZAXD0,AZAXD1))
IF 'AZAXD1
QUIT
Begin DoDot:2
+23 SET AZAXD2=0
+24 FOR
SET AZAXD2=$ORDER(^TMP("AZAX",$JOB,AZAXD0,AZAXD1,AZAXTYPE,AZAXD2))
IF 'AZAXD2
QUIT
Begin DoDot:3
+25 SET AZAXD3=0
+26 FOR
SET AZAXD3=$ORDER(^TMP("AZAX",$JOB,AZAXD0,AZAXD1,AZAXTYPE,AZAXD2,AZAXD3))
IF 'AZAXD3
QUIT
Begin DoDot:4
+27 SET X=$GET(^TMP("AZAX",$JOB,AZAXD0,AZAXD1,AZAXTYPE,AZAXD2,AZAXD3,0))
+28 SET X=$$FORMAT^AZAXCADU(X)
+29 IF X']""
QUIT
+30 WRITE X
+31 WRITE !
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+32 ;
+33 DO ^%ZISC
+34 ;
+35 IF $EXTRACT($GET(IOST),1,2)="C-"
WRITE !?5,"FILE "_AZAXFILE_" HAS BEEN CREATED"
+36 ;
+37 QUIT
DATES(AZAXTXT,AZAXY) ;
+1 ;----- ASK DATE RANGE
+2 ;
+3 ; INPUT:
+4 ; AZAXTXT = PROMPT TEXT
+5 ;
+6 ; OUTPUT:
+7 ; AZAXY = BEGIN^END DATES
+8 ;
DL ;----- DATE LOOP
+1 ;
+2 NEW AZAXBEG,AZAXEND,DIR,DIRUT,DTOUT,DUOUT,X,Y
+3 ;
+4 WRITE !
+5 SET AZAXY=""
+6 SET DIR(0)="DO^::E"
+7 SET DIR("A")="Begin with "_AZAXTXT
+8 SET DIR("?")="The "_AZAXTXT_" to include in the range"
+9 DO ^DIR
+10 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+11 IF Y=""
QUIT
+12 SET AZAXBEG=Y
+13 SET DIR("A")="End with "_AZAXTXT
+14 DO ^DIR
+15 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+16 IF Y=""
QUIT
+17 SET AZAXEND=Y
+18 IF AZAXEND<AZAXBEG
Begin DoDot:1
+19 WRITE *7,!?5,"ENDING DATE cannot be less than BEGINNING DATE"
End DoDot:1
GOTO DL
+20 SET AZAXY=AZAXBEG_U_AZAXEND
+21 QUIT
TXT ;----- PRINT OPTION TEXT
+1 ;
+2 NEW I,X
+3 FOR I=1:1
SET X=$PIECE($TEXT(DESC+I),";",3)
IF X["$$END"
QUIT
WRITE !,X
+4 QUIT
BLD(AZAXI,AZAXP,AZAXD) ;
+1 ;----- BUILD ICD DX CODE, PROCEDURE CODE AND DRUG ARRAYS
+2 ;
+3 NEW I,X
+4 ;
+5 KILL AZAXICD,AZAXPRC,AZAXDRG
+6 ;
+7 FOR I=1:1
SET X=$PIECE($TEXT(I+I),";",3)
IF X']""
QUIT
IF X["$$END"
QUIT
SET AZAXI(X)=""
+8 FOR I=1:1
SET X=$PIECE($TEXT(P+I),";",3)
IF X']""
QUIT
IF X["$$END"
QUIT
SET AZAXP(X)=""
+9 FOR I=1:1
SET X=$PIECE($TEXT(D+I),";",3)
IF X']""
QUIT
IF X["$$END"
QUIT
SET AZAXD(X)=""
+10 QUIT
I ;----- ICD DIAGNOSIS CODES BEING SEARCHED:
+1 ;;410;ACUTE MYOCARDIAL INFARCTION
+2 ;;411;UNSTABLE ANGINA PECTORIS
+3 ;;412;PREVIOUS ACUTE MYOCARDIAL INFARCTION
+4 ;;413;ANGINA PECTORIS
+5 ;;414;OTHER CHRONIC ISCHEMIC HEART DISEASE
+6 ;;$$END
+7 ;
P ;----- ICD PROCEDURE CODES BEING SEARCHED:
+1 ;;45.82;PERCUTANEOUS TRANSLUMINAL CORONARY ANGIOPLASTY
+2 ;;$$END
+3 ;
D ;----- DRUGS BEING SEARCHED:
+1 ;;ATORVASTATIN;LIPITOR
+2 ;;LOVASTATIN;MEVACOR
+3 ;;ROSUVASTATIN;CRESTOR
+4 ;;PRAVASTATIN;PRAVACHOL
+5 ;;SIMVASTATIN;ZOCOR
+6 ;;FLUVASTATIN;LESCOL
+7 ;;CERIVASTATIN;BAYCOL
+8 ;;$$END
