Routine: BTIUPDD

BTIUPDD ; IHS/MSC/MGH - Problem Objects ;12-Jul-2016 17:33;MGH

 ;;1.0;TEXT INTEGRATION UTILITIES;**1012,1013,1014,1016,1017**;MAR 20, 2013;Build 7

 ;4/13/13

DETAIL(DFN,TARGET,TYPE,ACT,NUM) ; Get problem details

 N PROB,CNT,RET,PRIEN,I,STAT

 K @TARGET

 I $G(TYPE)="" S TYPE="ASEO"

 I $G(ACT)="" S ACT="L"

 ;For Visit instructions and treatments, the default is the latest visit

 I $G(NUM)="" S NUM=1

 S RET=""

 S (CNT,PRIEN)=0

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

 .;Check for which statuses to return

 .S STAT=$P($G(^AUPNPROB(PRIEN,0)),U,12)

 .Q:STAT="D"

 .Q:TYPE'[STAT

 .D DETAIL^BGOPRDD(.RET,PRIEN,DFN,"A",100,"")             ;Get a detail report on one problem

 .S I=0 F  S I=$O(@RET@(I)) Q:I=""  D

 ..S CNT=CNT+1

 ..S @TARGET@(CNT,0)=@RET@(I)

 .K RET

 I CNT=0 S @TARGET@(1,0)="No active problems"

 Q "~@"_$NA(@TARGET)

 ;Get the problems associated with this visit and only the latest or items updated during this visit

VST(DFN,TARGET,VIEN,CP) ;Problems updated this visit

 N PROB,CNT,RET,PRIEN,I,VST,ARRAY

 S CNT=0,CP=$G(CP),ARRAY=""

 K @TARGET

 S VIEN=$G(VIEN)

 I VIEN'="" G GETPRB

 S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")

 I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)

 S VIEN=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)

 D GETPRB

 I CNT=0 S @TARGET@(1,0)="No Problems used as POVs in this visit record"

 Q "~@"_$NA(@TARGET)

GETPRB ;Get problems to update

 I $G(VIEN)="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)

 S PRIEN=0

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

 .;Check for which statuses to return

 .S STAT=$P($G(^AUPNPROB(PRIEN,0)),U,12)

 .Q:STAT="D"

 .I $D(^AUPNPROB(PRIEN,14,"B",VIEN)) D

 ..D GETDATA(.ARRAY,PRIEN,VIEN)

 ;IHS/MSC/MGH Patch 1014

 D ADDITEMS(.ARRAY)

GETDATA(ARRAY,PRIEN,VIEN) ;Get data for a problem

 N NARR,STATUS,ICD,POVNAR

 S POVNAR=$$POV^BTIUPDD(VIEN,PRIEN)

 S NARR=$$GET1^DIQ(9000011,PRIEN,.05)

 S ARRAY($P(POVNAR,U,2),NARR,PRIEN)=$P(POVNAR,U,1)

ADDITEMS(ARRAY) ;Add the other pieces to display

 N NARR,STATUS,ICD,POVNAR,STAT,PRIEN

 S STAT="" F  S STAT=$O(ARRAY(STAT)) Q:STAT=""  D

 .S NARR="" F  S NARR=$O(ARRAY(STAT,NARR)) Q:NARR=""  D

 ..S PRIEN="" F  S PRIEN=$O(ARRAY(STAT,NARR,PRIEN)) Q:PRIEN=""  D

 ...S POVNAR=$G(ARRAY(STAT,NARR,PRIEN))

 ...S STATUS=$$GET1^DIQ(9000011,PRIEN,.12)

 ...S ICD=$$GET1^DIQ(9000011,PRIEN,.01)

 ...D ADD("Problem: "_NARR)

 ...;Find changed narrative

 ...D ADD(" POV : "_POVNAR_"("_STAT_")")

 ...D ADD(" Status: "_STATUS)

 ...;D ADD(" Mapped ICD: "_ICD_" Status: "_STATUS)

 ...D QUAL^BTIUPV1(PRIEN,.CNT)

 ...I CP=1 D

 ....D FINDCP^BTIUPV1(PRIEN,"G",.CNT)  ;Add goals

 ....D FINDCP^BTIUPV1(PRIEN,"P",.CNT)  ;Add care plans

 ...D VIDT^BTIUPV1(PRIEN,VIEN,.CNT)   ;Visit instruction

 ...D VTRDT^BTIUPV1(PRIEN,VIEN,.CNT)  ;V treatment/regimens

 ...D REFDT^BTIUPV1(PRIEN,VIEN,.CNT)  ;V REFERRALS

 ...D EDU^BTIUPV1(PRIEN,VIEN,.CNT)  ;V education by date

ADD(DATA) ;add to list

 S CNT=CNT+1

 S @TARGET@(CNT,0)=DATA

POV(VIEN,PRIEN) ;Check to see if POV narrative is different from problem narrative

 ;IHS/MSC/MGH added normal/abnormal qualifier

 N POV,POVIEN,MATCH,PRIM,NORM,STR,ENTRY

 S MATCH=0,POV=""

 S POVIEN="",STR=""

 F  S POVIEN=$O(^AUPNVPOV("AD",VIEN,POVIEN)) Q:POVIEN=""!(MATCH=1)  D

 .I $P($G(^AUPNVPOV(POVIEN,0)),U,16)=PRIEN S MATCH=1

 .S POV=$$GET1^DIQ(9000010.07,POVIEN,.04)

 .S PRIM=$$GET1^DIQ(9000010.07,POVIEN,.12,"I")

 .I PRIM="" S PRIM="S"

 .S NORM=$$GET1^DIQ(9000010.07,POVIEN,.29,"E")

 .S ENTRY=$$GET1^DIQ(9000010.07,POVIEN,1216,"I")

 .I NORM="" S STR=POV_U_PRIM_U_ENTRY

 .I NORM'="" S STR=POV_";"_NORM_U_PRIM_U_ENTRY

 Q STR

TMPGBL(X) ;EP

 K ^TMP("BGOPRDD",$J) Q $NA(^($J))

BTIUPDD   ; IHS/MSC/MGH - Problem Objects ;12-Jul-2016 17:33;MGH

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**1012,1013,1014,1016,1017**;MAR 20, 2013;Build 7

 +2       ;4/13/13

 +3       ;

 +4        QUIT

 +5       ;

DETAIL(DFN,TARGET,TYPE,ACT,NUM) ; Get problem details

 +1        NEW PROB,CNT,RET,PRIEN,I,STAT

 +2        KILL @TARGET

 +3        IF $GET(TYPE)=""

               SET TYPE="ASEO"

 +4        IF $GET(ACT)=""

               SET ACT="L"

 +5       ;For Visit instructions and treatments, the default is the latest visit

 +6        IF $GET(NUM)=""

               SET NUM=1

 +7        SET RET=""

 +8        SET (CNT,PRIEN)=0

 +9        FOR

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

               IF 'PRIEN

                   QUIT

               Begin DoDot:1

 +10      ;Check for which statuses to return

 +11               SET STAT=$PIECE($GET(^AUPNPROB(PRIEN,0)),U,12)

 +12               IF STAT="D"

                       QUIT

 +13               IF TYPE'[STAT

                       QUIT

 +14      ;Get a detail report on one problem

                   DO DETAIL^BGOPRDD(.RET,PRIEN,DFN,"A",100,"")

 +15               SET I=0

FOR

                       SET I=$ORDER(@RET@(I))

                       IF I=""

                           QUIT

                       Begin DoDot:2

 +16                       SET CNT=CNT+1

 +17                       SET @TARGET@(CNT,0)=@RET@(I)

                       End DoDot:2

 +18               KILL RET

               End DoDot:1

 +19       IF CNT=0

               SET @TARGET@(1,0)="No active problems"

 +20       QUIT "~@"_$NAME(@TARGET)

 +21      ;

 +22      ;Get the problems associated with this visit and only the latest or items updated during this visit

VST(DFN,TARGET,VIEN,CP) ;Problems updated this visit

 +1        NEW PROB,CNT,RET,PRIEN,I,VST,ARRAY

 +2        SET CNT=0

           SET CP=$GET(CP)

           SET ARRAY=""

 +3        KILL @TARGET

 +4        SET VIEN=$GET(VIEN)

 +5        IF VIEN'=""

               GOTO GETPRB

 +6        SET VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")

 +7        IF VST=""

               SET @TARGET@(1,0)="Invalid visit"

               QUIT "~@"_$NAME(@TARGET)

 +8        SET VIEN=+$$VSTR2VIS^BEHOENCX(DFN,VST)

           IF VST<1

               SET @TARGET@(1,0)="Invalid context variables"

               QUIT "~@"_$NAME(@TARGET)

 +9        DO GETPRB

 +10       IF CNT=0

               SET @TARGET@(1,0)="No Problems used as POVs in this visit record"

 +11       QUIT "~@"_$NAME(@TARGET)

 +12      ;

GETPRB    ;Get problems to update

 +1        IF $GET(VIEN)=""

               SET @TARGET@(1,0)="Invalid visit"

               QUIT "~@"_$NAME(@TARGET)

 +2        SET PRIEN=0

 +3        FOR

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

               IF 'PRIEN

                   QUIT

               Begin DoDot:1

 +4       ;Check for which statuses to return

 +5                SET STAT=$PIECE($GET(^AUPNPROB(PRIEN,0)),U,12)

 +6                IF STAT="D"

                       QUIT

 +7                IF $DATA(^AUPNPROB(PRIEN,14,"B",VIEN))

                       Begin DoDot:2

 +8                        DO GETDATA(.ARRAY,PRIEN,VIEN)

                       End DoDot:2

               End DoDot:1

 +9       ;IHS/MSC/MGH Patch 1014

 +10       DO ADDITEMS(.ARRAY)

 +11       QUIT

GETDATA(ARRAY,PRIEN,VIEN) ;Get data for a problem

 +1        NEW NARR,STATUS,ICD,POVNAR

 +2        SET POVNAR=$$POV^BTIUPDD(VIEN,PRIEN)

 +3        SET NARR=$$GET1^DIQ(9000011,PRIEN,.05)

 +4        SET ARRAY($PIECE(POVNAR,U,2),NARR,PRIEN)=$PIECE(POVNAR,U,1)

 +5        QUIT

ADDITEMS(ARRAY) ;Add the other pieces to display

 +1        NEW NARR,STATUS,ICD,POVNAR,STAT,PRIEN

 +2        SET STAT=""

FOR

               SET STAT=$ORDER(ARRAY(STAT))

               IF STAT=""

                   QUIT

               Begin DoDot:1

 +3                SET NARR=""

FOR

                       SET NARR=$ORDER(ARRAY(STAT,NARR))

                       IF NARR=""

                           QUIT

                       Begin DoDot:2

 +4                        SET PRIEN=""

FOR

                               SET PRIEN=$ORDER(ARRAY(STAT,NARR,PRIEN))

                               IF PRIEN=""

                                   QUIT

                               Begin DoDot:3

 +5                                SET POVNAR=$GET(ARRAY(STAT,NARR,PRIEN))

 +6                                SET STATUS=$$GET1^DIQ(9000011,PRIEN,.12)

 +7                                SET ICD=$$GET1^DIQ(9000011,PRIEN,.01)

 +8                                DO ADD("Problem: "_NARR)

 +9       ;Find changed narrative

 +10                               DO ADD(" POV : "_POVNAR_"("_STAT_")")

 +11                               DO ADD(" Status: "_STATUS)

 +12      ;D ADD(" Mapped ICD: "_ICD_" Status: "_STATUS)

 +13                               DO QUAL^BTIUPV1(PRIEN,.CNT)

 +14                               IF CP=1

                                       Begin DoDot:4

 +15      ;Add goals

                                           DO FINDCP^BTIUPV1(PRIEN,"G",.CNT)

 +16      ;Add care plans

                                           DO FINDCP^BTIUPV1(PRIEN,"P",.CNT)

                                       End DoDot:4

 +17      ;Visit instruction

                                   DO VIDT^BTIUPV1(PRIEN,VIEN,.CNT)

 +18      ;V treatment/regimens

                                   DO VTRDT^BTIUPV1(PRIEN,VIEN,.CNT)

 +19      ;V REFERRALS

                                   DO REFDT^BTIUPV1(PRIEN,VIEN,.CNT)

 +20      ;V education by date

                                   DO EDU^BTIUPV1(PRIEN,VIEN,.CNT)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +21       QUIT

ADD(DATA) ;add to list

 +1        SET CNT=CNT+1

 +2        SET @TARGET@(CNT,0)=DATA

 +3        QUIT

POV(VIEN,PRIEN) ;Check to see if POV narrative is different from problem narrative

 +1       ;IHS/MSC/MGH added normal/abnormal qualifier

 +2        NEW POV,POVIEN,MATCH,PRIM,NORM,STR,ENTRY

 +3        SET MATCH=0

           SET POV=""

 +4        SET POVIEN=""

           SET STR=""

 +5        FOR

               SET POVIEN=$ORDER(^AUPNVPOV("AD",VIEN,POVIEN))

               IF POVIEN=""!(MATCH=1)

                   QUIT

               Begin DoDot:1

 +6                IF $PIECE($GET(^AUPNVPOV(POVIEN,0)),U,16)=PRIEN

                       SET MATCH=1

 +7                SET POV=$$GET1^DIQ(9000010.07,POVIEN,.04)

 +8                SET PRIM=$$GET1^DIQ(9000010.07,POVIEN,.12,"I")

 +9                IF PRIM=""

                       SET PRIM="S"

 +10               SET NORM=$$GET1^DIQ(9000010.07,POVIEN,.29,"E")

 +11               SET ENTRY=$$GET1^DIQ(9000010.07,POVIEN,1216,"I")

 +12               IF NORM=""

                       SET STR=POV_U_PRIM_U_ENTRY

 +13               IF NORM'=""

                       SET STR=POV_";"_NORM_U_PRIM_U_ENTRY

               End DoDot:1

 +14       QUIT STR

TMPGBL(X) ;EP

 +1        KILL ^TMP("BGOPRDD",$JOB)

           QUIT $NAME(^($JOB))

BTIUPDD.m