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

BEHOPLDD.m

Go to the documentation of this file.
  1. 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
  1. ;---------------------------------------------
  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,ACT
  1. S VIEN=$G(VIEN)
  1. S ZERO=$G(^AUPNPROB(IEN,0))
  1. S ACT=$G(ACT),NUM=$G(NUM)
  1. S RET=$$TMPGBL,CNT=0
  1. I $G(IEN)="" D ADD("No problem entered")
  1. D ADD2(""),ADD2("PROBLEM DATA")
  1. D ADD1($$GET1^DIQ(9000011,IEN,.07)," ID:")
  1. S PROB=$$GET1^DIQ(9000011,IEN,.05)
  1. I $P(PROB,"|",2)=""!($P(PROB,"|",2)=" ") S PROB=$P(PROB,"|",1)
  1. D ADD1(PROB,"Problem:")
  1. D CHANGED^BGOPAUD(IEN,.05)
  1. D ADD1($$GET1^DIQ(9000011,IEN,.01)," * Mapped ICD:")
  1. D CHANGED^BGOPAUD(IEN,.01)
  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. D CHANGED^BGOPAUD(IEN,.12)
  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,.03)," * Date Last Modified:")
  1. D ADD1($$GET1^DIQ(9000011,IEN,1.04)," * Recorded By:")
  1. S ACLASS=$$GET1^DIQ(9000011,IEN,.15)
  1. I ACLASS'="" D ADD1(ACLASS," * Asthma Class:")
  1. D CHANGED^BGOPAUD(IEN,.15)
  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. D CHANGED^BGOPAUD(IEN,80001)
  1. S DESC=$P($G(^AUPNPROB(IEN,800)),U,2)
  1. D ADD1(DESC," * Desc CT: ")
  1. D CHANGED^BGOPAUD(IEN,80002)
  1. D ADD2("")
  1. D ICD(IEN)
  1. D QUAL(IEN)
  1. D NOTES
  1. I VIEN="" D POV(IEN),ADD2("")
  1. D INPT(IEN)
  1. D RECON(IEN)
  1. Q
  1. NOTES ; Get the notes for this problem
  1. N AIEN,IEN2,BY,WHEN,NUM,FAC,NARR,I,NOTES,STAT
  1. D NOTES^BGOPRBN(.NOTES,IEN,1)
  1. I $D(NOTES)>1 D ADD2("") 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. .D CHANGED^BGOPAUD(IEN,"9000011.11,.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,FNUM,X,Q,FLD
  1. F X=13,17,18 D
  1. .I $D(^AUPNPROB(IEN,X)) D ADD2(" QUALIFIERS")
  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. ..I X=13 D
  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. ..I X=13 D ADD2("Entered by: "_BY_" On: "_WHEN)
  1. ..S FLD=$S(X=13:1301,X=17:1701,X=18:1801)
  1. ..D CHANGED^BGOPAUD(IEN,FLD_",.01")
  1. Q
  1. POV(IEN) ;See if this problem has been used as a POV
  1. N AIEN,IEN2,BY,WHEN,CLIN,VSIT
  1. I $D(^AUPNPROB(IEN,14)) D ADD2(" Visits when used as POV")
  1. S IEN2=0 F S IEN2=$O(^AUPNPROB(IEN,14,IEN2)) Q:'+IEN2 D
  1. .S VSIT=$G(^AUPNPROB(IEN,14,IEN2,0))
  1. .S CLIN=$P($G(^AUPNVSIT(VSIT,0)),U,8)
  1. .;IHS/MSC/MGH Remove quitting if pharamcy visit
  1. .;Q:CLIN=39 ;Don't include pharmacy visits
  1. .S AIEN=IEN2_","_IEN_","
  1. .D ADD2($$GET1^DIQ(9000011.14,AIEN,.01))
  1. Q
  1. INPT(IEN) ;See if this problem has been used for inpt visits
  1. N AIEN,IEN2,BY,WHEN
  1. I $D(^AUPNPROB(IEN,15))>10 D ADD2(" Used for Inpt Visits")
  1. S IEN2=0 F S IEN2=$O(^AUPNPROB(IEN,15,IEN2)) Q:'+IEN2 D
  1. .S AIEN=IEN2_","_IEN_","
  1. .D ADD2($$GET1^DIQ(9000011.15,AIEN,.01))
  1. Q
  1. RECON(IEN) ;Display the reconciliation data for this problem
  1. N REC,AIEN,WHEN,BY,RIEN
  1. S REC=""
  1. F S REC=$O(^BEHOCIR("G","P",IEN,REC)) Q:REC="" D
  1. .S RIEN="" F S RIEN=$O(^BEHOCIR("G","A",IEN,REC,RIEN)) Q:RIEN="" D
  1. ..S AIEN=RIEN_","_REC_","
  1. ..S WHEN=$$GET1^DIQ(90461.632,AIEN,.01)
  1. ..S BY=$$GET1^DIQ(90461.632,AIEN,.02)
  1. ..W ?10,"Reconciled on: "_WHEN_" by "_BY,!
  1. Q
  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. TMPGBL(X) ;EP
  1. K ^TMP("BGOPRDD",$J) Q $NA(^($J))