BEHOPLDD ; IHS/MSC/MGH - Problem Details ;23-Mar-2016 14:30;PLS
;;1.1;BEH COMPONENTS;**034002,034003,034004**;Mar 20, 2007;Build 3
;---------------------------------------------
DETAIL(RET,IEN,DFN) ;Get a detail report on one problem
N ZERO,CNT,PROB,CLASS,STATUS,ACLASS,PIP,ONSET,SNOMED,DESC,IN,OUT,ACT
S VIEN=$G(VIEN)
S ZERO=$G(^AUPNPROB(IEN,0))
S ACT=$G(ACT),NUM=$G(NUM)
S RET=$$TMPGBL,CNT=0
I $G(IEN)="" D ADD("No problem entered")
D ADD2(""),ADD2("PROBLEM DATA")
D ADD1($$GET1^DIQ(9000011,IEN,.07)," ID:")
S PROB=$$GET1^DIQ(9000011,IEN,.05)
I $P(PROB,"|",2)=""!($P(PROB,"|",2)=" ") S PROB=$P(PROB,"|",1)
D ADD1(PROB,"Problem:")
D CHANGED^BGOPAUD(IEN,.05)
D ADD1($$GET1^DIQ(9000011,IEN,.01)," * Mapped ICD:")
D CHANGED^BGOPAUD(IEN,.01)
S CLASS=$$GET1^DIQ(9000011,IEN,.04)
S STATUS=$$GET1^DIQ(9000011,IEN,.12)
I CLASS'="" S STATUS=STATUS_" * Class: "_CLASS
D ADD1(STATUS," * Status:")
D CHANGED^BGOPAUD(IEN,.12)
I $$GET1^DIQ(9000011,IEN,.13)="" S ONSET="UNKNOWN"
E S ONSET=$$GET1^DIQ(9000011,IEN,.13)
D ADD1(ONSET," * Date of Onset:")
D ADD1($$GET1^DIQ(9000011,IEN,.08)," * Date Entered:")
D ADD1($$GET1^DIQ(9000011,IEN,.03)," * Date Last Modified:")
D ADD1($$GET1^DIQ(9000011,IEN,1.04)," * Recorded By:")
S ACLASS=$$GET1^DIQ(9000011,IEN,.15)
I ACLASS'="" D ADD1(ACLASS," * Asthma Class:")
D CHANGED^BGOPAUD(IEN,.15)
S PIP=$$GET1^DIQ(9000011,IEN,.19,"I")
I PIP=1 D ADD1(PIP," * Pregnancy DX:")
S SNOMED=$P($G(^AUPNPROB(IEN,800)),U,1)
D ADD1(SNOMED," * Concept CT:")
D CHANGED^BGOPAUD(IEN,80001)
S DESC=$P($G(^AUPNPROB(IEN,800)),U,2)
D ADD1(DESC," * Desc CT: ")
D CHANGED^BGOPAUD(IEN,80002)
D ADD2("")
D ICD(IEN)
D QUAL(IEN)
D NOTES
I VIEN="" D POV(IEN),ADD2("")
D INPT(IEN)
D RECON(IEN)
Q
NOTES ; Get the notes for this problem
N AIEN,IEN2,BY,WHEN,NUM,FAC,NARR,I,NOTES,STAT
D NOTES^BGOPRBN(.NOTES,IEN,1)
I $D(NOTES)>1 D ADD2("") D ADD2(" NOTES")
S I="" F S I=$O(NOTES(I)) Q:I="" D
.S FAC=$P(NOTES(I),U,1)
.S FAC=$$GET1^DIQ(9999999.06,FAC,.01)
.D CHANGED^BGOPAUD(IEN,"9000011.11,.01")
.S NUM=$P(NOTES(I),U,3)
.S STAT=$P(NOTES(I),U,5) I STAT="A" S STATUS="ACTIVE"
.S BY=$P(NOTES(I),U,7)
.S BY=$$GET1^DIQ(200,BY,.01)
.S WHEN=$$FMTE^XLFDT($P(NOTES(I),U,6))
.S NARR=$P(NOTES(I),U,4)
.D ADD2("Site: "_FAC_" Number: "_NUM_" Status: "_STAT)
.D ADD2("Entered By: "_BY_" On: "_WHEN)
.D ADD2(NARR)
.D ADD2("")
Q
ICD(IEN) ;Get any additional ICD codes for this problem
N AIEN,IEN2
I $D(^AUPNPROB(IEN,12)) D ADD2(" Additional ICD Codes")
S IEN2=0 F S IEN2=$O(^AUPNPROB(IEN,12,IEN2)) Q:'+IEN2 D
.S AIEN=IEN2_","_IEN_","
.D ADD2($$GET1^DIQ(9000011.12,AIEN,.01))
Q
QUAL(IEN) ;Get any qualifiers for this problem
N AIEN,IEN2,BY,WHEN,FNUM,X,Q,FLD
F X=13,17,18 D
.I $D(^AUPNPROB(IEN,X)) D ADD2(" QUALIFIERS")
.S FNUM=$S(X=13:9000011.13,X=17:9000011.17,X=18:9000011.18)
.S IEN2=0 F S IEN2=$O(^AUPNPROB(IEN,X,IEN2)) Q:'+IEN2 D
..S AIEN=IEN2_","_IEN_","
..I X=13 D
...S BY=$$GET1^DIQ(FNUM,AIEN,.02)
...S WHEN=$$GET1^DIQ(FNUM,AIEN,.03)
..S Q=$$GET1^DIQ(FNUM,AIEN,.01)
..S Q=$$CONCEPT^BGOPAUD(Q)
..D ADD2(Q)
..I X=13 D ADD2("Entered by: "_BY_" On: "_WHEN)
..S FLD=$S(X=13:1301,X=17:1701,X=18:1801)
..D CHANGED^BGOPAUD(IEN,FLD_",.01")
Q
POV(IEN) ;See if this problem has been used as a POV
N AIEN,IEN2,BY,WHEN,CLIN,VSIT
I $D(^AUPNPROB(IEN,14)) D ADD2(" Visits when used as POV")
S IEN2=0 F S IEN2=$O(^AUPNPROB(IEN,14,IEN2)) Q:'+IEN2 D
.S VSIT=$G(^AUPNPROB(IEN,14,IEN2,0))
.S CLIN=$P($G(^AUPNVSIT(VSIT,0)),U,8)
.;IHS/MSC/MGH Remove quitting if pharamcy visit
.;Q:CLIN=39 ;Don't include pharmacy visits
.S AIEN=IEN2_","_IEN_","
.D ADD2($$GET1^DIQ(9000011.14,AIEN,.01))
Q
INPT(IEN) ;See if this problem has been used for inpt visits
N AIEN,IEN2,BY,WHEN
I $D(^AUPNPROB(IEN,15))>10 D ADD2(" Used for Inpt Visits")
S IEN2=0 F S IEN2=$O(^AUPNPROB(IEN,15,IEN2)) Q:'+IEN2 D
.S AIEN=IEN2_","_IEN_","
.D ADD2($$GET1^DIQ(9000011.15,AIEN,.01))
Q
RECON(IEN) ;Display the reconciliation data for this problem
N REC,AIEN,WHEN,BY,RIEN
S REC=""
F S REC=$O(^BEHOCIR("G","P",IEN,REC)) Q:REC="" D
.S RIEN="" F S RIEN=$O(^BEHOCIR("G","A",IEN,REC,RIEN)) Q:RIEN="" D
..S AIEN=RIEN_","_REC_","
..S WHEN=$$GET1^DIQ(90461.632,AIEN,.01)
..S BY=$$GET1^DIQ(90461.632,AIEN,.02)
..W ?10,"Reconciled on: "_WHEN_" by "_BY,!
Q
ADD1(TXT,LBL) ;
S CNT=CNT+1 S @RET@(CNT)=$S($D(LBL):$$LJ^XLFSTR(LBL,20),1:"")_$G(TXT),LBL=""
Q
ADD2(TXT) ;
S CNT=CNT+1 S @RET@(CNT)=TXT
Q
TMPGBL(X) ;EP
K ^TMP("BGOPRDD",$J) Q $NA(^($J))
BEHOPLDD ; IHS/MSC/MGH - Problem Details ;23-Mar-2016 14:30;PLS
+1 ;;1.1;BEH COMPONENTS;**034002,034003,034004**;Mar 20, 2007;Build 3
+2 ;---------------------------------------------
DETAIL(RET,IEN,DFN) ;Get a detail report on one problem
+1 NEW ZERO,CNT,PROB,CLASS,STATUS,ACLASS,PIP,ONSET,SNOMED,DESC,IN,OUT,ACT
+2 SET VIEN=$GET(VIEN)
+3 SET ZERO=$GET(^AUPNPROB(IEN,0))
+4 SET ACT=$GET(ACT)
SET NUM=$GET(NUM)
+5 SET RET=$$TMPGBL
SET CNT=0
+6 IF $GET(IEN)=""
DO ADD("No problem entered")
+7 DO ADD2("")
DO ADD2("PROBLEM DATA")
+8 DO ADD1($$GET1^DIQ(9000011,IEN,.07)," ID:")
+9 SET PROB=$$GET1^DIQ(9000011,IEN,.05)
+10 IF $PIECE(PROB,"|",2)=""!($PIECE(PROB,"|",2)=" ")
SET PROB=$PIECE(PROB,"|",1)
+11 DO ADD1(PROB,"Problem:")
+12 DO CHANGED^BGOPAUD(IEN,.05)
+13 DO ADD1($$GET1^DIQ(9000011,IEN,.01)," * Mapped ICD:")
+14 DO CHANGED^BGOPAUD(IEN,.01)
+15 SET CLASS=$$GET1^DIQ(9000011,IEN,.04)
+16 SET STATUS=$$GET1^DIQ(9000011,IEN,.12)
+17 IF CLASS'=""
SET STATUS=STATUS_" * Class: "_CLASS
+18 DO ADD1(STATUS," * Status:")
+19 DO CHANGED^BGOPAUD(IEN,.12)
+20 IF $$GET1^DIQ(9000011,IEN,.13)=""
SET ONSET="UNKNOWN"
+21 IF '$TEST
SET ONSET=$$GET1^DIQ(9000011,IEN,.13)
+22 DO ADD1(ONSET," * Date of Onset:")
+23 DO ADD1($$GET1^DIQ(9000011,IEN,.08)," * Date Entered:")
+24 DO ADD1($$GET1^DIQ(9000011,IEN,.03)," * Date Last Modified:")
+25 DO ADD1($$GET1^DIQ(9000011,IEN,1.04)," * Recorded By:")
+26 SET ACLASS=$$GET1^DIQ(9000011,IEN,.15)
+27 IF ACLASS'=""
DO ADD1(ACLASS," * Asthma Class:")
+28 DO CHANGED^BGOPAUD(IEN,.15)
+29 SET PIP=$$GET1^DIQ(9000011,IEN,.19,"I")
+30 IF PIP=1
DO ADD1(PIP," * Pregnancy DX:")
+31 SET SNOMED=$PIECE($GET(^AUPNPROB(IEN,800)),U,1)
+32 DO ADD1(SNOMED," * Concept CT:")
+33 DO CHANGED^BGOPAUD(IEN,80001)
+34 SET DESC=$PIECE($GET(^AUPNPROB(IEN,800)),U,2)
+35 DO ADD1(DESC," * Desc CT: ")
+36 DO CHANGED^BGOPAUD(IEN,80002)
+37 DO ADD2("")
+38 DO ICD(IEN)
+39 DO QUAL(IEN)
+40 DO NOTES
+41 IF VIEN=""
DO POV(IEN)
DO ADD2("")
+42 DO INPT(IEN)
+43 DO RECON(IEN)
+44 QUIT
NOTES ; Get the notes for this problem
+1 NEW AIEN,IEN2,BY,WHEN,NUM,FAC,NARR,I,NOTES,STAT
+2 DO NOTES^BGOPRBN(.NOTES,IEN,1)
+3 IF $DATA(NOTES)>1
DO ADD2("")
DO ADD2(" NOTES")
+4 SET I=""
FOR
SET I=$ORDER(NOTES(I))
IF I=""
QUIT
Begin DoDot:1
+5 SET FAC=$PIECE(NOTES(I),U,1)
+6 SET FAC=$$GET1^DIQ(9999999.06,FAC,.01)
+7 DO CHANGED^BGOPAUD(IEN,"9000011.11,.01")
+8 SET NUM=$PIECE(NOTES(I),U,3)
+9 SET STAT=$PIECE(NOTES(I),U,5)
IF STAT="A"
SET STATUS="ACTIVE"
+10 SET BY=$PIECE(NOTES(I),U,7)
+11 SET BY=$$GET1^DIQ(200,BY,.01)
+12 SET WHEN=$$FMTE^XLFDT($PIECE(NOTES(I),U,6))
+13 SET NARR=$PIECE(NOTES(I),U,4)
+14 DO ADD2("Site: "_FAC_" Number: "_NUM_" Status: "_STAT)
+15 DO ADD2("Entered By: "_BY_" On: "_WHEN)
+16 DO ADD2(NARR)
+17 DO ADD2("")
End DoDot:1
+18 QUIT
ICD(IEN) ;Get any additional ICD codes for this problem
+1 NEW AIEN,IEN2
+2 IF $DATA(^AUPNPROB(IEN,12))
DO ADD2(" Additional ICD Codes")
+3 SET IEN2=0
FOR
SET IEN2=$ORDER(^AUPNPROB(IEN,12,IEN2))
IF '+IEN2
QUIT
Begin DoDot:1
+4 SET AIEN=IEN2_","_IEN_","
+5 DO ADD2($$GET1^DIQ(9000011.12,AIEN,.01))
End DoDot:1
+6 QUIT
QUAL(IEN) ;Get any qualifiers for this problem
+1 NEW AIEN,IEN2,BY,WHEN,FNUM,X,Q,FLD
+2 FOR X=13,17,18
Begin DoDot:1
+3 IF $DATA(^AUPNPROB(IEN,X))
DO ADD2(" QUALIFIERS")
+4 SET FNUM=$SELECT(X=13:9000011.13,X=17:9000011.17,X=18:9000011.18)
+5 SET IEN2=0
FOR
SET IEN2=$ORDER(^AUPNPROB(IEN,X,IEN2))
IF '+IEN2
QUIT
Begin DoDot:2
+6 SET AIEN=IEN2_","_IEN_","
+7 IF X=13
Begin DoDot:3
+8 SET BY=$$GET1^DIQ(FNUM,AIEN,.02)
+9 SET WHEN=$$GET1^DIQ(FNUM,AIEN,.03)
End DoDot:3
+10 SET Q=$$GET1^DIQ(FNUM,AIEN,.01)
+11 SET Q=$$CONCEPT^BGOPAUD(Q)
+12 DO ADD2(Q)
+13 IF X=13
DO ADD2("Entered by: "_BY_" On: "_WHEN)
+14 SET FLD=$SELECT(X=13:1301,X=17:1701,X=18:1801)
+15 DO CHANGED^BGOPAUD(IEN,FLD_",.01")
End DoDot:2
End DoDot:1
+16 QUIT
POV(IEN) ;See if this problem has been used as a POV
+1 NEW AIEN,IEN2,BY,WHEN,CLIN,VSIT
+2 IF $DATA(^AUPNPROB(IEN,14))
DO ADD2(" Visits when used as POV")
+3 SET IEN2=0
FOR
SET IEN2=$ORDER(^AUPNPROB(IEN,14,IEN2))
IF '+IEN2
QUIT
Begin DoDot:1
+4 SET VSIT=$GET(^AUPNPROB(IEN,14,IEN2,0))
+5 SET CLIN=$PIECE($GET(^AUPNVSIT(VSIT,0)),U,8)
+6 ;IHS/MSC/MGH Remove quitting if pharamcy visit
+7 ;Q:CLIN=39 ;Don't include pharmacy visits
+8 SET AIEN=IEN2_","_IEN_","
+9 DO ADD2($$GET1^DIQ(9000011.14,AIEN,.01))
End DoDot:1
+10 QUIT
INPT(IEN) ;See if this problem has been used for inpt visits
+1 NEW AIEN,IEN2,BY,WHEN
+2 IF $DATA(^AUPNPROB(IEN,15))>10
DO ADD2(" Used for Inpt Visits")
+3 SET IEN2=0
FOR
SET IEN2=$ORDER(^AUPNPROB(IEN,15,IEN2))
IF '+IEN2
QUIT
Begin DoDot:1
+4 SET AIEN=IEN2_","_IEN_","
+5 DO ADD2($$GET1^DIQ(9000011.15,AIEN,.01))
End DoDot:1
+6 QUIT
RECON(IEN) ;Display the reconciliation data for this problem
+1 NEW REC,AIEN,WHEN,BY,RIEN
+2 SET REC=""
+3 FOR
SET REC=$ORDER(^BEHOCIR("G","P",IEN,REC))
IF REC=""
QUIT
Begin DoDot:1
+4 SET RIEN=""
FOR
SET RIEN=$ORDER(^BEHOCIR("G","A",IEN,REC,RIEN))
IF RIEN=""
QUIT
Begin DoDot:2
+5 SET AIEN=RIEN_","_REC_","
+6 SET WHEN=$$GET1^DIQ(90461.632,AIEN,.01)
+7 SET BY=$$GET1^DIQ(90461.632,AIEN,.02)
+8 WRITE ?10,"Reconciled on: "_WHEN_" by "_BY,!
End DoDot:2
End DoDot:1
+9 QUIT
ADD1(TXT,LBL) ;
+1 SET CNT=CNT+1
SET @RET@(CNT)=$SELECT($DATA(LBL):$$LJ^XLFSTR(LBL,20),1:"")_$GET(TXT)
SET LBL=""
+2 QUIT
ADD2(TXT) ;
+1 SET CNT=CNT+1
SET @RET@(CNT)=TXT
+2 QUIT
TMPGBL(X) ;EP
+1 KILL ^TMP("BGOPRDD",$JOB)
QUIT $NAME(^($JOB))
