Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BHSPL2

BHSPL2.m

Go to the documentation of this file. 
  1. 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
  1.  ;Patch 13 added normal/abnormal data
  1.  ;===================================================================
  1. POVP ;DISPLAY PROBLEMS USED BY LAST VISIT IN HEALTH SUMMARY
  1.  N TARGET,X,LINE,INVDT,QUIT
  1.  ;For Visit instructions and treatments, the default is the latest visit
  1.  S NUM=1
  1.  S TARGET=$$TMPGBL
  1.  K @TARGET
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  ;Find the last visit for this patient
  1.  S QUIT=0
  1.  S INVDT="" F  S INVDT=$O(^AUPNVSIT("AA",DFN,INVDT)) Q:INVDT=""!(QUIT=1)  D
  1.  .S VIEN="" S VIEN=$O(^AUPNVSIT("AA",DFN,INVDT,VIEN)) Q:VIEN=""!(QUIT=1)  D
  1.  ..I $P($G(^AUPNVSIT(VIEN,0)),U,7)="A" S QUIT=1 D PROB(VIEN)
  1.  Q
  1. POVVST ;DISPLAY PROBLEMS USED BY VISITS IN HEALTH SUMMARY
  1.  N TARGET,X,LINE,INVDT,QUIT,NUM,CNT
  1.  ;For Visit instructions and treatments, the default is the latest visit
  1.  S GMTSNDM=$G(GMTSNDM)
  1.  I GMTSNDM<1 S GMTSNDM=999
  1.  S NUM=1,CNT=0
  1.  S TARGET=$$TMPGBL
  1.  K @TARGET
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  ;Find the visits
  1.  S QUIT=0
  1.  S INVDT="" F  S INVDT=$O(^AUPNVSIT("AA",DFN,INVDT)) Q:INVDT=""!(CNT>GMTSNDM)  D
  1.  .S VIEN="" S VIEN=$O(^AUPNVSIT("AA",DFN,INVDT,VIEN)) Q:VIEN=""!(CNT>GMTSNDM)  D
  1.  ..I $P($G(^AUPNVSIT(VIEN,0)),U,7)="A" D
  1.  ...S CNT=CNT+1
  1.  ...D PROB(VIEN)
  1.  Q
  1. PROB(VIEN) ;Find problems used in this visit
  1.  N LINE,VDT,STAT,PRIEN
  1.  S PRIEN=0
  1.  S VDT=$$GET1^DIQ(9000010,VIEN,.01)
  1.  F  S PRIEN=$O(^AUPNPROB("AC",DFN,PRIEN)) Q:'PRIEN  D
  1.  .;Check for which statuses to return
  1.  .S STAT=$P($G(^AUPNPROB(PRIEN,0)),U,12)
  1.  .Q:STAT="D"
  1.  .I $D(^AUPNPROB(PRIEN,14,"B",VIEN))  D
  1.  ..S TARGET=$$TMPGBL
  1.  ..W !,"Visit Date: "_VDT,!
  1.  ..D DETAIL(.TARGET,PRIEN,DFN)
  1.  ..S LINE=0
  1.  ..F  S LINE=$O(@TARGET@(LINE)) Q:LINE=""  D
  1.  ...D CKP^GMTSUP Q:$D(GMTSQIT)  I GMTSNPG W !,"Problems for Visit",!
  1.  ...W @TARGET@(LINE),!
  1.  ..K TARGET
  1.  Q
  1. DETAIL(RET,IEN,DFN) ;Get a detail report on one problem
  1.  N ZERO,CNT,PROB,CLASS,STATUS,ACLASS,PIP,ONSET,SNOMED,DESC,IN,OUT,CHK
  1.  S VIEN=$G(VIEN)
  1.  S CNT=0
  1.  S ZERO=$G(^AUPNPROB(IEN,0))
  1.  S ACT=$G(ACT),NUM=$G(NUM)
  1.  D ADD2(""),ADD2("PROBLEM DATA")
  1.  D ADD1($$GET1^DIQ(9000011,IEN,.07),"  ID:")
  1.  S PROB=$$GET1^DIQ(9000011,IEN,.05)
  1.  D ADD1(PROB,"Problem:")
  1.  D ADD1($$GET1^DIQ(9000011,IEN,.01)," * Mapped ICD:")
  1.  S CLASS=$$GET1^DIQ(9000011,IEN,.04)
  1.  S STATUS=$$GET1^DIQ(9000011,IEN,.12)
  1.  I CLASS'="" S STATUS=STATUS_" * Class: "_CLASS
  1.  D ADD1(STATUS," * Status:")
  1.  I $$GET1^DIQ(9000011,IEN,.13)="" S ONSET="UNKNOWN"
  1.  E  S ONSET=$$GET1^DIQ(9000011,IEN,.13)
  1.  D ADD1(ONSET," * Date of Onset:")
  1.  D ADD1($$GET1^DIQ(9000011,IEN,.08)," * Date Entered:")
  1.  D ADD1($$GET1^DIQ(9000011,IEN,1.04)," * Recorded By:")
  1.  D ADD1($$GET1^DIQ(9000011,IEN,.03)," * Last Modified:")
  1.  D ADD1($$GET1^DIQ(9000011,IEN,.14)," * Modified User:")
  1.  S ACLASS=$$GET1^DIQ(9000011,IEN,.15)
  1.  I ACLASS'="" D ADD1(ACLASS," * Asthma Class:")
  1.  S PIP=$$GET1^DIQ(9000011,IEN,.19,"I")
  1.  I PIP=1 D ADD1(PIP," * Pregnancy DX:")
  1.  S SNOMED=$P($G(^AUPNPROB(IEN,800)),U,1)
  1.  D ADD1(SNOMED," * Concept CT:")
  1.  S DESC=$P($G(^AUPNPROB(IEN,800)),U,2)
  1.  D ADD1(DESC," * Desc CT: ")
  1.  S CHK=$$POVCHK(IEN,VIEN)
  1.  D ADD1($P(CHK,U,1)," * POV: ")
  1.  I $P(CHK,U,2)'="" D ADD1($P(CHK,U,2)," * ")
  1.  D ADD2("")
  1.  D NOTES
  1.  D ICD(IEN)
  1.  D QUAL(IEN)
  1.  D CARE(IEN,DFN,"A")
  1.  D VISIT(IEN,DFN,1,.VIEN)
  1.  D CONSULT(IEN,DFN,NUM)
  1.  Q
  1. NOTES ; Get the notes for this problem
  1.  N AIEN,IEN2,BY,WHEN,NUM,FAC,NARR,I,NOTES
  1.  D NOTES^BGOPRBN(.NOTES,IEN,1)
  1.  I $D(NOTES)>1 D ADD2("          NOTES")
  1.  S I="" F  S I=$O(NOTES(I)) Q:I=""  D
  1.  .S FAC=$P(NOTES(I),U,1)
  1.  .S FAC=$$GET1^DIQ(9999999.06,FAC,.01)
  1.  .S NUM=$P(NOTES(I),U,3)
  1.  .S STAT=$P(NOTES(I),U,5) I STAT="A" S STATUS="ACTIVE"
  1.  .S BY=$P(NOTES(I),U,7)
  1.  .S BY=$$GET1^DIQ(200,BY,.01)
  1.  .S WHEN=$$FMTE^XLFDT($P(NOTES(I),U,6))
  1.  .S NARR=$P(NOTES(I),U,4)
  1.  .D ADD2("Site: "_FAC_"  Number: "_NUM_" Status: "_STAT)
  1.  .D ADD2("Entered By: "_BY_"   On: "_WHEN)
  1.  .D ADD2(NARR)
  1.  .D ADD2("")
  1.  Q
  1. ICD(IEN) ;Get any additional ICD codes for this problem
  1.  N AIEN,IEN2
  1.  I $D(^AUPNPROB(IEN,12)) D ADD2("     Additional ICD Codes")
  1.  S IEN2=0 F  S IEN2=$O(^AUPNPROB(IEN,12,IEN2)) Q:'+IEN2  D
  1.  .S AIEN=IEN2_","_IEN_","
  1.  .D ADD2($$GET1^DIQ(9000011.12,AIEN,.01))
  1.  Q
  1. QUAL(IEN) ;Get any qualifiers for this problem
  1.  N AIEN,IEN2,BY,WHEN,X,Q,FNUM
  1.  I $D(^AUPNPROB(IEN,13))!($D(^AUPNPROB(IEN,17)))!($D(^AUPNPROB(IEN,18))) D ADD2("     QUALIFIERS")
  1.  F X=13,17,18 D
  1.  .S FNUM=$S(X=13:9000011.13,X=17:9000011.17,X=18:9000011.18)
  1.  .S IEN2=0 F  S IEN2=$O(^AUPNPROB(IEN,X,IEN2)) Q:'+IEN2  D
  1.  ..S AIEN=IEN2_","_IEN_","
  1.  ..S BY=$$GET1^DIQ(FNUM,AIEN,.02)
  1.  ..S WHEN=$$GET1^DIQ(FNUM,AIEN,.03)
  1.  ..S Q=$$GET1^DIQ(FNUM,AIEN,.01)
  1.  ..S Q=$$CONCEPT^BGOPAUD(Q)
  1.  ..D ADD2(Q)
  1.  ..D ADD2("Entered by: "_BY_"    On: "_WHEN)
  1.  Q
  1.  ;Find the latest number of entries for each section using the
  1.  ;parameter and return them to the calling program
  1.  ;Input is IEN of Problem
  1.  ;         DFN of Patient
  1. CARE(IEN,DFN,ACT) ;EP
  1.  ;Start with all the goals
  1.  N DATA,STR
  1.  S DATA=""
  1.  I $G(ACT)="" S ACT="A"
  1.  D GET^BGOCPLAN(.DATA,IEN,DFN,"G",ACT,"")
  1.  Q:'$D(^TMP("BGOPLAN",$J))
  1.  D ADD2("")
  1.  D ADD2("          GOALS")
  1.  D PLAN
  1.  ;Then do all the care plans
  1.  K ^TMP("BGOPLAN",$J)
  1.  N DATA,STR
  1.  S DATA=""
  1.  I $G(ACT)="" S ACT="A"
  1.  D GET^BGOCPLAN(.DATA,IEN,DFN,"P",ACT,"")
  1.  Q:'$D(^TMP("BGOPLAN",$J))
  1.  D ADD2("")
  1.  D ADD2("    CARE PLANS")
  1.  D PLAN
  1.  K ^TMP("BGOPLAN",$J)
  1.  Q
  1. VISIT(IEN,DFN,NUM,VIEN) ;visit instructions
  1.  ;Next get all the visit instructions
  1.  N DATA,STR
  1.  S DATA=""
  1.  I $G(NUM)="" S NUM=1
  1.  D GET^BGOVVI(.DATA,DFN,IEN,NUM,"",.VIEN)
  1.  Q:'$D(^TMP("BGOVIN",$J))
  1.  D ADD2("")
  1.  D ADD2("    VISIT INSTRUCTIONS")
  1.  D VST
  1.  ;Then do all the treatment/regimen entries
  1.  K ^TMP("BGOVIN",$J)
  1.  N DATA,STR,CT2
  1.  S DATA="",CT2=0
  1.  I $G(NUM)="" S NUM=1
  1.  D GET^BGOVTR(.DATA,DFN,IEN,NUM,"",.VIEN)
  1.  Q:'$D(^TMP("BGOVIN",$J))
  1.  D ADD2("")
  1.  D ADD2("    TREATMENT/REGIMENS")
  1.  D TREAT
  1.  K ^TMP("BGOVIN",$J)
  1.  Q
  1.  ;Get all the consults
  1. CONSULT(IEN,DFN,NUM) ;FIND consults
  1.  N DATA,STR,CT2,SER,SDATE,SSTAT
  1.  S DATA=""
  1.  I $G(NUM)="" S NUM=99999
  1.  D GETCON^BGOVTR(.DATA,DFN,IEN,NUM,"")
  1.  Q:'$D(^TMP("BGOVIN",$J))
  1.  D ADD2("")
  1.  D ADD2("     CONSULTS")
  1.  S CT2=0
  1.  F  S CT2=$O(^TMP("BGOVIN",$J,CT2)) Q:'+CT2  D
  1.  .S STR=$G(^TMP("BGOVIN",$J,CT2))
  1.  .S SER=$P(STR,U,2),SDATE=$P(STR,U,3),SSTAT=$P(STR,U,4)
  1.  .D ADD2("CONSULT: "_SER)
  1.  .D ADD2(" * Date Ordered: "_SDATE_"  Status: "_SSTAT)
  1.  Q
  1. PLAN ;GET ALL CARE PLANNING DATA
  1.  N CT2,STR,STAT,SIGNED,CPIEN,SIGNBY,SIGNDT
  1.  S CT2=0
  1.  F  S CT2=$O(^TMP("BGOPLAN",$J,CT2)) Q:'+CT2  D
  1.  .S STR=$G(^TMP("BGOPLAN",$J,CT2))
  1.  .I $P(STR,U,1)="~t" D
  1.  ..D ADD2($P(STR,U,2))
  1.  .E  D
  1.  ..S BY=$P(STR,U,4),WHEN=$P(STR,U,5)
  1.  ..D ADD2(" * Entered by: "_BY_"    On: "_WHEN)
  1.  ..S STAT=$P(STR,U,6)
  1.  ..S STAT=$S(STAT="A":"Active",STAT="I":"Inactive",STAT="R":"Replaced")
  1.  ..D ADD2(" * Status: "_STAT)
  1.  ..S SIGNED=$P(STR,U,7)
  1.  ..I SIGNED=1 D
  1.  ...S CPIEN=$P(STR,U,2)
  1.  ...S SIGNBY=$$GET1^DIQ(9000092,CPIEN,.07)
  1.  ...S SIGNDT=$$GET1^DIQ(9000092,CPIEN,.08)
  1.  ...D ADD2(" * Signed by: "_SIGNBY_"    on: "_SIGNDT)
  1.  Q
  1. VST ;GET ALL VISIT INSTRUCTIONS
  1.  N CT2,STR,STAT,SIGNED,VIIEN,SIGNBY,SIGNDT,FAC,VDT,VCAT,EVDT,PRV,ENTBY,ENTDT,MODBY,MODDT
  1.  S CT2=0
  1.  F  S CT2=$O(^TMP("BGOVIN",$J,CT2)) Q:'+CT2  D
  1.  .S STR=$G(^TMP("BGOVIN",$J,CT2))
  1.  .I $P(STR,U,1)="~t" D
  1.  ..D ADD2($P(STR,U,2))
  1.  .E  D
  1.  ..S VIIEN=$P(STR,U,2)
  1.  ..S VDT=$P(STR,U,4)
  1.  ..S VCAT=$P(STR,U,10)
  1.  ..D ADD2("Visit Date: "_VDT_"  Category:"_VCAT)
  1.  ..S FAC=$P(STR,U,5)
  1.  ..D ADD2(" * Facility: "_FAC)
  1.  ..S EVDT=$P(STR,U,8)
  1.  ..S PRV=$P(STR,U,12)
  1.  ..D ADD2(" * Provider: "_PRV)
  1.  ..D ADD2(" * Event Date: "_EVDT)
  1.  ..S SIGNBY=$$GET1^DIQ(9000010.58,VIIEN,.04)
  1.  ..S ENTBY=$$GET1^DIQ(9000010.58,VIIEN,1217)
  1.  ..S ENTDT=$$GET1^DIQ(9000010.58,VIIEN,1216)
  1.  ..S MODBY=$$GET1^DIQ(9000010.58,VIIEN,1219)
  1.  ..S MODDT=$$GET1^DIQ(9000010.58,VIIEN,1218)
  1.  ..D ADD2(" * Entered by: "_ENTBY_"    On: "_ENTDT)
  1.  ..D ADD2(" * Last Modified by: "_MODBY_"  On: "_MODDT)
  1.  ..S SIGNDT=$P(STR,U,13)
  1.  ..I SIGNDT'="" D ADD2(" * Signed by: "_SIGNBY_"    on: "_SIGNDT)
  1.  Q
  1. TREAT ; GET THE TREATMENT DATA
  1.  N CT,STR,VIIEN,SNOMED,VDT,VCAT,FAC,EVDT,PRV,ENTBY,ENTDT,MODBY,MODDT
  1.  F  S CT2=$O(^TMP("BGOVIN",$J,CT2)) Q:'+CT2  D
  1.  .S STR=$G(^TMP("BGOVIN",$J,CT2))
  1.  .S VIIEN=$P(STR,U,2)
  1.  .S SNOMED=$P(STR,U,3)
  1.  .S VDT=$P(STR,U,5)
  1.  .S VCAT=$P(STR,U,11)
  1.  .D ADD2("SNOMED TERM: "_SNOMED)
  1.  .D ADD2(" * Visit Date: "_VDT_"  Category:"_VCAT)
  1.  .S FAC=$P(STR,U,6)
  1.  .D ADD2(" * Facility: "_FAC)
  1.  .S EVDT=$P(STR,U,9)
  1.  .S PRV=$P(STR,U,13)
  1.  .D ADD2(" * Provider: "_PRV)
  1.  .D ADD2(" * Event Date: "_EVDT)
  1.  .S ENTBY=$$GET1^DIQ(9000010.58,VIIEN,1217)
  1.  .S ENTDT=$$GET1^DIQ(9000010.58,VIIEN,1216)
  1.  .S MODBY=$$GET1^DIQ(9000010.58,VIIEN,1219)
  1.  .S MODDT=$$GET1^DIQ(9000010.58,VIIEN,1218)
  1.  .D ADD2(" * Entered by: "_ENTBY_"    On: "_ENTDT)
  1.  .D ADD2(" * Last Modified by: "_MODBY_"  On: "_MODDT)
  1.  Q
  1. LOOK(SNOMED) ;LOOKUP CODE
  1.  N RET
  1.  S RET=$P($$DESC^BSTSAPI(SNOMED),U,2)
  1.  Q RET
  1. TMPGBL() ;EP
  1.  K ^TMP("BHSPL",$J) Q $NA(^($J))
  1. ADD1(TXT,LBL) ;
  1.  S CNT=CNT+1 S @RET@(CNT)=$S($D(LBL):$$LJ^XLFSTR(LBL,20),1:"")_$G(TXT),LBL=""
  1.  Q
  1. ADD2(TXT) ;
  1.  S CNT=CNT+1 S @RET@(CNT)=TXT
  1.  Q
  1. POVCHK(PRIEN,VIEN) ;Check for different provider narrative or normal/abnormal Patch 13
  1.  N VPOV,FOUND,NORM,VNAR
  1.  S FOUND=0
  1.  S VPOV=0 F  S VPOV=$O(^AUPNVPOV("AD",VIEN,VPOV)) Q:VPOV=""!(FOUND=1)  D
  1.  .I $P($G(^AUPNVPOV(VPOV,0)),U,16)=PRIEN D
  1.  ..S FOUND=1
  1.  ..S NORM=$$GET1^DIQ(9000010.07,VPOV,.29)
  1.  ..S VNAR=$$GET1^DIQ(9000010.07,VPOV,.04)
  1.  Q VNAR_U_NORM