BKMVA1U ;PRXM/HC/ALA - HMS PATIENT REGISTER UTILITIES ; 21 Jul 2005 10:16 AM
;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
;
HIVDT ; EP - Input Transform for the Initial HIV DX Date
NEW Y,AIDSDT,DOB,DFN
S AIDSDT=$$GET1^DIQ(90451.01,DA_","_DA(1)_",",5.5,"I")
S DFN=$$GET1^DIQ(90451,DA(1)_",",.01,"I")
S DOB=$$GET1^DIQ(2,DFN,.03,"I")
S %DT="EPX" D ^%DT S X=Y
I Y=-1 K X S BFL=1 Q
I DOB>X K X Q
I X>DT K X Q
I AIDSDT'="",X>AIDSDT K X Q
Q
;
AIDDT ; EP - Input Transform for the Initial AIDS DX Date
NEW Y,HIVDT,DOB,DFN
S HIVDT=$$GET1^DIQ(90451.01,DA_","_DA(1)_",",5,"I")
S DFN=$$GET1^DIQ(90451,DA(1)_",",.01,"I")
S DOB=$$GET1^DIQ(2,DFN,.03,"I")
S %DT="EPX" D ^%DT S X=Y
I Y=-1 K X S BFL=1 Q
I DOB>X K X Q
I X>DT K X Q
I HIVDT'="",X<HIVDT K X Q
Q
;
HHLP ; EP - HIV Diagnosis Special Help
S DV=""
K HELP
I $G(BFL) D HELP^%DTC K BFL Q
I X["BAD" D
. S HELP(1)="The HIV Diagnosis Date must be previous to the AIDS Diagnosis Date and/or"
. S HELP(1,"F")="?5"
. S HELP(2)="not previous to the Date of Birth or a future date."
. S HELP(2,"F")="!?5"
. S HELP(3)="Please re-enter the date."
. S HELP(3,"F")="!?5"
. S HELP(4)=""
. D EN^DDIOL(.HELP)
K HELP
Q
;
AHLP ; EP - AIDS Diagnosis Special Help
; PRX/DLS 4/6/2006 Added 'future date' to message & move 'Please re-enter...' to line 3.
S DV=""
K HELP
I $G(BFL) D HELP^%DTC K BFL Q
I X["BAD" D
. S DV=""
. S HELP(1)="The AIDS Diagnosis Date must be on or after the HIV Diagnosis Date and"
. S HELP(1,"F")="?5"
. S HELP(2)="not previous to the Date of Birth or a future date."
. S HELP(2,"F")="!?5"
. S HELP(3)="Please re-enter the date."
. S HELP(3,"F")="!?5"
. S HELP(4)=""
. D EN^DDIOL(.HELP)
K HELP
Q
;
ITAX ; EP - Initialize taxonomies for compile diagnosis and initial dates
NEW CPT,BCPTR,LAB
K ^TMP("BKMAIDS",$J),^TMP("BKMHIV",$J),^TMP("BKMCD4",$J),^TMP("BKMTST",$J),^TMP("BCMCD4AB")
D BLDTAX^BKMIXX5("BKMV AIDS DEF ILL DXS","^TMP(""BKMAIDS"",$J)")
D BLDTAX^BKMIXX5("BGP HIV/AIDS DXS","^TMP(""BKMHIV"",$J)")
D BLDTAX^BKMIXX5("BGP CD4 LOINC CODES","^TMP(""BKMCD4"",$J)")
D BLDTAX^BKMIXX5("BGP CD4 TAX","^TMP(""BKMCD4"",$J)")
D BLDTAX^BKMIXX5("BGP CD4 CPTS","^TMP(""BKMTST"",$J)")
; PRX/DLS 4/14/06 Added 'CD4 ABS' Taxonomy build to get proper Diag Cat for Add to Register.
D BLDTAX^BKMIXX5("BKMV CD4 ABS CPTS","^TMP(""BKMCD4AB"",$J)")
D BLDTAX^BKMIXX5("BKMV CD4 ABS LOINC CODES","^TMP(""BKMCD4AB"",$J)")
S CPT="" F S CPT=$O(^TMP("BKMTST",$J,CPT)) Q:CPT="" D
. S BCPTR=0 F S BCPTR=$O(^BLRCPT(BCPTR)) Q:'BCPTR D
.. I $D(^BLRCPT(BCPTR,11,"B",CPT)) D
... S LAB=$P($G(^BLRCPT(BCPTR,1)),U,1)
... Q:LAB=""
... I $G(^LAB(60,LAB,0))'="" S ^TMP("BKMCD4",$J,LAB)=$P(^LAB(60,LAB,0),U,1)
;
Q
BKMVA1U ;PRXM/HC/ALA - HMS PATIENT REGISTER UTILITIES ; 21 Jul 2005 10:16 AM
+1 ;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
+2 ;
HIVDT ; EP - Input Transform for the Initial HIV DX Date
+1 NEW Y,AIDSDT,DOB,DFN
+2 SET AIDSDT=$$GET1^DIQ(90451.01,DA_","_DA(1)_",",5.5,"I")
+3 SET DFN=$$GET1^DIQ(90451,DA(1)_",",.01,"I")
+4 SET DOB=$$GET1^DIQ(2,DFN,.03,"I")
+5 SET %DT="EPX"
DO ^%DT
SET X=Y
+6 IF Y=-1
KILL X
SET BFL=1
QUIT
+7 IF DOB>X
KILL X
QUIT
+8 IF X>DT
KILL X
QUIT
+9 IF AIDSDT'=""
IF X>AIDSDT
KILL X
QUIT
+10 QUIT
+11 ;
AIDDT ; EP - Input Transform for the Initial AIDS DX Date
+1 NEW Y,HIVDT,DOB,DFN
+2 SET HIVDT=$$GET1^DIQ(90451.01,DA_","_DA(1)_",",5,"I")
+3 SET DFN=$$GET1^DIQ(90451,DA(1)_",",.01,"I")
+4 SET DOB=$$GET1^DIQ(2,DFN,.03,"I")
+5 SET %DT="EPX"
DO ^%DT
SET X=Y
+6 IF Y=-1
KILL X
SET BFL=1
QUIT
+7 IF DOB>X
KILL X
QUIT
+8 IF X>DT
KILL X
QUIT
+9 IF HIVDT'=""
IF X<HIVDT
KILL X
QUIT
+10 QUIT
+11 ;
HHLP ; EP - HIV Diagnosis Special Help
+1 SET DV=""
+2 KILL HELP
+3 IF $GET(BFL)
DO HELP^%DTC
KILL BFL
QUIT
+4 IF X["BAD"
Begin DoDot:1
+5 SET HELP(1)="The HIV Diagnosis Date must be previous to the AIDS Diagnosis Date and/or"
+6 SET HELP(1,"F")="?5"
+7 SET HELP(2)="not previous to the Date of Birth or a future date."
+8 SET HELP(2,"F")="!?5"
+9 SET HELP(3)="Please re-enter the date."
+10 SET HELP(3,"F")="!?5"
+11 SET HELP(4)=""
+12 DO EN^DDIOL(.HELP)
End DoDot:1
+13 KILL HELP
+14 QUIT
+15 ;
AHLP ; EP - AIDS Diagnosis Special Help
+1 ; PRX/DLS 4/6/2006 Added 'future date' to message & move 'Please re-enter...' to line 3.
+2 SET DV=""
+3 KILL HELP
+4 IF $GET(BFL)
DO HELP^%DTC
KILL BFL
QUIT
+5 IF X["BAD"
Begin DoDot:1
+6 SET DV=""
+7 SET HELP(1)="The AIDS Diagnosis Date must be on or after the HIV Diagnosis Date and"
+8 SET HELP(1,"F")="?5"
+9 SET HELP(2)="not previous to the Date of Birth or a future date."
+10 SET HELP(2,"F")="!?5"
+11 SET HELP(3)="Please re-enter the date."
+12 SET HELP(3,"F")="!?5"
+13 SET HELP(4)=""
+14 DO EN^DDIOL(.HELP)
End DoDot:1
+15 KILL HELP
+16 QUIT
+17 ;
ITAX ; EP - Initialize taxonomies for compile diagnosis and initial dates
+1 NEW CPT,BCPTR,LAB
+2 KILL ^TMP("BKMAIDS",$JOB),^TMP("BKMHIV",$JOB),^TMP("BKMCD4",$JOB),^TMP("BKMTST",$JOB),^TMP("BCMCD4AB")
+3 DO BLDTAX^BKMIXX5("BKMV AIDS DEF ILL DXS","^TMP(""BKMAIDS"",$J)")
+4 DO BLDTAX^BKMIXX5("BGP HIV/AIDS DXS","^TMP(""BKMHIV"",$J)")
+5 DO BLDTAX^BKMIXX5("BGP CD4 LOINC CODES","^TMP(""BKMCD4"",$J)")
+6 DO BLDTAX^BKMIXX5("BGP CD4 TAX","^TMP(""BKMCD4"",$J)")
+7 DO BLDTAX^BKMIXX5("BGP CD4 CPTS","^TMP(""BKMTST"",$J)")
+8 ; PRX/DLS 4/14/06 Added 'CD4 ABS' Taxonomy build to get proper Diag Cat for Add to Register.
+9 DO BLDTAX^BKMIXX5("BKMV CD4 ABS CPTS","^TMP(""BKMCD4AB"",$J)")
+10 DO BLDTAX^BKMIXX5("BKMV CD4 ABS LOINC CODES","^TMP(""BKMCD4AB"",$J)")
+11 SET CPT=""
FOR
SET CPT=$ORDER(^TMP("BKMTST",$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))
Begin DoDot:3
+14 SET LAB=$PIECE($GET(^BLRCPT(BCPTR,1)),U,1)
+15 IF LAB=""
QUIT
+16 IF $GET(^LAB(60,LAB,0))'=""
SET ^TMP("BKMCD4",$JOB,LAB)=$PIECE(^LAB(60,LAB,0),U,1)
End DoDot:3
End DoDot:2
End DoDot:1
+17 ;
+18 QUIT
