BKMVC6.m

BKMVC6 ;PRXM/HC/JGH - Opp. Inf. and AIDS Defining Illnesses; 24-JAN-2005

 ;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40

 ;

GETALL(DFN) ; EP - Gather patient information

 NEW IENDA0,IENDA,IENS,TARGET,HTARGET

 NEW ATAX,ATAX1

 K ICD9S

 S ATAX=$O(^ATXAX("B","BKMV AIDS DEF ILL DXS",""))   ; DX.1

 S ATAX1=$O(^ATXAX("B","BKMV HIV OPP INF DXS",""))   ; DX.8

 ; Modified code to return unique ICDs for a given date.

 S REVDATE=""

 F  S REVDATE=$O(^AUPNVPOV("AA",DFN,REVDATE)) Q:REVDATE=""  D

 . S VPOV=""

 . F  S VPOV=$O(^AUPNVPOV("AA",DFN,REVDATE,VPOV)) Q:VPOV=""  D

 .. S IENS=$$IENS^DILF(VPOV)

 .. S ICD9=$P($G(^AUPNVPOV(VPOV,0)),"^",1)

 .. ;$$GET1^DIQ(9000010.07,IENS,.01,"I")

 .. I ICD9="" Q

 .. I $$PATCH^XPDUTL("ATX*5.1*11") I $$ICD^ATXAPI(ICD9,ATAX,9)=0,$$ICD^ATXAPI(ICD9,ATAX1,9)=0 Q

 .. E  I $$ICD^BKMIXX5(ICD9,ATAX,9)=0,$$ICD^BKMIXX5(ICD9,ATAX1,9)=0 Q

 .. S NAR=$$GET1^DIQ(9000010.07,IENS,.04,"E")

 .. S ICD9S(REVDATE,ICD9)=NAR

 S VPOV=""

 F  S VPOV=$O(^AUPNPROB("AC",DFN,VPOV)) Q:VPOV=""  D

 . S IENS=$$IENS^DILF(VPOV)

 . S POVDATE=$$PROB^BKMVUTL(IENS)

 . Q:POVDATE'?1.N

 . S REVDATE=9999999-POVDATE

 . S ICD9=$P($G(^AUPNPROB(VPOV,0)),"^",1)

 . ;$$GET1^DIQ(9000011,IENS,.01,"I")

 . I ICD9="" Q

 . I $$PATCH^XPDUTL("ATX*5.1*11") I $$ICD^ATXAPI(ICD9,ATAX,9)=0,$$ICD^ATXAPI(ICD9,ATAX1,9)=0 Q

 . E  I $$ICD^BKMIXX5(ICD9,ATAX,9)=0,$$ICD^BKMIXX5(ICD9,ATAX1,9)=0 Q

 . S NAR=$$GET1^DIQ(9000011,IENS,.05,"E")

 . S ICD9S(REVDATE,ICD9)=NAR

 . ;List date entered/last modified if different from date of onset

 . I POVDATE=$$GET1^DIQ(9000011,IENS,.13,"I") D

 ..  N OTHERDT

 ..  S OTHERDT=$$GET1^DIQ(9000011,IENS,.08,"I")

 ..  I OTHERDT="" S OTHERDT=$$GET1^DIQ(9000011,IENS,.03,"I")

 ..  Q:POVDATE=OTHERDT!(OTHERDT="")

 ..  S ICD9S(9999999-OTHERDT,ICD9)=NAR

 Q

BKMVC6    ;PRXM/HC/JGH - Opp. Inf. and AIDS Defining Illnesses; 24-JAN-2005

 +1       ;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40

 +2       ;

GETALL(DFN) ; EP - Gather patient information

 +1        NEW IENDA0,IENDA,IENS,TARGET,HTARGET

 +2        NEW ATAX,ATAX1

 +3        KILL ICD9S

 +4       ; DX.1

           SET ATAX=$ORDER(^ATXAX("B","BKMV AIDS DEF ILL DXS",""))

 +5       ; DX.8

           SET ATAX1=$ORDER(^ATXAX("B","BKMV HIV OPP INF DXS",""))

 +6       ; Modified code to return unique ICDs for a given date.

 +7        SET REVDATE=""

 +8        FOR 

               SET REVDATE=$ORDER(^AUPNVPOV("AA",DFN,REVDATE))

               IF REVDATE=""

                   QUIT 

               Begin DoDot:1

 +9                SET VPOV=""

 +10               FOR 

                       SET VPOV=$ORDER(^AUPNVPOV("AA",DFN,REVDATE,VPOV))

                       IF VPOV=""

                           QUIT 

                       Begin DoDot:2

 +11                       SET IENS=$$IENS^DILF(VPOV)

 +12                       SET ICD9=$PIECE($GET(^AUPNVPOV(VPOV,0)),"^",1)

 +13      ;$$GET1^DIQ(9000010.07,IENS,.01,"I")

 +14                       IF ICD9=""

                               QUIT 

 +15                       IF $$PATCH^XPDUTL("ATX*5.1*11")

                               IF $$ICD^ATXAPI(ICD9,ATAX,9)=0

                                   IF $$ICD^ATXAPI(ICD9,ATAX1,9)=0

                                       QUIT 

 +16                      IF '$TEST

                               IF $$ICD^BKMIXX5(ICD9,ATAX,9)=0

                                   IF $$ICD^BKMIXX5(ICD9,ATAX1,9)=0

                                       QUIT 

 +17                       SET NAR=$$GET1^DIQ(9000010.07,IENS,.04,"E")

 +18                       SET ICD9S(REVDATE,ICD9)=NAR

                       End DoDot:2

               End DoDot:1

 +19       SET VPOV=""

 +20       FOR 

               SET VPOV=$ORDER(^AUPNPROB("AC",DFN,VPOV))

               IF VPOV=""

                   QUIT 

               Begin DoDot:1

 +21               SET IENS=$$IENS^DILF(VPOV)

 +22               SET POVDATE=$$PROB^BKMVUTL(IENS)

 +23               IF POVDATE'?1.N

                       QUIT 

 +24               SET REVDATE=9999999-POVDATE

 +25               SET ICD9=$PIECE($GET(^AUPNPROB(VPOV,0)),"^",1)

 +26      ;$$GET1^DIQ(9000011,IENS,.01,"I")

 +27               IF ICD9=""

                       QUIT 

 +28               IF $$PATCH^XPDUTL("ATX*5.1*11")

                       IF $$ICD^ATXAPI(ICD9,ATAX,9)=0

                           IF $$ICD^ATXAPI(ICD9,ATAX1,9)=0

                               QUIT 

 +29              IF '$TEST

                       IF $$ICD^BKMIXX5(ICD9,ATAX,9)=0

                           IF $$ICD^BKMIXX5(ICD9,ATAX1,9)=0

                               QUIT 

 +30               SET NAR=$$GET1^DIQ(9000011,IENS,.05,"E")

 +31               SET ICD9S(REVDATE,ICD9)=NAR

 +32      ;List date entered/last modified if different from date of onset

 +33               IF POVDATE=$$GET1^DIQ(9000011,IENS,.13,"I")

                       Begin DoDot:2

 +34                       NEW OTHERDT

 +35                       SET OTHERDT=$$GET1^DIQ(9000011,IENS,.08,"I")

 +36                       IF OTHERDT=""

                               SET OTHERDT=$$GET1^DIQ(9000011,IENS,.03,"I")

 +37                       IF POVDATE=OTHERDT!(OTHERDT="")

                               QUIT 

 +38                       SET ICD9S(9999999-OTHERDT,ICD9)=NAR

                       End DoDot:2

               End DoDot:1

 +39       QUIT