- 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))