BGOPRDD ; IHS/BAO/TMD - Problem Details ;23-Jun-2016 08:38;du
;;1.1;BGO COMPONENTS;**13,14,20,21**;Mar 20, 2007;Build 6
;---------------------------------------------
DETAIL(RET,IEN,DFN,ACT,NUM,VIEN) ;Get a detail report on one problem
N ZERO,CNT,PROB,CLASS,STATUS,ACLASS,PIP,ONSET,SNOMED,DESC,IN,OUT,LAT,LATEXT
S VIEN=$G(VIEN)
S ZERO=$G(^AUPNPROB(IEN,0))
S ACT=$G(ACT),NUM=$G(NUM)
S RET=$$TMPGBL,CNT=0
D ADD2(""),ADD2("PROBLEM DATA")
D ADD1($$GET1^DIQ(9000011,IEN,.07)," ID:")
S PROB=$$GET1^DIQ(9000011,IEN,.05)
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,1.04)," - Recorded By:")
D ADD1($$GET1^DIQ(9000011,IEN,.03)," - Last Modified:")
D ADD1($$GET1^DIQ(9000011,IEN,.14)," - Modified User:")
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)
;IHS/MSC/MGH added laterality
S LAT=$P($G(^AUPNPROB(IEN,0)),U,22)
I LAT'="" D
.S LATEXT=$$CVPARM^BSTSMAP1("LAT",$P(LAT,"|",2))
.D ADD1(LATEXT," - Laterality: ")
D ADD2("")
D NOTES
D ICD(IEN)
D QUAL(IEN)
I VIEN="" D POV(IEN),ADD2("")
D INPT(IEN)
D CARE(IEN,DFN,ACT)
D VISIT(IEN,DFN,NUM,VIEN)
D OB(IEN,DFN,NUM,VIEN)
D VTREAT(IEN,DFN,NUM,VIEN)
I VIEN="" D CONSULT(IEN,DFN,NUM)
D REFERRAL(IEN,DFN,NUM,VIEN)
D EDU(IEN,DFN,NUM,VIEN)
I VIEN="" D RECON(IEN)
Q
NOTES ; Get the notes for this problem
N AIEN,IEN2,BY,WHEN,NUM,FAC,NARR,I,NOTES
D NOTES^BGOPRBN(.NOTES,IEN,1)
I $D(NOTES)>1 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,X,FNUM,Q
I $D(^AUPNPROB(IEN,13))!($D(^AUPNPROB(IEN,17)))!($D(^AUPNPROB(IEN,18))) D ADD2(" QUALIFIERS")
F X=13,17,18 D
.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_","
..S Q=$$GET1^DIQ(FNUM,AIEN,.01)
..S Q=$$CONCEPT^BGOPAUD(Q)
..D ADD2(Q)
..I X=13 D
...S BY=$$GET1^DIQ(FNUM,AIEN,.02)
...S WHEN=$$GET1^DIQ(FNUM,AIEN,.03)
...D ADD2("Entered by: "_BY_" On: "_WHEN)
Q
POV(IEN) ;See if this problem has been used as a POV
N AIEN,IEN2,BY,WHEN
I $D(^AUPNPROB(IEN,14)) D ADD2("") D ADD2(" POV VISITS")
S IEN2=0 F S IEN2=$O(^AUPNPROB(IEN,14,IEN2)) Q:'+IEN2 D
.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))>9 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
;Find the latest number of entries for each section using the
;parameter and return them to the calling program
;Input is IEN of Problem
; DFN of Patient
CARE(IEN,DFN,ACT) ;EP
;Start with all the goals
N DATA,STR
S DATA=""
I $G(ACT)="" S ACT="A"
D GET^BGOCPLAN(.DATA,IEN,DFN,"G",ACT,"")
I $D(^TMP("BGOPLAN",$J)) D
.D ADD2("")
.D ADD2(" GOALS")
.D PLAN
.K ^TMP("BGOPLAN",$J)
;Then do all the care plans
N DATA,STR
S DATA=""
I $G(ACT)="" S ACT="C"
D GET^BGOCPLAN(.DATA,IEN,DFN,"C",ACT,"")
I $D(^TMP("BGOPLAN",$J)) D
.D ADD2("")
.D ADD2(" CARE PLANS")
.D PLAN
.K ^TMP("BGOPLAN",$J)
Q
VISIT(IEN,DFN,NUM,VIEN) ;visit instructions
;Next get all the visit instructions
N DATA,STR
S DATA=""
I $G(NUM)="" S NUM=99999
D GET^BGOVVI(.DATA,DFN,IEN,NUM,"",.VIEN)
Q:'$D(^TMP("BGOVIN",$J))
D ADD2("")
D ADD2(" VISIT INSTRUCTIONS")
D VST
Q
OB(IEN,DFN,NUM,VIEN) ;OB notes
;Next get all the OB NOTES
N DATA,STR
S DATA=""
I $G(NUM)="" S NUM=99999
D GET^BGOVOB(.DATA,DFN,IEN,NUM,"",.VIEN)
Q:'$D(^TMP("BGOVOB",$J))
D ADD2("")
D ADD2(" OB NOTES")
D VOB
Q
VTREAT(IEN,DFN,NUM,VIEN) ;Then do all the treatment/regimen entries
N DATA,STR,CT2
S DATA="",CT2=0
I $G(NUM)="" S NUM=99999
D GET^BGOVTR(.DATA,DFN,IEN,NUM,"",.VIEN)
Q:'$D(^TMP("BGOVIN",$J))
D ADD2("")
D ADD2(" TREATMENT/REGIMENS")
D TREAT
Q
;Get all the consults
CONSULT(IEN,DFN,NUM) ;FIND consults
N DATA,STR,CT2,SER,SDATE,SSTAT
S DATA=""
I $G(NUM)="" S NUM=99999
D GETCON^BGOVTR(.DATA,DFN,IEN,NUM,"")
Q:'$D(^TMP("BGOVIN",$J))
D ADD2("")
D ADD2(" CONSULTS")
S CT2=0
F S CT2=$O(^TMP("BGOVIN",$J,CT2)) Q:'+CT2 D
.S STR=$G(^TMP("BGOVIN",$J,CT2))
.S SER=$P(STR,U,2),SDATE=$P(STR,U,3),SSTAT=$P(STR,U,4)
.D ADD2(" - CONSULT: "_SER)
.D ADD2(" - Date Ordered: "_SDATE_" Status: "_SSTAT)
Q
;Get all the consults
REFERRAL(IEN,DFN,NUM,VIEN) ;FIND referrals
N DATA,STR,CT2,SER,SDATE,SSTAT
S DATA=""
I $G(NUM)="" S NUM=99999
D GETREF^BGOVTR(.DATA,DFN,IEN,NUM,.VIEN)
Q:'$D(^TMP("BGOVIN",$J))
D ADD2("")
D ADD2(" REFERRALS")
S CT2=0
F S CT2=$O(^TMP("BGOVIN",$J,CT2)) Q:'+CT2 D
.S STR=$G(^TMP("BGOVIN",$J,CT2))
.S SER=$P(STR,U,2),SDATE=$P(STR,U,3),SSTAT=$P(STR,U,4)
.D ADD2(" - REFERRAL: "_SER)
.D ADD2(" - Date Ordered: "_SDATE_" Status: "_SSTAT)
Q
EDU(IEN,DFN,NUM,VIEN) ;Find education
N DATA,STR,CT2,SER,SDATE,SSTAT,SNO,EIEN
S DATA=""
I $G(NUM)="" S NUM=99999
D GETEDU^BGOVTR(.DATA,DFN,IEN,NUM,.VIEN)
Q:'$D(^TMP("BGOVIN",$J))
D ADD2("")
D ADD2(" EDUCATION")
S CT2=0
F S CT2=$O(^TMP("BGOVIN",$J,CT2)) Q:'+CT2 D
.S STR=$G(^TMP("BGOVIN",$J,CT2))
.S EIEN=$P(STR,U,6)
.S SER=$P(STR,U,2),SDATE=$P(STR,U,3)
.D ADD2("TOPIC: "_SER)
.D ADD2(" - Date Ordered: "_SDATE)
.S SNO="" F S SNO=$O(^AUPNVPED(EIEN,26,"B",SNO)) Q:SNO="" D
..D ADD2(" - SNOMED: "_SNO)
.S SNO=$P(STR,U,7)
.D ADD2(" - SNOMED: "_SNO)
Q
PLAN ;GET ALL CARE PLANNING DATA
N CT2,STR,STAT,SIGNED,CPIEN,SIGNBY,SIGNDT
S CT2=0
F S CT2=$O(^TMP("BGOPLAN",$J,CT2)) Q:'+CT2 D
.S STR=$G(^TMP("BGOPLAN",$J,CT2))
.I $P(STR,U,1)="~t" D
..D ADD2($P(STR,U,2))
.E D
..S BY=$P(STR,U,4),WHEN=$P(STR,U,5)
..D ADD2(" - Entered by: "_BY_" On: "_WHEN)
..S STAT=$P(STR,U,6)
..S STAT=$S(STAT="A":"Active",STAT="I":"Inactive",STAT="R":"Replaced",1:STAT)
..D ADD2(" - Status: "_STAT)
..S SIGNED=$P(STR,U,7)
..I SIGNED=1 D
...S CPIEN=$P(STR,U,2)
...S SIGNBY=$$GET1^DIQ(9000092,CPIEN,.07)
...S SIGNDT=$$GET1^DIQ(9000092,CPIEN,.08)
...D ADD2(" - Signed by: "_SIGNBY_" on: "_SIGNDT)
Q
VST ;GET ALL VISIT INSTRUCTIONS
N CT2,STR,STAT,SIGNED,VIIEN,SIGNBY,SIGNDT,FAC,VDT,VCAT,EVDT,PRV,ENTBY,ENTDT,MODBY,MODDT
S CT2=0
F S CT2=$O(^TMP("BGOVIN",$J,CT2)) Q:'+CT2 D
.S STR=$G(^TMP("BGOVIN",$J,CT2))
.I $P(STR,U,1)="~t" D
..D ADD2($P(STR,U,2))
.E D
..S VIIEN=$P(STR,U,2)
..S VDT=$P(STR,U,4)
..S VCAT=$P(STR,U,10)
..D ADD2(" - Visit Date: "_VDT_" Category:"_VCAT)
..S FAC=$P(STR,U,5)
..D ADD2(" - Facility: "_FAC)
..S EVDT=$P(STR,U,8)
..S PRV=$P(STR,U,12)
..D ADD2(" - Provider: "_PRV)
..D ADD2(" - Event Date: "_EVDT)
..S SIGNBY=$$GET1^DIQ(9000010.58,VIIEN,.04)
..S ENTBY=$$GET1^DIQ(9000010.58,VIIEN,1217)
..S ENTDT=$$GET1^DIQ(9000010.58,VIIEN,1216)
..S MODBY=$$GET1^DIQ(9000010.58,VIIEN,1219)
..S MODDT=$$GET1^DIQ(9000010.58,VIIEN,1218)
..D ADD2(" - Entered by: "_ENTBY_" On: "_ENTDT)
..D ADD2(" - Last Modified by: "_MODBY_" On: "_MODDT)
..S SIGNDT=$P(STR,U,13)
..I SIGNDT'="" D ADD2(" - Signed by: "_SIGNBY_" on: "_SIGNDT)
Q
VOB ;GET ALL V OB NOTES
N CT2,STR,STAT,SIGNED,OBIEN,SIGNBY,SIGNDT,FAC,VDT,VCAT,EVDT,PRV,ENTBY,ENTDT,MODBY,MODDT
S CT2=0
F S CT2=$O(^TMP("BGOVOB",$J,CT2)) Q:'+CT2 D
.S STR=$G(^TMP("BGOVOB",$J,CT2))
.I $P(STR,U,1)="~t" D
..D ADD2($P(STR,U,2))
.E D
..S OBIEN=$P(STR,U,2)
..S VDT=$P(STR,U,4)
..S VCAT=$P(STR,U,10)
..D ADD2(" - Visit Date: "_VDT_" Category:"_VCAT)
..S FAC=$P(STR,U,5)
..D ADD2(" - Facility: "_FAC)
..S EVDT=$P(STR,U,8)
..S PRV=$P(STR,U,12)
..D ADD2(" - Provider: "_PRV)
..D ADD2(" - Event Date: "_EVDT)
..S SIGNBY=$$GET1^DIQ(9000010.43,OBIEN,.04)
..S ENTBY=$$GET1^DIQ(9000010.43,OBIEN,1217)
..S ENTDT=$$GET1^DIQ(9000010.43,OBIEN,1216)
..S MODBY=$$GET1^DIQ(9000010.43,OBIEN,1219)
..S MODDT=$$GET1^DIQ(9000010.43,OBIEN,1218)
..D ADD2(" - Entered by: "_ENTBY_" On: "_ENTDT)
..D ADD2(" - Last Modified by: "_MODBY_" On: "_MODDT)
..S SIGNDT=$P(STR,U,13)
..I SIGNDT'="" D ADD2(" - Signed by: "_SIGNBY_" on: "_SIGNDT)
Q
TREAT ; GET THE TREATMENT DATA
N CT,STR,VIIEN,SNOMED,VDT,VCAT,FAC,EVDT,PRV,ENTBY,ENTDT,MODBY,MODDT,IN,X,TXT
F S CT2=$O(^TMP("BGOVIN",$J,CT2)) Q:'+CT2 D
.S STR=$G(^TMP("BGOVIN",$J,CT2))
.S VIIEN=$P(STR,U,2)
.S SNOMED=$P(STR,U,3)
.S VDT=$P(STR,U,5)
.S VCAT=$P(STR,U,11)
.S IN=SNOMED_U_U_VDT_U_1
.S X=$$CONC^BSTSAPI(IN)
.S TXT=$P(X,U,4)
.S SNOMED=TXT_" ("_SNOMED_")"
.D ADD2("SNOMED TERM: "_SNOMED)
.D ADD2(" - Visit Date: "_VDT_" Category:"_VCAT)
.S FAC=$P(STR,U,6)
.D ADD2(" - Facility: "_FAC)
.S EVDT=$P(STR,U,9)
.S PRV=$P(STR,U,13)
.D ADD2(" - Provider: "_PRV)
.D ADD2(" - Event Date: "_EVDT)
.S ENTBY=$$GET1^DIQ(9000010.61,VIIEN,1217)
.S ENTDT=$$GET1^DIQ(9000010.61,VIIEN,1216)
.S MODBY=$$GET1^DIQ(9000010.61,VIIEN,1219)
.S MODDT=$$GET1^DIQ(9000010.61,VIIEN,1218)
.D ADD2(" - Entered by: "_ENTBY_" On: "_ENTDT)
.D ADD2(" - Last Modified by: "_MODBY_" On: "_MODDT)
Q
LOOK(SNOMED) ;LOOKUP CODE
N RET
S RET=$P($$DESC^BSTSAPI(SNOMED_"^^1"),U,2)
Q RET
RECON(IEN) ;Display the reconciliation data for this problem
N REC,AIEN,WHEN,BY,RIEN
S REC=""
I $D(^BEHOCIR("G","P",IEN)) D
.D ADD2("")
.D ADD2(" RECONCILATION DATA")
.F S REC=$O(^BEHOCIR("G","P",IEN,REC)) Q:REC="" D
..S RIEN="" F S RIEN=$O(^BEHOCIR("G","P",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)
...D ADD2(" - 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))
BGOPRDD ; IHS/BAO/TMD - Problem Details ;23-Jun-2016 08:38;du
+1 ;;1.1;BGO COMPONENTS;**13,14,20,21**;Mar 20, 2007;Build 6
+2 ;---------------------------------------------
DETAIL(RET,IEN,DFN,ACT,NUM,VIEN) ;Get a detail report on one problem
+1 NEW ZERO,CNT,PROB,CLASS,STATUS,ACLASS,PIP,ONSET,SNOMED,DESC,IN,OUT,LAT,LATEXT
+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 DO ADD2("")
DO ADD2("PROBLEM DATA")
+7 DO ADD1($$GET1^DIQ(9000011,IEN,.07)," ID:")
+8 SET PROB=$$GET1^DIQ(9000011,IEN,.05)
+9 DO ADD1(PROB,"Problem:")
+10 DO CHANGED^BGOPAUD(IEN,.05)
+11 DO ADD1($$GET1^DIQ(9000011,IEN,.01)," - Mapped ICD:")
+12 DO CHANGED^BGOPAUD(IEN,.01)
+13 SET CLASS=$$GET1^DIQ(9000011,IEN,.04)
+14 SET STATUS=$$GET1^DIQ(9000011,IEN,.12)
+15 IF CLASS'=""
SET STATUS=STATUS_" - Class: "_CLASS
+16 DO ADD1(STATUS," - Status:")
+17 DO CHANGED^BGOPAUD(IEN,.12)
+18 IF $$GET1^DIQ(9000011,IEN,.13)=""
SET ONSET="UNKNOWN"
+19 IF '$TEST
SET ONSET=$$GET1^DIQ(9000011,IEN,.13)
+20 DO ADD1(ONSET," - Date of Onset:")
+21 DO ADD1($$GET1^DIQ(9000011,IEN,.08)," - Date Entered:")
+22 DO ADD1($$GET1^DIQ(9000011,IEN,1.04)," - Recorded By:")
+23 DO ADD1($$GET1^DIQ(9000011,IEN,.03)," - Last Modified:")
+24 DO ADD1($$GET1^DIQ(9000011,IEN,.14)," - Modified User:")
+25 SET ACLASS=$$GET1^DIQ(9000011,IEN,.15)
+26 IF ACLASS'=""
DO ADD1(ACLASS," - Asthma Class:")
+27 DO CHANGED^BGOPAUD(IEN,.15)
+28 SET PIP=$$GET1^DIQ(9000011,IEN,.19,"I")
+29 IF PIP=1
DO ADD1(PIP," - Pregnancy DX:")
+30 SET SNOMED=$PIECE($GET(^AUPNPROB(IEN,800)),U,1)
+31 DO ADD1(SNOMED," - Concept CT:")
+32 DO CHANGED^BGOPAUD(IEN,80001)
+33 SET DESC=$PIECE($GET(^AUPNPROB(IEN,800)),U,2)
+34 DO ADD1(DESC," - Desc CT: ")
+35 DO CHANGED^BGOPAUD(IEN,80002)
+36 ;IHS/MSC/MGH added laterality
+37 SET LAT=$PIECE($GET(^AUPNPROB(IEN,0)),U,22)
+38 IF LAT'=""
Begin DoDot:1
+39 SET LATEXT=$$CVPARM^BSTSMAP1("LAT",$PIECE(LAT,"|",2))
+40 DO ADD1(LATEXT," - Laterality: ")
End DoDot:1
+41 DO ADD2("")
+42 DO NOTES
+43 DO ICD(IEN)
+44 DO QUAL(IEN)
+45 IF VIEN=""
DO POV(IEN)
DO ADD2("")
+46 DO INPT(IEN)
+47 DO CARE(IEN,DFN,ACT)
+48 DO VISIT(IEN,DFN,NUM,VIEN)
+49 DO OB(IEN,DFN,NUM,VIEN)
+50 DO VTREAT(IEN,DFN,NUM,VIEN)
+51 IF VIEN=""
DO CONSULT(IEN,DFN,NUM)
+52 DO REFERRAL(IEN,DFN,NUM,VIEN)
+53 DO EDU(IEN,DFN,NUM,VIEN)
+54 IF VIEN=""
DO RECON(IEN)
+55 QUIT
NOTES ; Get the notes for this problem
+1 NEW AIEN,IEN2,BY,WHEN,NUM,FAC,NARR,I,NOTES
+2 DO NOTES^BGOPRBN(.NOTES,IEN,1)
+3 IF $DATA(NOTES)>1
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,X,FNUM,Q
+2 IF $DATA(^AUPNPROB(IEN,13))!($DATA(^AUPNPROB(IEN,17)))!($DATA(^AUPNPROB(IEN,18)))
DO ADD2(" QUALIFIERS")
+3 FOR X=13,17,18
Begin DoDot:1
+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 SET Q=$$GET1^DIQ(FNUM,AIEN,.01)
+8 SET Q=$$CONCEPT^BGOPAUD(Q)
+9 DO ADD2(Q)
+10 IF X=13
Begin DoDot:3
+11 SET BY=$$GET1^DIQ(FNUM,AIEN,.02)
+12 SET WHEN=$$GET1^DIQ(FNUM,AIEN,.03)
+13 DO ADD2("Entered by: "_BY_" On: "_WHEN)
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT
POV(IEN) ;See if this problem has been used as a POV
+1 NEW AIEN,IEN2,BY,WHEN
+2 IF $DATA(^AUPNPROB(IEN,14))
DO ADD2("")
DO ADD2(" POV VISITS")
+3 SET IEN2=0
FOR
SET IEN2=$ORDER(^AUPNPROB(IEN,14,IEN2))
IF '+IEN2
QUIT
Begin DoDot:1
+4 SET AIEN=IEN2_","_IEN_","
+5 DO ADD2($$GET1^DIQ(9000011.14,AIEN,.01))
End DoDot:1
+6 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))>9
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
+7 ;Find the latest number of entries for each section using the
+8 ;parameter and return them to the calling program
+9 ;Input is IEN of Problem
+10 ; DFN of Patient
CARE(IEN,DFN,ACT) ;EP
+1 ;Start with all the goals
+2 NEW DATA,STR
+3 SET DATA=""
+4 IF $GET(ACT)=""
SET ACT="A"
+5 DO GET^BGOCPLAN(.DATA,IEN,DFN,"G",ACT,"")
+6 IF $DATA(^TMP("BGOPLAN",$JOB))
Begin DoDot:1
+7 DO ADD2("")
+8 DO ADD2(" GOALS")
+9 DO PLAN
+10 KILL ^TMP("BGOPLAN",$JOB)
End DoDot:1
+11 ;Then do all the care plans
+12 NEW DATA,STR
+13 SET DATA=""
+14 IF $GET(ACT)=""
SET ACT="C"
+15 DO GET^BGOCPLAN(.DATA,IEN,DFN,"C",ACT,"")
+16 IF $DATA(^TMP("BGOPLAN",$JOB))
Begin DoDot:1
+17 DO ADD2("")
+18 DO ADD2(" CARE PLANS")
+19 DO PLAN
+20 KILL ^TMP("BGOPLAN",$JOB)
End DoDot:1
+21 QUIT
VISIT(IEN,DFN,NUM,VIEN) ;visit instructions
+1 ;Next get all the visit instructions
+2 NEW DATA,STR
+3 SET DATA=""
+4 IF $GET(NUM)=""
SET NUM=99999
+5 DO GET^BGOVVI(.DATA,DFN,IEN,NUM,"",.VIEN)
+6 IF '$DATA(^TMP("BGOVIN",$JOB))
QUIT
+7 DO ADD2("")
+8 DO ADD2(" VISIT INSTRUCTIONS")
+9 DO VST
+10 QUIT
OB(IEN,DFN,NUM,VIEN) ;OB notes
+1 ;Next get all the OB NOTES
+2 NEW DATA,STR
+3 SET DATA=""
+4 IF $GET(NUM)=""
SET NUM=99999
+5 DO GET^BGOVOB(.DATA,DFN,IEN,NUM,"",.VIEN)
+6 IF '$DATA(^TMP("BGOVOB",$JOB))
QUIT
+7 DO ADD2("")
+8 DO ADD2(" OB NOTES")
+9 DO VOB
+10 QUIT
VTREAT(IEN,DFN,NUM,VIEN) ;Then do all the treatment/regimen entries
+1 NEW DATA,STR,CT2
+2 SET DATA=""
SET CT2=0
+3 IF $GET(NUM)=""
SET NUM=99999
+4 DO GET^BGOVTR(.DATA,DFN,IEN,NUM,"",.VIEN)
+5 IF '$DATA(^TMP("BGOVIN",$JOB))
QUIT
+6 DO ADD2("")
+7 DO ADD2(" TREATMENT/REGIMENS")
+8 DO TREAT
+9 QUIT
+10 ;Get all the consults
CONSULT(IEN,DFN,NUM) ;FIND consults
+1 NEW DATA,STR,CT2,SER,SDATE,SSTAT
+2 SET DATA=""
+3 IF $GET(NUM)=""
SET NUM=99999
+4 DO GETCON^BGOVTR(.DATA,DFN,IEN,NUM,"")
+5 IF '$DATA(^TMP("BGOVIN",$JOB))
QUIT
+6 DO ADD2("")
+7 DO ADD2(" CONSULTS")
+8 SET CT2=0
+9 FOR
SET CT2=$ORDER(^TMP("BGOVIN",$JOB,CT2))
IF '+CT2
QUIT
Begin DoDot:1
+10 SET STR=$GET(^TMP("BGOVIN",$JOB,CT2))
+11 SET SER=$PIECE(STR,U,2)
SET SDATE=$PIECE(STR,U,3)
SET SSTAT=$PIECE(STR,U,4)
+12 DO ADD2(" - CONSULT: "_SER)
+13 DO ADD2(" - Date Ordered: "_SDATE_" Status: "_SSTAT)
End DoDot:1
+14 QUIT
+15 ;Get all the consults
REFERRAL(IEN,DFN,NUM,VIEN) ;FIND referrals
+1 NEW DATA,STR,CT2,SER,SDATE,SSTAT
+2 SET DATA=""
+3 IF $GET(NUM)=""
SET NUM=99999
+4 DO GETREF^BGOVTR(.DATA,DFN,IEN,NUM,.VIEN)
+5 IF '$DATA(^TMP("BGOVIN",$JOB))
QUIT
+6 DO ADD2("")
+7 DO ADD2(" REFERRALS")
+8 SET CT2=0
+9 FOR
SET CT2=$ORDER(^TMP("BGOVIN",$JOB,CT2))
IF '+CT2
QUIT
Begin DoDot:1
+10 SET STR=$GET(^TMP("BGOVIN",$JOB,CT2))
+11 SET SER=$PIECE(STR,U,2)
SET SDATE=$PIECE(STR,U,3)
SET SSTAT=$PIECE(STR,U,4)
+12 DO ADD2(" - REFERRAL: "_SER)
+13 DO ADD2(" - Date Ordered: "_SDATE_" Status: "_SSTAT)
End DoDot:1
+14 QUIT
EDU(IEN,DFN,NUM,VIEN) ;Find education
+1 NEW DATA,STR,CT2,SER,SDATE,SSTAT,SNO,EIEN
+2 SET DATA=""
+3 IF $GET(NUM)=""
SET NUM=99999
+4 DO GETEDU^BGOVTR(.DATA,DFN,IEN,NUM,.VIEN)
+5 IF '$DATA(^TMP("BGOVIN",$JOB))
QUIT
+6 DO ADD2("")
+7 DO ADD2(" EDUCATION")
+8 SET CT2=0
+9 FOR
SET CT2=$ORDER(^TMP("BGOVIN",$JOB,CT2))
IF '+CT2
QUIT
Begin DoDot:1
+10 SET STR=$GET(^TMP("BGOVIN",$JOB,CT2))
+11 SET EIEN=$PIECE(STR,U,6)
+12 SET SER=$PIECE(STR,U,2)
SET SDATE=$PIECE(STR,U,3)
+13 DO ADD2("TOPIC: "_SER)
+14 DO ADD2(" - Date Ordered: "_SDATE)
+15 SET SNO=""
FOR
SET SNO=$ORDER(^AUPNVPED(EIEN,26,"B",SNO))
IF SNO=""
QUIT
Begin DoDot:2
+16 DO ADD2(" - SNOMED: "_SNO)
End DoDot:2
+17 SET SNO=$PIECE(STR,U,7)
+18 DO ADD2(" - SNOMED: "_SNO)
End DoDot:1
+19 QUIT
PLAN ;GET ALL CARE PLANNING DATA
+1 NEW CT2,STR,STAT,SIGNED,CPIEN,SIGNBY,SIGNDT
+2 SET CT2=0
+3 FOR
SET CT2=$ORDER(^TMP("BGOPLAN",$JOB,CT2))
IF '+CT2
QUIT
Begin DoDot:1
+4 SET STR=$GET(^TMP("BGOPLAN",$JOB,CT2))
+5 IF $PIECE(STR,U,1)="~t"
Begin DoDot:2
+6 DO ADD2($PIECE(STR,U,2))
End DoDot:2
+7 IF '$TEST
Begin DoDot:2
+8 SET BY=$PIECE(STR,U,4)
SET WHEN=$PIECE(STR,U,5)
+9 DO ADD2(" - Entered by: "_BY_" On: "_WHEN)
+10 SET STAT=$PIECE(STR,U,6)
+11 SET STAT=$SELECT(STAT="A":"Active",STAT="I":"Inactive",STAT="R":"Replaced",1:STAT)
+12 DO ADD2(" - Status: "_STAT)
+13 SET SIGNED=$PIECE(STR,U,7)
+14 IF SIGNED=1
Begin DoDot:3
+15 SET CPIEN=$PIECE(STR,U,2)
+16 SET SIGNBY=$$GET1^DIQ(9000092,CPIEN,.07)
+17 SET SIGNDT=$$GET1^DIQ(9000092,CPIEN,.08)
+18 DO ADD2(" - Signed by: "_SIGNBY_" on: "_SIGNDT)
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
VST ;GET ALL VISIT INSTRUCTIONS
+1 NEW CT2,STR,STAT,SIGNED,VIIEN,SIGNBY,SIGNDT,FAC,VDT,VCAT,EVDT,PRV,ENTBY,ENTDT,MODBY,MODDT
+2 SET CT2=0
+3 FOR
SET CT2=$ORDER(^TMP("BGOVIN",$JOB,CT2))
IF '+CT2
QUIT
Begin DoDot:1
+4 SET STR=$GET(^TMP("BGOVIN",$JOB,CT2))
+5 IF $PIECE(STR,U,1)="~t"
Begin DoDot:2
+6 DO ADD2($PIECE(STR,U,2))
End DoDot:2
+7 IF '$TEST
Begin DoDot:2
+8 SET VIIEN=$PIECE(STR,U,2)
+9 SET VDT=$PIECE(STR,U,4)
+10 SET VCAT=$PIECE(STR,U,10)
+11 DO ADD2(" - Visit Date: "_VDT_" Category:"_VCAT)
+12 SET FAC=$PIECE(STR,U,5)
+13 DO ADD2(" - Facility: "_FAC)
+14 SET EVDT=$PIECE(STR,U,8)
+15 SET PRV=$PIECE(STR,U,12)
+16 DO ADD2(" - Provider: "_PRV)
+17 DO ADD2(" - Event Date: "_EVDT)
+18 SET SIGNBY=$$GET1^DIQ(9000010.58,VIIEN,.04)
+19 SET ENTBY=$$GET1^DIQ(9000010.58,VIIEN,1217)
+20 SET ENTDT=$$GET1^DIQ(9000010.58,VIIEN,1216)
+21 SET MODBY=$$GET1^DIQ(9000010.58,VIIEN,1219)
+22 SET MODDT=$$GET1^DIQ(9000010.58,VIIEN,1218)
+23 DO ADD2(" - Entered by: "_ENTBY_" On: "_ENTDT)
+24 DO ADD2(" - Last Modified by: "_MODBY_" On: "_MODDT)
+25 SET SIGNDT=$PIECE(STR,U,13)
+26 IF SIGNDT'=""
DO ADD2(" - Signed by: "_SIGNBY_" on: "_SIGNDT)
End DoDot:2
End DoDot:1
+27 QUIT
VOB ;GET ALL V OB NOTES
+1 NEW CT2,STR,STAT,SIGNED,OBIEN,SIGNBY,SIGNDT,FAC,VDT,VCAT,EVDT,PRV,ENTBY,ENTDT,MODBY,MODDT
+2 SET CT2=0
+3 FOR
SET CT2=$ORDER(^TMP("BGOVOB",$JOB,CT2))
IF '+CT2
QUIT
Begin DoDot:1
+4 SET STR=$GET(^TMP("BGOVOB",$JOB,CT2))
+5 IF $PIECE(STR,U,1)="~t"
Begin DoDot:2
+6 DO ADD2($PIECE(STR,U,2))
End DoDot:2
+7 IF '$TEST
Begin DoDot:2
+8 SET OBIEN=$PIECE(STR,U,2)
+9 SET VDT=$PIECE(STR,U,4)
+10 SET VCAT=$PIECE(STR,U,10)
+11 DO ADD2(" - Visit Date: "_VDT_" Category:"_VCAT)
+12 SET FAC=$PIECE(STR,U,5)
+13 DO ADD2(" - Facility: "_FAC)
+14 SET EVDT=$PIECE(STR,U,8)
+15 SET PRV=$PIECE(STR,U,12)
+16 DO ADD2(" - Provider: "_PRV)
+17 DO ADD2(" - Event Date: "_EVDT)
+18 SET SIGNBY=$$GET1^DIQ(9000010.43,OBIEN,.04)
+19 SET ENTBY=$$GET1^DIQ(9000010.43,OBIEN,1217)
+20 SET ENTDT=$$GET1^DIQ(9000010.43,OBIEN,1216)
+21 SET MODBY=$$GET1^DIQ(9000010.43,OBIEN,1219)
+22 SET MODDT=$$GET1^DIQ(9000010.43,OBIEN,1218)
+23 DO ADD2(" - Entered by: "_ENTBY_" On: "_ENTDT)
+24 DO ADD2(" - Last Modified by: "_MODBY_" On: "_MODDT)
+25 SET SIGNDT=$PIECE(STR,U,13)
+26 IF SIGNDT'=""
DO ADD2(" - Signed by: "_SIGNBY_" on: "_SIGNDT)
End DoDot:2
End DoDot:1
+27 QUIT
TREAT ; GET THE TREATMENT DATA
+1 NEW CT,STR,VIIEN,SNOMED,VDT,VCAT,FAC,EVDT,PRV,ENTBY,ENTDT,MODBY,MODDT,IN,X,TXT
+2 FOR
SET CT2=$ORDER(^TMP("BGOVIN",$JOB,CT2))
IF '+CT2
QUIT
Begin DoDot:1
+3 SET STR=$GET(^TMP("BGOVIN",$JOB,CT2))
+4 SET VIIEN=$PIECE(STR,U,2)
+5 SET SNOMED=$PIECE(STR,U,3)
+6 SET VDT=$PIECE(STR,U,5)
+7 SET VCAT=$PIECE(STR,U,11)
+8 SET IN=SNOMED_U_U_VDT_U_1
+9 SET X=$$CONC^BSTSAPI(IN)
+10 SET TXT=$PIECE(X,U,4)
+11 SET SNOMED=TXT_" ("_SNOMED_")"
+12 DO ADD2("SNOMED TERM: "_SNOMED)
+13 DO ADD2(" - Visit Date: "_VDT_" Category:"_VCAT)
+14 SET FAC=$PIECE(STR,U,6)
+15 DO ADD2(" - Facility: "_FAC)
+16 SET EVDT=$PIECE(STR,U,9)
+17 SET PRV=$PIECE(STR,U,13)
+18 DO ADD2(" - Provider: "_PRV)
+19 DO ADD2(" - Event Date: "_EVDT)
+20 SET ENTBY=$$GET1^DIQ(9000010.61,VIIEN,1217)
+21 SET ENTDT=$$GET1^DIQ(9000010.61,VIIEN,1216)
+22 SET MODBY=$$GET1^DIQ(9000010.61,VIIEN,1219)
+23 SET MODDT=$$GET1^DIQ(9000010.61,VIIEN,1218)
+24 DO ADD2(" - Entered by: "_ENTBY_" On: "_ENTDT)
+25 DO ADD2(" - Last Modified by: "_MODBY_" On: "_MODDT)
End DoDot:1
+26 QUIT
LOOK(SNOMED) ;LOOKUP CODE
+1 NEW RET
+2 SET RET=$PIECE($$DESC^BSTSAPI(SNOMED_"^^1"),U,2)
+3 QUIT RET
RECON(IEN) ;Display the reconciliation data for this problem
+1 NEW REC,AIEN,WHEN,BY,RIEN
+2 SET REC=""
+3 IF $DATA(^BEHOCIR("G","P",IEN))
Begin DoDot:1
+4 DO ADD2("")
+5 DO ADD2(" RECONCILATION DATA")
+6 FOR
SET REC=$ORDER(^BEHOCIR("G","P",IEN,REC))
IF REC=""
QUIT
Begin DoDot:2
+7 SET RIEN=""
FOR
SET RIEN=$ORDER(^BEHOCIR("G","P",IEN,REC,RIEN))
IF RIEN=""
QUIT
Begin DoDot:3
+8 SET AIEN=RIEN_","_REC_","
+9 SET WHEN=$$GET1^DIQ(90461.632,AIEN,.01)
+10 SET BY=$$GET1^DIQ(90461.632,AIEN,.02)
+11 DO ADD2(" - Reconciled on: "_WHEN_" by "_BY)
End DoDot:3
End DoDot:2
End DoDot:1
+12 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))
