AZAXCAD ;IHS/PHXAO/AEF - CAD/STATIN STUDY DATA EXTRACT
;;1.0;ANNE'S SPECIAL ROUTINES;;MAR 23, 2004
;;
;;This is the original routine that was run and data submitted. Modifications
;;needed to be made so this one is being saved as a backup.
;;
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
EN ;----- MAIN ENTRY POINT
;
N AZAXD,AZAXDTS,AZAXI,AZAXP,AZAXPDTS,AZAXY
;
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 BLD(.AZAXI,.AZAXP,.AZAXD)
;
D LOOP1(AZAXDTS,.AZAXI,.AZAXP)
;
D LOOP2(AZAXPDTS,.AZAXD)
;
D LOOP3(AZAXPDTS,.AZAXD)
;
D LOOP4
;
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
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
. . 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 SET2(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 SET3(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 SET4(AZAXD0,AZAXD1)
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,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 AZAXDGNA=$$DRUG^AZAXCADU($P(AZAXDATA,U))
. . . Q:AZAXDGNA']""
. . . Q:'$D(AZAXD($P(AZAXDGNA," ")))
. . . D SET6(AZAXVMD0)
;
Q
LOOP4 ;
;----- LOOP THROUGH ^TMP GLOBAL AND FIND PATIENTS WITH BOTH THE DX AND RX
;
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
. . Q:'$D(^TMP("AZAX",$J,AZAXD0,AZAXD1,"I"))
. . Q:'$D(^TMP("AZAX",$J,AZAXD0,AZAXD1,"D"))
. . F AZAXTYPE="D","I" 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 AZAXTN=""
. . . . . I AZAXTYPE="D" S AZAXTN="DRUG"
. . . . . I AZAXTYPE="I" S AZAXTN="ICDS"
. . . . . Q:AZAXTN']""
. . . . . S Z=$G(^TMP("AZAX",$J,AZAXD0,AZAXD1,AZAXTYPE,AZAXD2,AZAXD3,0))
. . . . . S ^TMP("AZAX",$J,"F",AZAXD0,AZAXD1,AZAXTN,AZAXD2,AZAXD3,0)=Z
. . . . . S ^TMP("AZAX",$J,"F",0)=$G(^TMP("AZAX",$J,"F",0))+1
;
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 AZAXVSDT,Z
;
S AZAXVSDT=$$VISDT^AZAXCADU(AZAXVSD0)
S AZAXVSDT=$P(AZAXVSDT,".")
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)=$$LOC^AZAXCADU(AZAXVSD0) ;5-LOCATION
S $P(Z,U,6)=$$SLDATE^AZAXCADU(AZAXVSDT) ;6-VISIT DATE
;
Q:'AZAXDFN
Q:'AZAXVSD0
Q:AZAXICNA']""
;
;S ^TMP("AZAX",$J,"X",$$SITE^AZAXCADU,AZAXDFN,AZAXVSD0,AZAXICNA,0)=Z
S ^TMP("AZAX",$J,$$SITE^AZAXCADU,AZAXDFN,"I",AZAXVSD0,AZAXICNA,0)=Z
Q
SET2(AZAXD0) ;
;----- SET RX DATA INTO ^TMP GLOBAL
;
; INCOMING:
; AZAXD0 = PRESCRIPTION FILE IEN
;
N AZAXDATA,AZAXDFN,AZAXDSP,Z
;
S Z=""
S AZAXDATA=$G(^PSRX(AZAXD0,0))
S AZAXDFN=$P(AZAXDATA,U,2)
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 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,"D",AZAXD0,AZAXDSP,0)=Z
;
Q
SET3(AZAXD0,AZAXD1) ;
;----- SET RX REFILL DATA INTO ^TMP GLOBAL
;
; INCOMING:
; AZAXD0 = PRESCRIPTION FILE IEN
; AZAXD1 = REFILL IEN
;
N AZAXDATA,AZAXDFN,AZAXDSP,Z
;
S Z=""
S AZAXDATA=$G(^PSRX(AZAXD0,0))
S AZAXDFN=$P(AZAXDATA,U,2)
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,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,"D",AZAXD0,AZAXDSP,0)=Z
;
Q
SET4(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 Z=""
S AZAXDATA=$G(^PSRX(AZAXD0,0))
S AZAXDFN=$P(AZAXDATA,U,2)
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,"D",AZAXD0,AZAXDSP,0)=Z
;
Q
SET5(AZAXDFN) ;
;----- SETS ^TMP GLOBAL FOR PATIENTS WHO HAVE BOTH THE ICD AND THE DRUG
;
; INCOMING:
; AZAXDFN = PATIENT IEN
;
N AZAXICNA,AZAXVD0,Z
;
S AZAXVD0=0
F S AZAXVD0=$O(^TMP("AZAX",$J,"X",$$SITE^AZAXCADU,AZAXDFN,AZAXVD0)) Q:'AZAXVD0 D
. S AZAXICNA=""
. F S AZAXICNA=$O(^TMP("AZAX",$J,"X",$$SITE^AZAXCADU,AZAXDFN,AZAXVD0,AZAXICNA)) Q:AZAXICNA']"" D
. . S Z=$G(^TMP("AZAX",$J,"X",$$SITE^AZAXCADU,AZAXDFN,AZAXVD0,AZAXICNA,0))
. . S ^TMP("AZAX",$J,$$SITE^AZAXCADU,AZAXDFN,"ICDS",AZAXVD0,AZAXICNA,0)=Z
. . S ^TMP("AZAX",$J,"ICDS",0)=$G(^TMP("AZAX",$J,"ICDS",0))+1
Q
SET6(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
;
Q:'AZAXDFN
Q:'AZAXVMD0
Q:'AZAXDSP
;
S ^TMP("AZAX",$J,$$SITE^AZAXCADU,AZAXDFN,"D",AZAXVMD0,AZAXDSP,0)=Z
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,"F",0)) D Q
. W !,"NO 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,"F",AZAXD0)) Q:'AZAXD0 D
. S AZAXD1=0
. F S AZAXD1=$O(^TMP("AZAX",$J,"F",AZAXD0,AZAXD1)) Q:'AZAXD1 D
. . S AZAXD2=0
. . F S AZAXD2=$O(^TMP("AZAX",$J,"F",AZAXD0,AZAXD1,AZAXTYPE,AZAXD2)) Q:'AZAXD2 D
. . . S AZAXD3=0
. . . F S AZAXD3=$O(^TMP("AZAX",$J,"F",AZAXD0,AZAXD1,AZAXTYPE,AZAXD2,AZAXD3)) Q:'AZAXD3 D
. . . . S X=$G(^TMP("AZAX",$J,"F",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 ;;This is the original routine that was run and data submitted. Modifications
+4 ;;needed to be made so this one is being saved as a backup.
+5 ;;
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
EN ;----- MAIN ENTRY POINT
+1 ;
+2 NEW AZAXD,AZAXDTS,AZAXI,AZAXP,AZAXPDTS,AZAXY
+3 ;
+4 KILL ^TMP("AZAX",$JOB)
+5 ;
+6 DO TXT
+7 ;
+8 DO DATES("VISIT DATE",.AZAXY)
+9 IF 'AZAXY
QUIT
+10 SET AZAXDTS=AZAXY
+11 ;
+12 DO DATES("DISPENSED DATE",.AZAXY)
+13 IF 'AZAXY
QUIT
+14 SET AZAXPDTS=AZAXY
+15 ;
+16 DO BLD(.AZAXI,.AZAXP,.AZAXD)
+17 ;
+18 DO LOOP1(AZAXDTS,.AZAXI,.AZAXP)
+19 ;
+20 DO LOOP2(AZAXPDTS,.AZAXD)
+21 ;
+22 DO LOOP3(AZAXPDTS,.AZAXD)
+23 ;
+24 DO LOOP4
+25 ;
+26 DO FILE
+27 ;
+28 ;K ^TMP("AZAX",$J)
+29 ;
+30 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
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 DO INITIAL(AZAXRXD0,AZAXPDTS)
+26 DO REFILLS(AZAXRXD0,AZAXPDTS)
+27 DO PARTIAL(AZAXRXD0,AZAXPDTS)
End DoDot:2
End DoDot:1
+28 ;
+29 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 SET2(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 SET3(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 SET4(AZAXD0,AZAXD1)
End DoDot:1
+13 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,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 AZAXDGNA=$$DRUG^AZAXCADU($PIECE(AZAXDATA,U))
+20 IF AZAXDGNA']""
QUIT
+21 IF '$DATA(AZAXD($PIECE(AZAXDGNA," ")))
QUIT
+22 DO SET6(AZAXVMD0)
End DoDot:3
End DoDot:2
End DoDot:1
+23 ;
+24 QUIT
LOOP4 ;
+1 ;----- LOOP THROUGH ^TMP GLOBAL AND FIND PATIENTS WITH BOTH THE DX AND RX
+2 ;
+3 SET AZAXD0=0
+4 FOR
SET AZAXD0=$ORDER(^TMP("AZAX",$JOB,AZAXD0))
IF 'AZAXD0
QUIT
Begin DoDot:1
+5 SET AZAXD1=0
+6 FOR
SET AZAXD1=$ORDER(^TMP("AZAX",$JOB,AZAXD0,AZAXD1))
IF 'AZAXD1
QUIT
Begin DoDot:2
+7 IF '$DATA(^TMP("AZAX",$JOB,AZAXD0,AZAXD1,"I"))
QUIT
+8 IF '$DATA(^TMP("AZAX",$JOB,AZAXD0,AZAXD1,"D"))
QUIT
+9 FOR AZAXTYPE="D","I"
Begin DoDot:3
+10 SET AZAXD2=0
+11 FOR
SET AZAXD2=$ORDER(^TMP("AZAX",$JOB,AZAXD0,AZAXD1,AZAXTYPE,AZAXD2))
IF 'AZAXD2
QUIT
Begin DoDot:4
+12 SET AZAXD3=0
+13 FOR
SET AZAXD3=$ORDER(^TMP("AZAX",$JOB,AZAXD0,AZAXD1,AZAXTYPE,AZAXD2,AZAXD3))
IF 'AZAXD3
QUIT
Begin DoDot:5
+14 SET AZAXTN=""
+15 IF AZAXTYPE="D"
SET AZAXTN="DRUG"
+16 IF AZAXTYPE="I"
SET AZAXTN="ICDS"
+17 IF AZAXTN']""
QUIT
+18 SET Z=$GET(^TMP("AZAX",$JOB,AZAXD0,AZAXD1,AZAXTYPE,AZAXD2,AZAXD3,0))
+19 SET ^TMP("AZAX",$JOB,"F",AZAXD0,AZAXD1,AZAXTN,AZAXD2,AZAXD3,0)=Z
+20 SET ^TMP("AZAX",$JOB,"F",0)=$GET(^TMP("AZAX",$JOB,"F",0))+1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 ;
+22 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 AZAXVSDT,Z
+16 ;
+17 SET AZAXVSDT=$$VISDT^AZAXCADU(AZAXVSD0)
+18 SET AZAXVSDT=$PIECE(AZAXVSDT,".")
+19 ;1-UNIQUE PATIENT ID
SET $PIECE(Z,U)=$$UID^AZAXCADU(AZAXDFN)
+20 ;2-SEX
SET $PIECE(Z,U,2)=$$SEX^AZAXCADU(AZAXDFN)
+21 ;3-AGE
SET $PIECE(Z,U,3)=$$AGE^AZAXCADU(AZAXDFN)
+22 ;4-ICD CODE
SET $PIECE(Z,U,4)=AZAXICNA
+23 ;5-LOCATION
SET $PIECE(Z,U,5)=$$LOC^AZAXCADU(AZAXVSD0)
+24 ;6-VISIT DATE
SET $PIECE(Z,U,6)=$$SLDATE^AZAXCADU(AZAXVSDT)
+25 ;
+26 IF 'AZAXDFN
QUIT
+27 IF 'AZAXVSD0
QUIT
+28 IF AZAXICNA']""
QUIT
+29 ;
+30 ;S ^TMP("AZAX",$J,"X",$$SITE^AZAXCADU,AZAXDFN,AZAXVSD0,AZAXICNA,0)=Z
+31 SET ^TMP("AZAX",$JOB,$$SITE^AZAXCADU,AZAXDFN,"I",AZAXVSD0,AZAXICNA,0)=Z
+32 QUIT
SET2(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 Z=""
+9 SET AZAXDATA=$GET(^PSRX(AZAXD0,0))
+10 SET AZAXDFN=$PIECE(AZAXDATA,U,2)
+11 ;1-UNIQUE PATIENT ID
SET $PIECE(Z,U)=$$UID^AZAXCADU(AZAXDFN)
+12 ;2-DRUG NAME
SET $PIECE(Z,U,2)=$$DRUG^AZAXCADU($PIECE(AZAXDATA,U,6))
+13 ;4-DAYS SUPPLIED
SET $PIECE(Z,U,4)=$PIECE(AZAXDATA,U,8)
+14 ;6-QUANTITY
SET $PIECE(Z,U,6)=$PIECE(AZAXDATA,U,7)
+15 ;7-SIG
SET $PIECE(Z,U,7)=$PIECE(AZAXDATA,U,10)
+16 SET AZAXDATA=$GET(^PSRX(AZAXD0,2))
+17 SET AZAXDSP=$PIECE(AZAXDATA,U,5)
+18 ;3-DISPENSED DATE
SET $PIECE(Z,U,3)=$$SLDATE^AZAXCADU(AZAXDSP)
+19 ;5-NDC
SET $PIECE(Z,U,5)=$PIECE(AZAXDATA,U,7)
+20 ;
+21 IF 'AZAXDFN
QUIT
+22 IF 'AZAXD0
QUIT
+23 IF 'AZAXDSP
QUIT
+24 ;
+25 SET ^TMP("AZAX",$JOB,$$SITE^AZAXCADU,AZAXDFN,"D",AZAXD0,AZAXDSP,0)=Z
+26 ;
+27 QUIT
SET3(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 Z=""
+10 SET AZAXDATA=$GET(^PSRX(AZAXD0,0))
+11 SET AZAXDFN=$PIECE(AZAXDATA,U,2)
+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 ;7-SIG
SET $PIECE(Z,U,7)=$PIECE(AZAXDATA,U,10)
+15 SET AZAXDATA=$GET(^PSRX(AZAXD0,1,AZAXD1,0))
+16 SET AZAXDSP=$PIECE(AZAXDATA,U,19)
+17 ;3-DISPENSED DATE
SET $PIECE(Z,U,3)=$$SLDATE^AZAXCADU(AZAXDSP)
+18 ;4-DAYS SUPPLY
SET $PIECE(Z,U,4)=$PIECE(AZAXDATA,U,10)
+19 ;5-NDC
SET $PIECE(Z,U,5)=$PIECE(AZAXDATA,U,13)
+20 ;6-QTY
SET $PIECE(Z,U,6)=$PIECE(AZAXDATA,U,4)
+21 ;
+22 IF 'AZAXDFN
QUIT
+23 IF 'AZAXD0
QUIT
+24 IF 'AZAXDSP
QUIT
+25 ;
+26 SET ^TMP("AZAX",$JOB,$$SITE^AZAXCADU,AZAXDFN,"D",AZAXD0,AZAXDSP,0)=Z
+27 ;
+28 QUIT
SET4(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 Z=""
+10 SET AZAXDATA=$GET(^PSRX(AZAXD0,0))
+11 SET AZAXDFN=$PIECE(AZAXDATA,U,2)
+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 ;7-SIG
SET $PIECE(Z,U,7)=$PIECE(AZAXDATA,U,10)
+15 SET AZAXDATA=$GET(^PSRX(AZAXD0,"P",AZAXD1,0))
+16 SET AZAXDSP=$PIECE(AZAXDATA,U,13)
+17 ;3-DISPENSED DATE
SET $PIECE(Z,U,3)=$$SLDATE^AZAXCADU(AZAXDSP)
+18 ;4-DAYS SUPPLY
SET $PIECE(Z,U,4)=$PIECE(AZAXDATA,U,10)
+19 ;5-NDC
SET $PIECE(Z,U,5)=$PIECE(AZAXDATA,U,12)
+20 ;6-QTY
SET $PIECE(Z,U,6)=$PIECE(AZAXDATA,U,4)
+21 ;
+22 IF 'AZAXDFN
QUIT
+23 IF 'AZAXD0
QUIT
+24 IF 'AZAXDSP
QUIT
+25 ;
+26 SET ^TMP("AZAX",$JOB,$$SITE^AZAXCADU,AZAXDFN,"D",AZAXD0,AZAXDSP,0)=Z
+27 ;
+28 QUIT
SET5(AZAXDFN) ;
+1 ;----- SETS ^TMP GLOBAL FOR PATIENTS WHO HAVE BOTH THE ICD AND THE DRUG
+2 ;
+3 ; INCOMING:
+4 ; AZAXDFN = PATIENT IEN
+5 ;
+6 NEW AZAXICNA,AZAXVD0,Z
+7 ;
+8 SET AZAXVD0=0
+9 FOR
SET AZAXVD0=$ORDER(^TMP("AZAX",$JOB,"X",$$SITE^AZAXCADU,AZAXDFN,AZAXVD0))
IF 'AZAXVD0
QUIT
Begin DoDot:1
+10 SET AZAXICNA=""
+11 FOR
SET AZAXICNA=$ORDER(^TMP("AZAX",$JOB,"X",$$SITE^AZAXCADU,AZAXDFN,AZAXVD0,AZAXICNA))
IF AZAXICNA']""
QUIT
Begin DoDot:2
+12 SET Z=$GET(^TMP("AZAX",$JOB,"X",$$SITE^AZAXCADU,AZAXDFN,AZAXVD0,AZAXICNA,0))
+13 SET ^TMP("AZAX",$JOB,$$SITE^AZAXCADU,AZAXDFN,"ICDS",AZAXVD0,AZAXICNA,0)=Z
+14 SET ^TMP("AZAX",$JOB,"ICDS",0)=$GET(^TMP("AZAX",$JOB,"ICDS",0))+1
End DoDot:2
End DoDot:1
+15 QUIT
SET6(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 ;
+21 IF 'AZAXDFN
QUIT
+22 IF 'AZAXVMD0
QUIT
+23 IF 'AZAXDSP
QUIT
+24 ;
+25 SET ^TMP("AZAX",$JOB,$$SITE^AZAXCADU,AZAXDFN,"D",AZAXVMD0,AZAXDSP,0)=Z
+26 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,"F",0))
Begin DoDot:1
+6 WRITE !,"NO 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,"F",AZAXD0))
IF 'AZAXD0
QUIT
Begin DoDot:1
+21 SET AZAXD1=0
+22 FOR
SET AZAXD1=$ORDER(^TMP("AZAX",$JOB,"F",AZAXD0,AZAXD1))
IF 'AZAXD1
QUIT
Begin DoDot:2
+23 SET AZAXD2=0
+24 FOR
SET AZAXD2=$ORDER(^TMP("AZAX",$JOB,"F",AZAXD0,AZAXD1,AZAXTYPE,AZAXD2))
IF 'AZAXD2
QUIT
Begin DoDot:3
+25 SET AZAXD3=0
+26 FOR
SET AZAXD3=$ORDER(^TMP("AZAX",$JOB,"F",AZAXD0,AZAXD1,AZAXTYPE,AZAXD2,AZAXD3))
IF 'AZAXD3
QUIT
Begin DoDot:4
+27 SET X=$GET(^TMP("AZAX",$JOB,"F",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
