Routine: BKMVA1U

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

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

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

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

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)

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

BKMVA1U.m