- AZAXCAD ;IHS/PHXAO/AEF - CAD/STATIN STUDY DATA EXTRACT
- ;;1.0;ANNE'S SPECIAL ROUTINES;;MAR 23, 2004
- ;;
- 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 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
- . . D MED(AZAXVSD0,.AZAXD) ;CHECK V MEDICATIONS FILE
- ;
- 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
- MED(AZAXVSD0,AZAXD) ;
- ;----- CHECK V MEDICATION FILE FOR DRUGS
- ;
- ; INCOMING:
- ; AZAXVSD0 = VISIT IEN
- ;
- S AZAXVMD0=0
- F S AZAXVMD0=$O(^AUPNMED("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(AZAXVSD0)
- Q
- . S AZAXDFN=$P(AZAXDATA,U,2)
- . S AZAXDSP=$$VSDT^AZAXCADU($P(AZAXDATA,U,3))
- . ;
- . S Z=""
- . S $P(Z,U)=$$UID^AZAXCADU(AZAXDFN) ;1-UNIQUE PATIENT ID
- . S $P(Z,U,2)=AZAXDGNA ;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,"VMED",AZAXVMD0,AZAXDSP,0)=Z
- 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
- 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
- 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,"DRUG",AZAXD0,AZAXDSP,0)=Z
- S ^TMP("AZAX",$J,"DRUG",0)=$G(^TMP("AZAX",$J,"DRUG",0))+1
- ;
- D SET5(AZAXDFN)
- ;
- 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,"DRUG",AZAXD0,AZAXDSP,0)=Z
- S ^TMP("AZAX",$J,"DRUG",0)=$G(^TMP("AZAX",$J,"DRUG",0))+1
- ;
- D SET5(AZAXDFN)
- ;
- 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,"DRUG",AZAXD0,AZAXDSP,0)=Z
- S ^TMP("AZAX",$J,"DRUG",0)=$G(^TMP("AZAX",$J,"DRUG",0))+1
- ;
- D SET5(AZAXDFN)
- ;
- 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=$$VSDT^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,"VMED",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,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(AZAXICD,AZAXPRC,AZAXDRG) ;
- ;----- 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:
- ;;;714;RHEUMATOID ARTHRITIS;*** TESTING - AEF *** REMOVE THIS LINE
- ;;;250;DIABETES;*** TESTING - AEF *** REMOVE THIS LINE
- ;;;$$END ;*** TESTING - AEF *** REMOVE THIS LINE
- ;;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:
- ;;;ASPIRIN;;*** TESTING - AEF *** REMOVE THIS LINE
- ;;;$$END ;*** TESTING - AEF *** REMOVE THIS LINE
- ;;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 ;;
- 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 FILE
- +23 ;
- +24 ;K ^TMP("AZAX",$J)
- +25 ;
- +26 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)
- +23 ;CHECK V MEDICATIONS FILE
- DO MED(AZAXVSD0,.AZAXD)
- End DoDot:2
- End DoDot:1
- +24 ;
- +25 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
- MED(AZAXVSD0,AZAXD) ;
- +1 ;----- CHECK V MEDICATION FILE FOR DRUGS
- +2 ;
- +3 ; INCOMING:
- +4 ; AZAXVSD0 = VISIT IEN
- +5 ;
- +6 SET AZAXVMD0=0
- +7 FOR
- SET AZAXVMD0=$ORDER(^AUPNMED("AD",AZAXVSD0,AZAXVMD0))
- IF 'AZAXVMD0
- QUIT
- Begin DoDot:1
- +8 SET AZAXDATA=$GET(^AUPNVMED(AZAXVMD0,0))
- +9 SET AZAXDGNA=$$DRUG^AZAXCADU($PIECE(AZAXDATA,U))
- +10 IF AZAXDGNA']""
- QUIT
- +11 IF '$DATA(AZAXD($PIECE(AZAXDGNA," ")))
- QUIT
- +12 DO SET6(AZAXVSD0)
- End DoDot:1
- +13 QUIT
- +14
- *** ERROR ***
- +15
- *** ERROR ***
- +16 ;