AZAXCADB.m

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       ;