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
;
Q
;
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)
Q
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)
Q
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
Q
ADD(DATA) ;add to list
S CNT=CNT+1
S @TARGET@(CNT,0)=DATA
Q
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))
