Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BKMVSUP3

BKMVSUP3.m

Go to the documentation of this file. 
  1. BKMVSUP3 ;PRXM/HC/WOM - Continuation of BKMVSUP, HIV SUPPLEMENT; [ 1/19/2005 7:16 PM ] ; 10 Jun 2005  12:46 PM
  1.  ;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
  1.  Q
  1. RET(DFN) ; EP - Retrieve Eye taxonomies (P.03)
  1.  ; Several calls below used to use $H-360.
  1.  ; Replaced with BKMCKDT (FileMan format date).
  1.  N BKMCKDT,PRV,CLN
  1.  S BKMCKDT=$$FMADD^XLFDT(DT,-360)
  1.  K BKMT("EYE")
  1.  S GLOBAL="BKMT(""EYE"",VSTDT,TEST,""CPT"")"
  1.  D CPTTAX^BKMIXX(DFN,"BGP DM EYE EXAM CPTS","",BKMCKDT,GLOBAL)
  1.  D CPTTAX^BKMIXX(DFN,"BGP RETINAL EXAM CPTS","",BKMCKDT,GLOBAL)
  1.  S GLOBAL="BKMT(""EYE"",VSTDT,TEST,""EXAM"")"
  1.  D EXAMTAX^BKMIXX1(DFN,"03","",BKMCKDT,GLOBAL)
  1.  ; Added provider, clinic code and procedure checks
  1.  S GLOBAL="BKMT(""EYE"",VSTDT,TEST,""PRV"")"
  1.  ; Check provider codes
  1.  F PRV="79","24","08" D
  1.  . D PRVTAX^BKMIXX2(DFN,PRV,"",BKMCKDT,GLOBAL)
  1.  S GLOBAL="BKMT(""EYE"",VSTDT,TEST,""CLN"")"
  1.  ; Check clinic codes
  1.  F CLN="17","18","64","A2" D
  1.  . D CLNTAX^BKMIXX2(DFN,CLN,"",BKMCKDT,GLOBAL)
  1.  ; Check procedure code
  1.  ;D PROCTAX^BKMIXX2(DFN,95.02,"",BKMCKDT,GLOBAL)
  1.  D PRCTAX^BKMIXX1(DFN,"BQI EYE EXAM PROCS","",BKMCKDT,GLOBAL)
  1.  ; Check POVs
  1.  ;D POVTAX^BKMIXX2(DFN,"V72.0","",BKMCKDT,GLOBAL)
  1.  D ICDTAX^BKMIXX1(DFN,"BQI EYE EXAM DXS","",BKMCKDT,GLOBAL)
  1.  ; Print results
  1.  S LINE=" Dilated eye exam: "
  1.  D LTAXPRT^BKMVSUP1("EYE",1)
  1.  I $D(BKMT("EYE")) K BKMT("EYE") D UPD^BKMVSUP D UPD^BKMVSUP:LINE'="" Q
  1.  ; If no eye exams found check refusals
  1.  ; The following has been replaced with D REFUSAL^BKMIXX2 call
  1.  ; S EXIEN=$O(^AUTTEXAM("C","03",""))
  1.  ; I EXIEN S TST(EXIEN)="" W $$REF^BKMVSUP2(DFN,9999999.15,.TST)
  1.  D REFUSAL^BKMIXX2(DFN,9999999.15,"03","",BKMCKDT,GLOBAL)
  1.  ; Print results
  1.  D LTAXPRT^BKMVSUP1("EYE",1,1,1)
  1.  I '$D(BKMT("EYE")) S LINE=$$LINE^BKMVSUP(LINE,"Date:",24)
  1.  D UPD^BKMVSUP
  1.  I LNCNT>MAXCT D NEWPG^BKMVSUP
  1.  Q
  1. MAM(DFN) ; EP - Retrieve mammogram taxonomies
  1.  ; Several calls below used to use $H-360.
  1.  ; Replaced with BKMCKDT (FileMan format date).
  1.  N BKMCKDT
  1.  S BKMCKDT=$$FMADD^XLFDT(DT,-360)
  1.  ; *** Examine V Rad and V CPT; if others are needed will have to add
  1.  ; Q:$P(^DPT(DFN,0),U,2)'="F"  ; - removed and replaced with N/A as per IHS
  1.  S LINE=" Mammogram: "
  1.  I $P(^DPT(DFN,0),U,2)'="F" S LINE=LINE_"Not Applicable" Q  ;Females only
  1.  K BKMT("MAM")
  1.  S GLOBAL="BKMT(""MAM"",VSTDT,TEST,""PROC"")"
  1.  D PRCTAX^BKMIXX1(DFN,"BGP MAMMOGRAM PROCEDURES","",BKMCKDT,GLOBAL)
  1.  S GLOBAL="BKMT(""MAM"",VSTDT,TEST,""ICD"")"
  1.  D ICDTAX^BKMIXX1(DFN,"BGP MAMMOGRAM ICDS","",BKMCKDT,GLOBAL)
  1.  S GLOBAL="BKMT(""MAM"",VSTDT,TEST,""CPT"")"
  1.  D CPTTAX^BKMIXX(DFN,"BGP CPT MAMMOGRAM","",BKMCKDT,GLOBAL)
  1.  ; Additional check of V-Rad file for mammography.
  1.  S GLOBAL="BKMT(""MAM"",VSTDT,TEST,""RAD"")"
  1.  D RADTAX^BKMIXX1(DFN,"BGP CPT MAMMOGRAM","",BKMCKDT,GLOBAL)
  1.  I $D(BKMT("MAM")) D LTAXPRT^BKMVSUP1("MAM",1) K BKMT("MAM") D UPD^BKMVSUP:LINE'="" Q
  1.  D REFUSAL^BKMIXX2(DFN,71,"BGP CPT MAMMOGRAM","",BKMCKDT,GLOBAL)
  1.  ; Print results
  1.  D LTAXPRT^BKMVSUP1("MAM",1,1,1)
  1.  I '$D(BKMT("MAM")) S LINE=$$LINE^BKMVSUP(LINE,"Date:",24)
  1.  K BKMT("MAM")
  1.  I LINE'="" D UPD^BKMVSUP
  1.  Q
  1. DEN(DFN) ; EP - Dental exam
  1.  ; Several calls below used to use $H-360.
  1.  ; Replaced with BKMCKDT (FileMan format date).
  1.  N BKMCKDT
  1.  S BKMCKDT=$$FMADD^XLFDT(DT,-360)
  1.  K BKMT("DEN")
  1.  S GLOBAL="BKMT(""DEN"",VSTDT,TEST,""PRC"")"
  1.  D ICDTAX^BKMIXX1(DFN,"BKM DENTAL EXAMINATION","",BKMCKDT,GLOBAL)
  1.  S GLOBAL="BKMT(""DEN"",VSTDT,TEST,""ADA"")"
  1.  D ADATAX^BKMIXX(DFN,"BGP DENTAL EXAM DENTAL CODE","",BKMCKDT,GLOBAL)
  1.  S GLOBAL="BKMT(""DEN"",VSTDT,TEST,""EXAM"")"
  1.  D EXAMTAX^BKMIXX1(DFN,"30","",BKMCKDT,GLOBAL)
  1.  ; Print results
  1.  S LINE=" Dental exam: "
  1.  D LTAXPRT^BKMVSUP1("DEN",1)
  1.  I $D(BKMT("DEN")) K BKMT("DEN") D UPD^BKMVSUP D UPD^BKMVSUP:LINE'="" Q
  1.  ; If no dental exams found check refusals
  1.  ; The following has been replaced with D REFUSAL^BKMIXX2 call
  1.  ; S EXIEN=$O(^AUTTEXAM("C","30",""))
  1.  ; I EXIEN S TST(EXIEN)="" W $$REF^BKMVSUP2(DFN,9999999.15,.TST)
  1.  D REFUSAL^BKMIXX2(DFN,9999999.15,"30","",BKMCKDT,GLOBAL)
  1.  ; Print results
  1.  D LTAXPRT^BKMVSUP1("DEN",1,1,1)
  1.  I '$D(BKMT("DEN")) S LINE=$$LINE^BKMVSUP(LINE,"Date:",24)
  1.  D UPD^BKMVSUP
  1.  I LNCNT>MAXCT D NEWPG^BKMVSUP
  1.  Q
  1. DRUGS(DFN) ; EP - Get medications
  1.  D HAART(DFN)
  1.  D MAC(DFN)
  1.  D PCP(DFN)
  1.  D PRTMP(DFN)
  1.  D NEW(DFN)
  1.  F TYPE="MAC","PCP","NEW" K ^TMP("BKMSUPP",$J,TYPE)
  1.  Q
  1. HAART(DFN) ; GATHER HAART DRUG DATA (using Taxonomy)
  1.  N MEDDT,MEDIEN,DISC,STDT,SIG,QTY,DISPDT,RXNAME
  1.  K ^TMP("BKMSUPP",$J,"HAART") ;,^TMP("BKMSUPP",$J,"HAARTD")
  1.  S LINE=" Current ARV Medications (past 6 months): " D UPD^BKMVSUP
  1.  S GLOBAL="^TMP(""BKMSUPP"",$J,""HAART"",VSTDT,TEST)"
  1.  D NDCTAX^BKMIXX1(DFN,"BKMV EI MED NDCS","","",GLOBAL)
  1.  D MEDTAX^BKMIXX(DFN,"BKMV EI MEDS","","",GLOBAL)
  1.  D NDCTAX^BKMIXX1(DFN,"BKMV NNRTI MED NDCS","","",GLOBAL)
  1.  D MEDTAX^BKMIXX(DFN,"BKMV NNRTI MEDS","","",GLOBAL)
  1.  D NDCTAX^BKMIXX1(DFN,"BKMV NRTI MED NDCS","","",GLOBAL)
  1.  D MEDTAX^BKMIXX(DFN,"BKMV NRTI MEDS","","",GLOBAL)
  1.  D NDCTAX^BKMIXX1(DFN,"BKMV PI MED NDCS","","",GLOBAL)
  1.  D MEDTAX^BKMIXX(DFN,"BKMV PI MEDS","","",GLOBAL)
  1.  D NDCTAX^BKMIXX1(DFN,"BKMV II MED NDCS","","",GLOBAL)
  1.  D MEDTAX^BKMIXX(DFN,"BKMV II MEDS","","",GLOBAL)
  1.  D NDCTAX^BKMIXX1(DFN,"BKMV NRTI/NNRTI MED NDCS","","",GLOBAL)
  1.  D MEDTAX^BKMIXX(DFN,"BKMV NRTI/NNRTI MEDS","","",GLOBAL)
  1.  D NDCTAX^BKMIXX1(DFN,"BKMV NRTI COMBO MED NDCS","","",GLOBAL)
  1.  D MEDTAX^BKMIXX(DFN,"BKMV NRTI COMBO MEDS","","",GLOBAL)
  1.  D NDCTAX^BKMIXX1(DFN,"BKMV PI BOOSTER MED NDCS","","",GLOBAL)
  1.  D MEDTAX^BKMIXX(DFN,"BKMV PI BOOSTER MEDS","","",GLOBAL)
  1.  ; *** separate list into active and discontinued
  1.  ; *** NOTE: last 6 months for active HAART; **ALL** disc'd HAART
  1.  S MEDDT=""
  1.  F  S MEDDT=$O(^TMP("BKMSUPP",$J,"HAART",MEDDT)) Q:MEDDT=""  D
  1.  . S MEDIEN="" F  S MEDIEN=$O(^TMP("BKMSUPP",$J,"HAART",MEDDT,MEDIEN)) Q:MEDIEN=""  D
  1.  .. S DISC=$$GET1^DIQ(9000010.14,MEDIEN,.08,"I")
  1.  .. I DISC D
  1.  ... S BKMT("HAARTD",DISC,MEDDT,MEDIEN)="" ;Needed for flow sheet
  1.  ... ;S ^TMP("BKMSUPP",$J,"HAARTD",MEDDT,MEDIEN)=^TMP("BKMSUPP",$J,"HAART",MEDDT,MEDIEN)
  1.  ... K ^TMP("BKMSUPP",$J,"HAART",MEDDT,MEDIEN)
  1.  D DRPRT("HAART",$$FMADD^XLFDT(DT,-183))
  1.  I '$D(^TMP("BKMSUPP",$J,"HAART")) D
  1.  . ; Check refusals
  1.  . S GLOBAL="BKMT(""HAART"",VSTDT,TEST)"
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV EI MED NDCS","","",GLOBAL)
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV EI MEDS","","",GLOBAL)
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV NNRTI MED NDCS","","",GLOBAL)
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV NNRTI MEDS","","",GLOBAL)
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV NRTI MED NDCS","","",GLOBAL)
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV NRTI MEDS","","",GLOBAL)
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV PI MED NDCS","","",GLOBAL)
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV PI MEDS","","",GLOBAL)
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV II MED NDCS","","",GLOBAL)
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV II MEDS","","",GLOBAL)
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV NRTI/NNRTI MED NDCS","","",GLOBAL)
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV NRTI/NNRTI MEDS","","",GLOBAL)
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV NRTI COMBO MED NDCS","","",GLOBAL)
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV NRTI COMBO MEDS","","",GLOBAL)
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV PI BOOSTER MED NDCS","","",GLOBAL)
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV PI BOOSTER MEDS","","",GLOBAL)
  1.  . ; Print results
  1.  . D DRFPRT("HAART",1) K BKMT("HAART")
  1.  D UPD^BKMVSUP
  1.  ; Discontinued drugs were disabled as per IHS
  1.  ; S LINE=" Discontinued ARV Medications: [Data not currently available]"; ***
  1.  ; D UPD^BKMVSUP ;***
  1.  ; D DRPRT("HAARTD") ;inactivated print as per IHS
  1.  ; keep drugs to identify "other" drugs
  1.  Q
  1. MAC(DFN) ; GATHER MAC Prophylaxis DRUG DATA (using Taxonomy)
  1.  ; Several calls below used to use $H-183.
  1.  ; Replaced with BKMCKDT (FileMan format date).
  1.  N BKMCKDT
  1.  S BKMCKDT=$$FMADD^XLFDT(DT,-183)
  1.  I LNCNT>MAXCT D NEWPG^BKMVSUP
  1.  S GLOBAL="^TMP(""BKMSUPP"",$J,""MAC"",VSTDT,TEST)"
  1.  D NDCTAX^BKMIXX1(DFN,"BKMV MAC PROPH MED NDCS","",BKMCKDT,GLOBAL)
  1.  D MEDTAX^BKMIXX(DFN,"BKMV MAC PROPH MEDS","",BKMCKDT,GLOBAL)
  1.  I '$D(^TMP("BKMSUPP",$J,"MAC")) D
  1.  . ; Check refusals
  1.  . S GLOBAL="BKMT(""MAC"",VSTDT,TEST)"
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV MAC PROPH MED NDCS","","",GLOBAL)
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV MAC PROPH MEDS","","",GLOBAL)
  1.  ; keep drugs to identify "other" drugs
  1.  I LNCNT>MAXCT D NEWPG^BKMVSUP
  1.  Q
  1. PCP(DFN) ; GATHER PCP Prophylaxis DRUG DATA (using Taxonomy)
  1.  ; Several calls below used to use $H-183.
  1.  ; Replaced with BKMCKDT (FileMan format date).
  1.  N BKMCKDT
  1.  S BKMCKDT=$$FMADD^XLFDT(DT,-183)
  1.  S GLOBAL="^TMP(""BKMSUPP"",$J,""PCP"",VSTDT,TEST)"
  1.  D NDCTAX^BKMIXX1(DFN,"BKMV PCP PROPH MED NDCS","",BKMCKDT,GLOBAL)
  1.  D MEDTAX^BKMIXX(DFN,"BKMV PCP PROPH MEDS","",BKMCKDT,GLOBAL)
  1.  I '$D(^TMP("BKMSUPP",$J,"PCP")) D
  1.  . ; Check refusals
  1.  . S GLOBAL="BKMT(""PCP"",VSTDT,TEST)"
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV PCP PROPH MED NDCS","","",GLOBAL)
  1.  . D REFUSAL^BKMIXX2(DFN,50,"BKMV PCP PROPH MEDS","","",GLOBAL)
  1.  ; keep drugs to identify "new" drugs
  1.  I LNCNT>MAXCT D NEWPG^BKMVSUP
  1.  Q
  1. PRTMP(DFN) ; Combine MAC and PCP results for printing purposes
  1.  K ^TMP("BKMSUPP",$J,"MACPCP"),BKMT("MACPCP")
  1.  M ^TMP("BKMSUPP",$J,"MACPCP")=^TMP("BKMSUPP",$J,"MAC")
  1.  M ^TMP("BKMSUPP",$J,"MACPCP")=^TMP("BKMSUPP",$J,"PCP")
  1.  D UPD^BKMVSUP S LINE=" Prophylaxis Medications for MAC and/or PCP (past 6 months): "
  1.  D UPD^BKMVSUP
  1.  I $D(^TMP("BKMSUPP",$J,"MACPCP")) D DRPRT("MACPCP",$$FMADD^XLFDT(DT,-183))
  1.  I '$D(^TMP("BKMSUPP",$J,"MACPCP")) D
  1.  . M BKMT("MACPCP")=BKMT("MAC")
  1.  . M BKMT("MACPCP")=BKMT("PCP")
  1.  . D DRFPRT("MACPCP",1)
  1.  . K BKMT("PCP"),BKMT("MAC"),BKMT("MACPCP")
  1.  K ^TMP("BKMSUPP",$J,"MACPCP")
  1.  Q
  1. NEW(DFN) ; GATHER "New" DRUG DATA (drugs dispensed during last 6 mos excluding previously listed drugs)
  1.  ; Disabled as per IHS ***
  1.  Q
  1.  N TEST,VISIT,VSTDT,OLD,TYPE
  1.  S TEST=""
  1.  F  S TEST=$O(^AUPNVMED("AC",DFN,TEST)) Q:TEST=""  D
  1.  . S VISIT=$$GET1^DIQ(9000010.14,TEST,.03,"I")
  1.  . S VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")
  1.  . S OLD=""
  1.  . F TYPE="HAART","HAARTD","MAC","PCP" I $D(^TMP("BKMSUPP",$J,TYPE,VSTDT,TEST)) S OLD=1 Q
  1.  . Q:OLD
  1.  . ; Build same data string as BKMIXX* routines used in other sections.
  1.  . N MED,SIG,QTY,DAY
  1.  . S MED=$$GET1^DIQ(9000010.14,TEST,.01,"E")
  1.  . S SIG=$$GET1^DIQ(9000010.14,TEST,.05,"E")
  1.  . S QTY=$$GET1^DIQ(9000010.14,TEST,.06,"E")
  1.  . S DAY=$$GET1^DIQ(9000010.14,TEST,.07,"E")
  1.  . S ^TMP("BKMSUPP",$J,"NEW",VSTDT,TEST)=MED_U_SIG_U_QTY_U_DAY
  1.  D UPD^BKMVSUP
  1.  S LINE=" Any Other Medications prescribed (past 6 months): " D UPD^BKMVSUP
  1.  D DRPRT("NEW",$$FMADD^XLFDT(DT,-183))
  1.  I LNCNT>MAXCT D NEWPG^BKMVSUP
  1.  Q
  1. DRPRT(TYPE,STDT) ; Print Drugs
  1.  Q:'$D(^TMP("BKMSUPP",$J,TYPE))
  1.  N MEDDT,DISPDT,MEDIEN,SIG,QTY,RXIEN,RXNAME
  1.  S STDT=$G(STDT)
  1.  I STDT,'$O(^TMP("BKMSUPP",$J,TYPE,STDT-.01)) Q
  1.  I LNCNT>(MAXCT-2) D NEWPG^BKMVSUP
  1.  D UPD^BKMVSUP
  1.  S LINE="      [Date]",LINE=$$LINE^BKMVSUP(LINE,"[Med Name]",18)
  1.  S LINE=$$LINE^BKMVSUP(LINE,"[SIG]",50),LINE=$$LINE^BKMVSUP(LINE,"[Qty]",66)
  1.  S MEDDT="" F  S MEDDT=$O(^TMP("BKMSUPP",$J,TYPE,MEDDT),-1) Q:MEDDT<STDT!'MEDDT  D
  1.  . ; PRXM/HC/BHS - 11/01/2005 - Modified external date format to MM/DD/CCYY to eliminate time
  1.  . S DISPDT=$$FMTE^XLFDT(MEDDT\1,"5Z")
  1.  . S MEDIEN="" F  S MEDIEN=$O(^TMP("BKMSUPP",$J,TYPE,MEDDT,MEDIEN)) Q:MEDIEN=""  D
  1.  .. N TEMP
  1.  .. S TEMP=^TMP("BKMSUPP",$J,TYPE,MEDDT,MEDIEN)
  1.  .. S RXNAME=$P(TEMP,U,1),SIG=$P(TEMP,U,2),QTY=$P(TEMP,U,3)
  1.  .. D UPD^BKMVSUP
  1.  .. S LINE="      "_DISPDT,LINE=$$LINE^BKMVSUP(LINE,$E(RXNAME,1,30),18)
  1.  .. S LINE=$$LINE^BKMVSUP(LINE,$E(SIG,1,14),50),LINE=$$LINE^BKMVSUP(LINE,QTY,66)
  1.  .. I LNCNT>MAXCT D NEWPG^BKMVSUP
  1.  D UPD^BKMVSUP
  1.  I LNCNT>MAXCT D NEWPG^BKMVSUP
  1.  Q
  1.  ;
  1. DRFPRT(TYP,MAX) ; Print Drug Refusals
  1.  ; TYP = Type of test (subscript in BKMT array)
  1.  ; MAX = Maximum number of results to print
  1.  N DDT,CNT,Y,TST
  1.  S MAX=$G(MAX,1)
  1.  S (DDT,CNT)=""
  1.  F  S DDT=$O(BKMT(TYP,DDT),-1) Q:'DDT  D  Q:CNT>MAX
  1.  . S Y=$P($$FMTE^XLFDT(DDT,"5Z"),"@")
  1.  . S TST=""
  1.  . F  S TST=$O(BKMT(TYP,DDT,TST)) Q:TST=""  D  Q:CNT>MAX
  1.  .. S LINE=" Date: "_Y,LINE=$$LINE^BKMVSUP(LINE,"[Refusal Type: ",22)_$P(BKMT(TYP,DDT,TST),U)_"]"
  1.  .. S CNT=CNT+1
  1.  .. D UPD^BKMVSUP
  1.  .. I LNCNT>MAXCT D NEWPG^BKMVSUP
  1.  Q
  1.  ;
  1. PAUSE() ; EP - For screen displays pause and allow user to stop
  1.  ; Returns a 1 if the user elected to stop
  1.  ; Matches Health Summary
  1.  I IOST'["C-" Q 0
  1.  N READ
  1.  R !,"<>",READ:DTIME I '$T Q 1
  1.  I READ="^" Q 1
  1.  Q 0
  1.  ;
  1. XIT ; QUIT POINT
  1.  Q