BHSPL2 ;IHS/MSC/MGH - Health Summary for Items associated with Problem list ;09-Mar-2016 09:58;du
;;1.0;HEALTH SUMMARY COMPONENTS;**8,13**;Mar 17,2006;Build 6
;Patch 13 added normal/abnormal data
;===================================================================
POVP ;DISPLAY PROBLEMS USED BY LAST VISIT IN HEALTH SUMMARY
N TARGET,X,LINE,INVDT,QUIT
;For Visit instructions and treatments, the default is the latest visit
S NUM=1
S TARGET=$$TMPGBL
K @TARGET
D CKP^GMTSUP Q:$D(GMTSQIT)
;Find the last visit for this patient
S QUIT=0
S INVDT="" F S INVDT=$O(^AUPNVSIT("AA",DFN,INVDT)) Q:INVDT=""!(QUIT=1) D
.S VIEN="" S VIEN=$O(^AUPNVSIT("AA",DFN,INVDT,VIEN)) Q:VIEN=""!(QUIT=1) D
..I $P($G(^AUPNVSIT(VIEN,0)),U,7)="A" S QUIT=1 D PROB(VIEN)
Q
POVVST ;DISPLAY PROBLEMS USED BY VISITS IN HEALTH SUMMARY
N TARGET,X,LINE,INVDT,QUIT,NUM,CNT
;For Visit instructions and treatments, the default is the latest visit
S GMTSNDM=$G(GMTSNDM)
I GMTSNDM<1 S GMTSNDM=999
S NUM=1,CNT=0
S TARGET=$$TMPGBL
K @TARGET
D CKP^GMTSUP Q:$D(GMTSQIT)
;Find the visits
S QUIT=0
S INVDT="" F S INVDT=$O(^AUPNVSIT("AA",DFN,INVDT)) Q:INVDT=""!(CNT>GMTSNDM) D
.S VIEN="" S VIEN=$O(^AUPNVSIT("AA",DFN,INVDT,VIEN)) Q:VIEN=""!(CNT>GMTSNDM) D
..I $P($G(^AUPNVSIT(VIEN,0)),U,7)="A" D
...S CNT=CNT+1
...D PROB(VIEN)
Q
PROB(VIEN) ;Find problems used in this visit
N LINE,VDT,STAT,PRIEN
S PRIEN=0
S VDT=$$GET1^DIQ(9000010,VIEN,.01)
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
..S TARGET=$$TMPGBL
..W !,"Visit Date: "_VDT,!
..D DETAIL(.TARGET,PRIEN,DFN)
..S LINE=0
..F S LINE=$O(@TARGET@(LINE)) Q:LINE="" D
...D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG W !,"Problems for Visit",!
...W @TARGET@(LINE),!
..K TARGET
Q
DETAIL(RET,IEN,DFN) ;Get a detail report on one problem
N ZERO,CNT,PROB,CLASS,STATUS,ACLASS,PIP,ONSET,SNOMED,DESC,IN,OUT,CHK
S VIEN=$G(VIEN)
S CNT=0
S ZERO=$G(^AUPNPROB(IEN,0))
S ACT=$G(ACT),NUM=$G(NUM)
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 ADD1($$GET1^DIQ(9000011,IEN,.01)," * Mapped ICD:")
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:")
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:")
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:")
S DESC=$P($G(^AUPNPROB(IEN,800)),U,2)
D ADD1(DESC," * Desc CT: ")
S CHK=$$POVCHK(IEN,VIEN)
D ADD1($P(CHK,U,1)," * POV: ")
I $P(CHK,U,2)'="" D ADD1($P(CHK,U,2)," * ")
D ADD2("")
D NOTES
D ICD(IEN)
D QUAL(IEN)
D CARE(IEN,DFN,"A")
D VISIT(IEN,DFN,1,.VIEN)
D CONSULT(IEN,DFN,NUM)
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)
.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,Q,FNUM
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 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)
..D ADD2("Entered by: "_BY_" On: "_WHEN)
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,"")
Q:'$D(^TMP("BGOPLAN",$J))
D ADD2("")
D ADD2(" GOALS")
D PLAN
;Then do all the care plans
K ^TMP("BGOPLAN",$J)
N DATA,STR
S DATA=""
I $G(ACT)="" S ACT="A"
D GET^BGOCPLAN(.DATA,IEN,DFN,"P",ACT,"")
Q:'$D(^TMP("BGOPLAN",$J))
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=1
D GET^BGOVVI(.DATA,DFN,IEN,NUM,"",.VIEN)
Q:'$D(^TMP("BGOVIN",$J))
D ADD2("")
D ADD2(" VISIT INSTRUCTIONS")
D VST
;Then do all the treatment/regimen entries
K ^TMP("BGOVIN",$J)
N DATA,STR,CT2
S DATA="",CT2=0
I $G(NUM)="" S NUM=1
D GET^BGOVTR(.DATA,DFN,IEN,NUM,"",.VIEN)
Q:'$D(^TMP("BGOVIN",$J))
D ADD2("")
D ADD2(" TREATMENT/REGIMENS")
D TREAT
K ^TMP("BGOVIN",$J)
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
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")
..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
TREAT ; GET THE TREATMENT DATA
N CT,STR,VIIEN,SNOMED,VDT,VCAT,FAC,EVDT,PRV,ENTBY,ENTDT,MODBY,MODDT
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)
.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.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)
Q
LOOK(SNOMED) ;LOOKUP CODE
N RET
S RET=$P($$DESC^BSTSAPI(SNOMED),U,2)
Q RET
TMPGBL() ;EP
K ^TMP("BHSPL",$J) Q $NA(^($J))
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
POVCHK(PRIEN,VIEN) ;Check for different provider narrative or normal/abnormal Patch 13
N VPOV,FOUND,NORM,VNAR
S FOUND=0
S VPOV=0 F S VPOV=$O(^AUPNVPOV("AD",VIEN,VPOV)) Q:VPOV=""!(FOUND=1) D
.I $P($G(^AUPNVPOV(VPOV,0)),U,16)=PRIEN D
..S FOUND=1
..S NORM=$$GET1^DIQ(9000010.07,VPOV,.29)
..S VNAR=$$GET1^DIQ(9000010.07,VPOV,.04)
Q VNAR_U_NORM
BHSPL2 ;IHS/MSC/MGH - Health Summary for Items associated with Problem list ;09-Mar-2016 09:58;du
+1 ;;1.0;HEALTH SUMMARY COMPONENTS;**8,13**;Mar 17,2006;Build 6
+2 ;Patch 13 added normal/abnormal data
+3 ;===================================================================
POVP ;DISPLAY PROBLEMS USED BY LAST VISIT IN HEALTH SUMMARY
+1 NEW TARGET,X,LINE,INVDT,QUIT
+2 ;For Visit instructions and treatments, the default is the latest visit
+3 SET NUM=1
+4 SET TARGET=$$TMPGBL
+5 KILL @TARGET
+6 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+7 ;Find the last visit for this patient
+8 SET QUIT=0
+9 SET INVDT=""
FOR
SET INVDT=$ORDER(^AUPNVSIT("AA",DFN,INVDT))
IF INVDT=""!(QUIT=1)
QUIT
Begin DoDot:1
+10 SET VIEN=""
SET VIEN=$ORDER(^AUPNVSIT("AA",DFN,INVDT,VIEN))
IF VIEN=""!(QUIT=1)
QUIT
Begin DoDot:2
+11 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,7)="A"
SET QUIT=1
DO PROB(VIEN)
End DoDot:2
End DoDot:1
+12 QUIT
POVVST ;DISPLAY PROBLEMS USED BY VISITS IN HEALTH SUMMARY
+1 NEW TARGET,X,LINE,INVDT,QUIT,NUM,CNT
+2 ;For Visit instructions and treatments, the default is the latest visit
+3 SET GMTSNDM=$GET(GMTSNDM)
+4 IF GMTSNDM<1
SET GMTSNDM=999
+5 SET NUM=1
SET CNT=0
+6 SET TARGET=$$TMPGBL
+7 KILL @TARGET
+8 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+9 ;Find the visits
+10 SET QUIT=0
+11 SET INVDT=""
FOR
SET INVDT=$ORDER(^AUPNVSIT("AA",DFN,INVDT))
IF INVDT=""!(CNT>GMTSNDM)
QUIT
Begin DoDot:1
+12 SET VIEN=""
SET VIEN=$ORDER(^AUPNVSIT("AA",DFN,INVDT,VIEN))
IF VIEN=""!(CNT>GMTSNDM)
QUIT
Begin DoDot:2
+13 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,7)="A"
Begin DoDot:3
+14 SET CNT=CNT+1
+15 DO PROB(VIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
PROB(VIEN) ;Find problems used in this visit
+1 NEW LINE,VDT,STAT,PRIEN
+2 SET PRIEN=0
+3 SET VDT=$$GET1^DIQ(9000010,VIEN,.01)
+4 FOR
SET PRIEN=$ORDER(^AUPNPROB("AC",DFN,PRIEN))
IF 'PRIEN
QUIT
Begin DoDot:1
+5 ;Check for which statuses to return
+6 SET STAT=$PIECE($GET(^AUPNPROB(PRIEN,0)),U,12)
+7 IF STAT="D"
QUIT
+8 IF $DATA(^AUPNPROB(PRIEN,14,"B",VIEN))
Begin DoDot:2
+9 SET TARGET=$$TMPGBL
+10 WRITE !,"Visit Date: "_VDT,!
+11 DO DETAIL(.TARGET,PRIEN,DFN)
+12 SET LINE=0
+13 FOR
SET LINE=$ORDER(@TARGET@(LINE))
IF LINE=""
QUIT
Begin DoDot:3
+14 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
IF GMTSNPG
WRITE !,"Problems for Visit",!
+15 WRITE @TARGET@(LINE),!
End DoDot:3
+16 KILL TARGET
End DoDot:2
End DoDot:1
+17 QUIT
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,CHK
+2 SET VIEN=$GET(VIEN)
+3 SET CNT=0
+4 SET ZERO=$GET(^AUPNPROB(IEN,0))
+5 SET ACT=$GET(ACT)
SET NUM=$GET(NUM)
+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 ADD1($$GET1^DIQ(9000011,IEN,.01)," * Mapped ICD:")
+11 SET CLASS=$$GET1^DIQ(9000011,IEN,.04)
+12 SET STATUS=$$GET1^DIQ(9000011,IEN,.12)
+13 IF CLASS'=""
SET STATUS=STATUS_" * Class: "_CLASS
+14 DO ADD1(STATUS," * Status:")
+15 IF $$GET1^DIQ(9000011,IEN,.13)=""
SET ONSET="UNKNOWN"
+16 IF '$TEST
SET ONSET=$$GET1^DIQ(9000011,IEN,.13)
+17 DO ADD1(ONSET," * Date of Onset:")
+18 DO ADD1($$GET1^DIQ(9000011,IEN,.08)," * Date Entered:")
+19 DO ADD1($$GET1^DIQ(9000011,IEN,1.04)," * Recorded By:")
+20 DO ADD1($$GET1^DIQ(9000011,IEN,.03)," * Last Modified:")
+21 DO ADD1($$GET1^DIQ(9000011,IEN,.14)," * Modified User:")
+22 SET ACLASS=$$GET1^DIQ(9000011,IEN,.15)
+23 IF ACLASS'=""
DO ADD1(ACLASS," * Asthma Class:")
+24 SET PIP=$$GET1^DIQ(9000011,IEN,.19,"I")
+25 IF PIP=1
DO ADD1(PIP," * Pregnancy DX:")
+26 SET SNOMED=$PIECE($GET(^AUPNPROB(IEN,800)),U,1)
+27 DO ADD1(SNOMED," * Concept CT:")
+28 SET DESC=$PIECE($GET(^AUPNPROB(IEN,800)),U,2)
+29 DO ADD1(DESC," * Desc CT: ")
+30 SET CHK=$$POVCHK(IEN,VIEN)
+31 DO ADD1($PIECE(CHK,U,1)," * POV: ")
+32 IF $PIECE(CHK,U,2)'=""
DO ADD1($PIECE(CHK,U,2)," * ")
+33 DO ADD2("")
+34 DO NOTES
+35 DO ICD(IEN)
+36 DO QUAL(IEN)
+37 DO CARE(IEN,DFN,"A")
+38 DO VISIT(IEN,DFN,1,.VIEN)
+39 DO CONSULT(IEN,DFN,NUM)
+40 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 SET NUM=$PIECE(NOTES(I),U,3)
+8 SET STAT=$PIECE(NOTES(I),U,5)
IF STAT="A"
SET STATUS="ACTIVE"
+9 SET BY=$PIECE(NOTES(I),U,7)
+10 SET BY=$$GET1^DIQ(200,BY,.01)
+11 SET WHEN=$$FMTE^XLFDT($PIECE(NOTES(I),U,6))
+12 SET NARR=$PIECE(NOTES(I),U,4)
+13 DO ADD2("Site: "_FAC_" Number: "_NUM_" Status: "_STAT)
+14 DO ADD2("Entered By: "_BY_" On: "_WHEN)
+15 DO ADD2(NARR)
+16 DO ADD2("")
End DoDot:1
+17 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,Q,FNUM
+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 BY=$$GET1^DIQ(FNUM,AIEN,.02)
+8 SET WHEN=$$GET1^DIQ(FNUM,AIEN,.03)
+9 SET Q=$$GET1^DIQ(FNUM,AIEN,.01)
+10 SET Q=$$CONCEPT^BGOPAUD(Q)
+11 DO ADD2(Q)
+12 DO ADD2("Entered by: "_BY_" On: "_WHEN)
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;Find the latest number of entries for each section using the
+15 ;parameter and return them to the calling program
+16 ;Input is IEN of Problem
+17 ; 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))
QUIT
+7 DO ADD2("")
+8 DO ADD2(" GOALS")
+9 DO PLAN
+10 ;Then do all the care plans
+11 KILL ^TMP("BGOPLAN",$JOB)
+12 NEW DATA,STR
+13 SET DATA=""
+14 IF $GET(ACT)=""
SET ACT="A"
+15 DO GET^BGOCPLAN(.DATA,IEN,DFN,"P",ACT,"")
+16 IF '$DATA(^TMP("BGOPLAN",$JOB))
QUIT
+17 DO ADD2("")
+18 DO ADD2(" CARE PLANS")
+19 DO PLAN
+20 KILL ^TMP("BGOPLAN",$JOB)
+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=1
+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 ;Then do all the treatment/regimen entries
+11 KILL ^TMP("BGOVIN",$JOB)
+12 NEW DATA,STR,CT2
+13 SET DATA=""
SET CT2=0
+14 IF $GET(NUM)=""
SET NUM=1
+15 DO GET^BGOVTR(.DATA,DFN,IEN,NUM,"",.VIEN)
+16 IF '$DATA(^TMP("BGOVIN",$JOB))
QUIT
+17 DO ADD2("")
+18 DO ADD2(" TREATMENT/REGIMENS")
+19 DO TREAT
+20 KILL ^TMP("BGOVIN",$JOB)
+21 QUIT
+22 ;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
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")
+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
TREAT ; GET THE TREATMENT DATA
+1 NEW CT,STR,VIIEN,SNOMED,VDT,VCAT,FAC,EVDT,PRV,ENTBY,ENTDT,MODBY,MODDT
+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 DO ADD2("SNOMED TERM: "_SNOMED)
+9 DO ADD2(" * Visit Date: "_VDT_" Category:"_VCAT)
+10 SET FAC=$PIECE(STR,U,6)
+11 DO ADD2(" * Facility: "_FAC)
+12 SET EVDT=$PIECE(STR,U,9)
+13 SET PRV=$PIECE(STR,U,13)
+14 DO ADD2(" * Provider: "_PRV)
+15 DO ADD2(" * Event Date: "_EVDT)
+16 SET ENTBY=$$GET1^DIQ(9000010.58,VIIEN,1217)
+17 SET ENTDT=$$GET1^DIQ(9000010.58,VIIEN,1216)
+18 SET MODBY=$$GET1^DIQ(9000010.58,VIIEN,1219)
+19 SET MODDT=$$GET1^DIQ(9000010.58,VIIEN,1218)
+20 DO ADD2(" * Entered by: "_ENTBY_" On: "_ENTDT)
+21 DO ADD2(" * Last Modified by: "_MODBY_" On: "_MODDT)
End DoDot:1
+22 QUIT
LOOK(SNOMED) ;LOOKUP CODE
+1 NEW RET
+2 SET RET=$PIECE($$DESC^BSTSAPI(SNOMED),U,2)
+3 QUIT RET
TMPGBL() ;EP
+1 KILL ^TMP("BHSPL",$JOB)
QUIT $NAME(^($JOB))
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
POVCHK(PRIEN,VIEN) ;Check for different provider narrative or normal/abnormal Patch 13
+1 NEW VPOV,FOUND,NORM,VNAR
+2 SET FOUND=0
+3 SET VPOV=0
FOR
SET VPOV=$ORDER(^AUPNVPOV("AD",VIEN,VPOV))
IF VPOV=""!(FOUND=1)
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^AUPNVPOV(VPOV,0)),U,16)=PRIEN
Begin DoDot:2
+5 SET FOUND=1
+6 SET NORM=$$GET1^DIQ(9000010.07,VPOV,.29)
+7 SET VNAR=$$GET1^DIQ(9000010.07,VPOV,.04)
End DoDot:2
End DoDot:1
+8 QUIT VNAR_U_NORM
