BKMVFAPI ;PRXM/HC/ALA - Autopopulate Code for iCare ; 15 Nov 2005 5:46 PM
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
EN(GLBREF,BKMDEC) ;EP - Entry point
;
;Description
; Find all the patients that would meet the HMS autopopulate logic
;Input
; GLBREF - Global reference where the data will be filed (^TMP("name",$j)
; BKMDEC - Include deceased patients
;
NEW REGISTER
S REGISTER=$$HIVIEN^BKMIXX3()
I REGISTER="" S BMXSEC="There is no HMS register defined." Q
;
;if we have to check for valid user
;I '$$VALID^BKMIXX3(DUZ) S BMXSEC="You are not a valid HMS user." Q
;
DXN ; Check the ICD9 Diagnosis taxonomies
K ^TMP("BKMARRAY",$J),^TMP("BKMPOP",$J)
D BLDTAX^BKMIXX5("BGP HIV/AIDS DXS","^TMP(""BKMARRAY"",$J)")
S DXN="" F S DXN=$O(^TMP("BKMARRAY",$J,DXN)) Q:DXN="" D
. S LIEN="" F S LIEN=$O(^AUPNVPOV("B",DXN,LIEN)) Q:LIEN="" D
.. S DFN=$P(^AUPNVPOV(LIEN,0),U,2)
.. I DFN="" Q
.. I 'BKMDEC,$$GET1^DIQ(2,DFN,.351,"I")'="" Q
.. I '$$HRN^BKMVUTL(DFN) Q
.. D NPAT(DFN)
. ;
. S LIEN="" F S LIEN=$O(^AUPNPROB("B",DXN,LIEN)) Q:LIEN="" D
.. S DFN=$P(^AUPNPROB(LIEN,0),U,2) I DFN="" Q
.. I 'BKMDEC,$$GET1^DIQ(2,DFN,.351,"I")'="" Q
.. I '$$HRN^BKMVUTL(DFN) Q
.. D NPAT(DFN)
;
K DXN,LIEN
;
MED ; Check the medication taxonomies
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BKMV NRTI MED NDCS","^TMP(""BKMARRAY"",$J)")
S MED="" F S MED=$O(^TMP("BKMARRAY",$J,MED)) Q:MED="" D FMD("BKMV NRTI MED NDCS")
D BLDTAX^BKMIXX5("BKMV NRTI MEDS","^TMP(""BKMARRAY"",$J)")
S MED="" F S MED=$O(^TMP("BKMARRAY",$J,MED)) Q:MED="" D FMD("BKMV NRTI MEDS")
D BLDTAX^BKMIXX5("BKMV NNRTI MED NDCS","^TMP(""BKMARRAY"",$J)")
S MED="" F S MED=$O(^TMP("BKMARRAY",$J,MED)) Q:MED="" D FMD("BKMV NNRTI MED NDCS")
D BLDTAX^BKMIXX5("BKMV NNRTI MEDS","^TMP(""BKMARRAY"",$J)")
S MED="" F S MED=$O(^TMP("BKMARRAY",$J,MED)) Q:MED="" D FMD("BKMV NNRTI MEDS")
D BLDTAX^BKMIXX5("BKMV PI MED NDCS","^TMP(""BKMARRAY"",$J)")
S MED="" F S MED=$O(^TMP("BKMARRAY",$J,MED)) Q:MED="" D FMD("BKMV PI MED NDCS")
D BLDTAX^BKMIXX5("BKMV PI MEDS","^TMP(""BKMARRAY"",$J)")
S MED="" F S MED=$O(^TMP("BKMARRAY",$J,MED)) Q:MED="" D FMD("BKMV PI MEDS")
D BLDTAX^BKMIXX5("BKMV EI MED NDCS","^TMP(""BKMARRAY"",$J)")
S MED="" F S MED=$O(^TMP("BKMARRAY",$J,MED)) Q:MED="" D FMD("BKMV EI MED NDCS")
D BLDTAX^BKMIXX5("BKMV EI MEDS","^TMP(""BKMARRAY"",$J)")
S MED="" F S MED=$O(^TMP("BKMARRAY",$J,MED)) Q:MED="" D FMD("BKMV EI MEDS")
K ^TMP($J,"BKMVMEDS")
;
LAB ; Check the lab, CPT, and LOINC codes in the Lab V-File.
;
; Build the lab tests from taxonomies to check
K ^TMP("BKMARRAY",$J),^TMP("BKMCPT",$J)
D BLDTAX^BKMIXX5("BGP HIV TEST TAX","^TMP(""BKMARRAY"",$J)")
S LAB="" F S LAB=$O(^TMP("BKMARRAY",$J,LAB)) Q:LAB="" D FLB("BGP HIV TEST TAX")
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BGP HIV TEST LOINC CODES","^TMP(""BKMARRAY"",$J)")
S LAB="" F S LAB=$O(^TMP("BKMARRAY",$J,LAB)) Q:LAB="" D FLB("BGP HIV TEST LOINC CODES")
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BGP CPT HIV TESTS","^TMP(""BKMCPT"",$J)")
S CPT="" F S CPT=$O(^TMP("BKMCPT",$J,CPT)) Q:CPT="" D
. S BCPTR=0 F S BCPTR=$O(^BLRCPT(BCPTR)) Q:'BCPTR D
.. I $D(^BLRCPT(BCPTR,11,"B",CPT)) S LAB=$P($G(^BLRCPT(BCPTR,1)),U,1) I LAB'="" S ^TMP("BKMARRAY",$J,LAB)=$P(^LAB(60,LAB,0),U,1)
K ^TMP("BKMCPT",$J),CPT,BCPTR
S LAB="" F S LAB=$O(^TMP("BKMARRAY",$J,LAB)) Q:LAB="" D FLB("BGP CPT HIV TESTS")
;
XIT ;KILL LOCALS AND EXIT
D ^XBFMK
K DIR,REGISTER,BKM,FOUND,LOINC,MED,VMEDIEN,Y,ZTDESC,ZTIO,ZTSAVE
K STATUS,ZTRTN,ZTSK,AIDX,AIEN,AOK,DXN,HIDX,HIEN,LIEN,QFL,VISDTM,VISIT
K ^TMP("BKMPOP",$J),^TMP("BKMARRAY",$J),^TMP("BKMTST",$J)
K ^TMP("BKMAIDS",$J),^TMP("BKMHIV",$J),^TMP("BKMCD4",$J)
K DCT,DIAGCAT,HAIDSDT,IAIDSDT,RDATE,LAB,RDA,SBFILE,SUBFIL,XCNP,IGNORE
K BKCIEN,BKMIEN,BKMPOPDT,DFN,ERR,ERROR,BCPTR,CPT,ENTRY,BKMDEC
Q
;
FMD(MTAX) ; Find Medications
NEW LIEN
S LIEN="" F S LIEN=$O(^AUPNVMED("B",MED,LIEN)) Q:LIEN="" D
. S DFN=$P(^AUPNVMED(LIEN,0),U,2)
. I DFN="" Q
. I 'BKMDEC,$$GET1^DIQ(2,DFN,.351,"I")'="" Q
. I '$$HRN^BKMVUTL(DFN) Q
. S ^TMP($J,"BKMVMEDS",DFN)=$G(^TMP($J,"BKMVMEDS",DFN))+1
. Q
S DFN="" F S DFN=$O(^TMP($J,"BKMVMEDS",DFN)) Q:DFN="" D
. I $G(^TMP($J,"BKMVMEDS",DFN))>1 D NPAT(DFN)
K ^TMP($J,"BKMVMEDS",DFN),^TMP("BKMARRAY",$J)
K DFN,MTAX
Q
;
FLB(LTAX) ; Find Lab tests
NEW LIEN
S LIEN="" F S LIEN=$O(^AUPNVLAB("B",LAB,LIEN)) Q:LIEN="" D
. S DFN=$P(^AUPNVLAB(LIEN,0),U,2)
. I DFN="" Q
. I 'BKMDEC,$$GET1^DIQ(2,DFN,.351,"I")'="" Q
. I '$$HRN^BKMVUTL(DFN) Q
. S RESULT=$$GET1^DIQ(9000010.09,LIEN,.04,"E") Q:RESULT=""
. I $$POSITIVE^BKMVF32(RESULT) D NPAT(DFN)
K LIEN,LTAX,RESULT,DFN
Q
;
NPAT(DFN) ;
S @GLBREF@(DFN,0)=""
Q
BKMVFAPI ;PRXM/HC/ALA - Autopopulate Code for iCare ; 15 Nov 2005 5:46 PM
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
EN(GLBREF,BKMDEC) ;EP - Entry point
+1 ;
+2 ;Description
+3 ; Find all the patients that would meet the HMS autopopulate logic
+4 ;Input
+5 ; GLBREF - Global reference where the data will be filed (^TMP("name",$j)
+6 ; BKMDEC - Include deceased patients
+7 ;
+8 NEW REGISTER
+9 SET REGISTER=$$HIVIEN^BKMIXX3()
+10 IF REGISTER=""
SET BMXSEC="There is no HMS register defined."
QUIT
+11 ;
+12 ;if we have to check for valid user
+13 ;I '$$VALID^BKMIXX3(DUZ) S BMXSEC="You are not a valid HMS user." Q
+14 ;
DXN ; Check the ICD9 Diagnosis taxonomies
+1 KILL ^TMP("BKMARRAY",$JOB),^TMP("BKMPOP",$JOB)
+2 DO BLDTAX^BKMIXX5("BGP HIV/AIDS DXS","^TMP(""BKMARRAY"",$J)")
+3 SET DXN=""
FOR
SET DXN=$ORDER(^TMP("BKMARRAY",$JOB,DXN))
IF DXN=""
QUIT
Begin DoDot:1
+4 SET LIEN=""
FOR
SET LIEN=$ORDER(^AUPNVPOV("B",DXN,LIEN))
IF LIEN=""
QUIT
Begin DoDot:2
+5 SET DFN=$PIECE(^AUPNVPOV(LIEN,0),U,2)
+6 IF DFN=""
QUIT
+7 IF 'BKMDEC
IF $$GET1^DIQ(2,DFN,.351,"I")'=""
QUIT
+8 IF '$$HRN^BKMVUTL(DFN)
QUIT
+9 DO NPAT(DFN)
End DoDot:2
+10 ;
+11 SET LIEN=""
FOR
SET LIEN=$ORDER(^AUPNPROB("B",DXN,LIEN))
IF LIEN=""
QUIT
Begin DoDot:2
+12 SET DFN=$PIECE(^AUPNPROB(LIEN,0),U,2)
IF DFN=""
QUIT
+13 IF 'BKMDEC
IF $$GET1^DIQ(2,DFN,.351,"I")'=""
QUIT
+14 IF '$$HRN^BKMVUTL(DFN)
QUIT
+15 DO NPAT(DFN)
End DoDot:2
End DoDot:1
+16 ;
+17 KILL DXN,LIEN
+18 ;
MED ; Check the medication taxonomies
+1 KILL ^TMP("BKMARRAY",$JOB)
+2 DO BLDTAX^BKMIXX5("BKMV NRTI MED NDCS","^TMP(""BKMARRAY"",$J)")
+3 SET MED=""
FOR
SET MED=$ORDER(^TMP("BKMARRAY",$JOB,MED))
IF MED=""
QUIT
DO FMD("BKMV NRTI MED NDCS")
+4 DO BLDTAX^BKMIXX5("BKMV NRTI MEDS","^TMP(""BKMARRAY"",$J)")
+5 SET MED=""
FOR
SET MED=$ORDER(^TMP("BKMARRAY",$JOB,MED))
IF MED=""
QUIT
DO FMD("BKMV NRTI MEDS")
+6 DO BLDTAX^BKMIXX5("BKMV NNRTI MED NDCS","^TMP(""BKMARRAY"",$J)")
+7 SET MED=""
FOR
SET MED=$ORDER(^TMP("BKMARRAY",$JOB,MED))
IF MED=""
QUIT
DO FMD("BKMV NNRTI MED NDCS")
+8 DO BLDTAX^BKMIXX5("BKMV NNRTI MEDS","^TMP(""BKMARRAY"",$J)")
+9 SET MED=""
FOR
SET MED=$ORDER(^TMP("BKMARRAY",$JOB,MED))
IF MED=""
QUIT
DO FMD("BKMV NNRTI MEDS")
+10 DO BLDTAX^BKMIXX5("BKMV PI MED NDCS","^TMP(""BKMARRAY"",$J)")
+11 SET MED=""
FOR
SET MED=$ORDER(^TMP("BKMARRAY",$JOB,MED))
IF MED=""
QUIT
DO FMD("BKMV PI MED NDCS")
+12 DO BLDTAX^BKMIXX5("BKMV PI MEDS","^TMP(""BKMARRAY"",$J)")
+13 SET MED=""
FOR
SET MED=$ORDER(^TMP("BKMARRAY",$JOB,MED))
IF MED=""
QUIT
DO FMD("BKMV PI MEDS")
+14 DO BLDTAX^BKMIXX5("BKMV EI MED NDCS","^TMP(""BKMARRAY"",$J)")
+15 SET MED=""
FOR
SET MED=$ORDER(^TMP("BKMARRAY",$JOB,MED))
IF MED=""
QUIT
DO FMD("BKMV EI MED NDCS")
+16 DO BLDTAX^BKMIXX5("BKMV EI MEDS","^TMP(""BKMARRAY"",$J)")
+17 SET MED=""
FOR
SET MED=$ORDER(^TMP("BKMARRAY",$JOB,MED))
IF MED=""
QUIT
DO FMD("BKMV EI MEDS")
+18 KILL ^TMP($JOB,"BKMVMEDS")
+19 ;
LAB ; Check the lab, CPT, and LOINC codes in the Lab V-File.
+1 ;
+2 ; Build the lab tests from taxonomies to check
+3 KILL ^TMP("BKMARRAY",$JOB),^TMP("BKMCPT",$JOB)
+4 DO BLDTAX^BKMIXX5("BGP HIV TEST TAX","^TMP(""BKMARRAY"",$J)")
+5 SET LAB=""
FOR
SET LAB=$ORDER(^TMP("BKMARRAY",$JOB,LAB))
IF LAB=""
QUIT
DO FLB("BGP HIV TEST TAX")
+6 KILL ^TMP("BKMARRAY",$JOB)
+7 DO BLDTAX^BKMIXX5("BGP HIV TEST LOINC CODES","^TMP(""BKMARRAY"",$J)")
+8 SET LAB=""
FOR
SET LAB=$ORDER(^TMP("BKMARRAY",$JOB,LAB))
IF LAB=""
QUIT
DO FLB("BGP HIV TEST LOINC CODES")
+9 KILL ^TMP("BKMARRAY",$JOB)
+10 DO BLDTAX^BKMIXX5("BGP CPT HIV TESTS","^TMP(""BKMCPT"",$J)")
+11 SET CPT=""
FOR
SET CPT=$ORDER(^TMP("BKMCPT",$JOB,CPT))
IF CPT=""
QUIT
Begin DoDot:1
+12 SET BCPTR=0
FOR
SET BCPTR=$ORDER(^BLRCPT(BCPTR))
IF 'BCPTR
QUIT
Begin DoDot:2
+13 IF $DATA(^BLRCPT(BCPTR,11,"B",CPT))
SET LAB=$PIECE($GET(^BLRCPT(BCPTR,1)),U,1)
IF LAB'=""
SET ^TMP("BKMARRAY",$JOB,LAB)=$PIECE(^LAB(60,LAB,0),U,1)
End DoDot:2
End DoDot:1
+14 KILL ^TMP("BKMCPT",$JOB),CPT,BCPTR
+15 SET LAB=""
FOR
SET LAB=$ORDER(^TMP("BKMARRAY",$JOB,LAB))
IF LAB=""
QUIT
DO FLB("BGP CPT HIV TESTS")
+16 ;
XIT ;KILL LOCALS AND EXIT
+1 DO ^XBFMK
+2 KILL DIR,REGISTER,BKM,FOUND,LOINC,MED,VMEDIEN,Y,ZTDESC,ZTIO,ZTSAVE
+3 KILL STATUS,ZTRTN,ZTSK,AIDX,AIEN,AOK,DXN,HIDX,HIEN,LIEN,QFL,VISDTM,VISIT
+4 KILL ^TMP("BKMPOP",$JOB),^TMP("BKMARRAY",$JOB),^TMP("BKMTST",$JOB)
+5 KILL ^TMP("BKMAIDS",$JOB),^TMP("BKMHIV",$JOB),^TMP("BKMCD4",$JOB)
+6 KILL DCT,DIAGCAT,HAIDSDT,IAIDSDT,RDATE,LAB,RDA,SBFILE,SUBFIL,XCNP,IGNORE
+7 KILL BKCIEN,BKMIEN,BKMPOPDT,DFN,ERR,ERROR,BCPTR,CPT,ENTRY,BKMDEC
+8 QUIT
+9 ;
FMD(MTAX) ; Find Medications
+1 NEW LIEN
+2 SET LIEN=""
FOR
SET LIEN=$ORDER(^AUPNVMED("B",MED,LIEN))
IF LIEN=""
QUIT
Begin DoDot:1
+3 SET DFN=$PIECE(^AUPNVMED(LIEN,0),U,2)
+4 IF DFN=""
QUIT
+5 IF 'BKMDEC
IF $$GET1^DIQ(2,DFN,.351,"I")'=""
QUIT
+6 IF '$$HRN^BKMVUTL(DFN)
QUIT
+7 SET ^TMP($JOB,"BKMVMEDS",DFN)=$GET(^TMP($JOB,"BKMVMEDS",DFN))+1
+8 QUIT
End DoDot:1
+9 SET DFN=""
FOR
SET DFN=$ORDER(^TMP($JOB,"BKMVMEDS",DFN))
IF DFN=""
QUIT
Begin DoDot:1
+10 IF $GET(^TMP($JOB,"BKMVMEDS",DFN))>1
DO NPAT(DFN)
End DoDot:1
+11 KILL ^TMP($JOB,"BKMVMEDS",DFN),^TMP("BKMARRAY",$JOB)
+12 KILL DFN,MTAX
+13 QUIT
+14 ;
FLB(LTAX) ; Find Lab tests
+1 NEW LIEN
+2 SET LIEN=""
FOR
SET LIEN=$ORDER(^AUPNVLAB("B",LAB,LIEN))
IF LIEN=""
QUIT
Begin DoDot:1
+3 SET DFN=$PIECE(^AUPNVLAB(LIEN,0),U,2)
+4 IF DFN=""
QUIT
+5 IF 'BKMDEC
IF $$GET1^DIQ(2,DFN,.351,"I")'=""
QUIT
+6 IF '$$HRN^BKMVUTL(DFN)
QUIT
+7 SET RESULT=$$GET1^DIQ(9000010.09,LIEN,.04,"E")
IF RESULT=""
QUIT
+8 IF $$POSITIVE^BKMVF32(RESULT)
DO NPAT(DFN)
End DoDot:1
+9 KILL LIEN,LTAX,RESULT,DFN
+10 QUIT
+11 ;
NPAT(DFN) ;
+1 SET @GLBREF@(DFN,0)=""
+2 QUIT
