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

BTIUPDD1.m

Go to the documentation of this file. 
  1. BTIUPDD1 ; IHS/MSC/MGH - Problem Objects ;21-Oct-2015 14:20;DU
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**1012,1013,1014**;MAR 20, 2013;Build 6
  1.  ;IHS/MSC/MGH Patch 1013 added CP=2 for todays care plans
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1.  ;Get the problems associated with this visit and only the latest or items updated during this visit
  1. VST(DFN,TARGET,VIEN,CP) ;Problems updated this visit
  1.  N PROB,CNT,RET,I,VST
  1.  S CNT=0,CP=$G(CP)
  1.  K @TARGET
  1.  S VIEN=$G(VIEN)
  1.  I VIEN'="" G GETPRB
  1.  S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
  1.  I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
  1.  S VIEN=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
  1.  D GETPRB
  1.  I CNT=0 S @TARGET@(1,0)="No Problems used as POVs in this visit record"
  1.  Q "~@"_$NA(@TARGET)
  1.  ;
  1. GETPRB ;Get problems to update
  1.  N POV,PRIEN,PCNT,ARRAY
  1.  S ARRAY=""
  1.  I $G(VIEN)="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
  1.  S PCNT=0,PRIEN=0
  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.  ..D GETDATA(.ARRAY,PRIEN,VIEN)
  1.  ;IHS/MSC/MGH Patch 1014
  1.  D ADDITMS(.ARRAY)
  1.  Q
  1. GETDATA(ARRAY,PRIEN,VIEN) ;Get data for a problem
  1.  N NARR,STATUS,ICD
  1.  S NARR=$$POV^BTIUPDD(VIEN,PRIEN)
  1.  S ARRAY($P(NARR,U,2),$P(NARR,U,1),PRIEN)=""
  1.  Q
  1.  ;S NARR=$$GET1^DIQ(9000010.07,POV,.04)
  1. ADDITMS(ARRAY) ;Get items in order
  1.  N STAT,NARR,PRIEN
  1.  S STAT="" F  S STAT=$O(ARRAY(STAT)) Q:STAT=""  D
  1.  .S NARR="" F  S NARR=$O(ARRAY(STAT,NARR)) Q:NARR=""  D
  1.  ..S PRIEN="" F  S PRIEN=$O(ARRAY(STAT,NARR,PRIEN)) Q:PRIEN=""  D
  1.  ...S PCNT=PCNT+1
  1.  ...D ADD($J(PCNT,2)_")"_NARR_" "_"("_STAT_")")
  1.  ...D QUAL^BTIUPV1(PRIEN,.CNT)
  1.  ...I CP=1 D
  1.  ....D FINDCP^BTIUPV1(PRIEN,"G",.CNT)  ;Add goals
  1.  ....D FINDCP^BTIUPV1(PRIEN,"P",.CNT)  ;Add care plans
  1.  ...;IHS/MSC/MGH Patch 1013
  1.  ...I CP=2 D
  1.  ....D FINDCP(PRIEN,"G",.CNT)
  1.  ....D FINDCP(PRIEN,"P",.CNT)
  1.  ...D VIDT^BTIUPV1(PRIEN,VIEN,.CNT)   ;Visit instruction
  1.  ...D VTRDT^BTIUPV1(PRIEN,VIEN,.CNT)  ;V treatment/regimens
  1.  ...D REFDT^BTIUPV1(PRIEN,VIEN,.CNT)  ;V REFERRALS
  1.  ...D EDU^BTIUPV1(PRIEN,VIEN,.CNT)  ;V education by date
  1.  Q
  1. FINDCP(PRIEN,TYPE,CNT) ;Find a care plan for today Patch 1013
  1.  N INVDT,INVDT2,SIGNDT,ARRDT,STATUS,EDATE,IEN,NODE,PRV,PRVNM,INVDT,CPIEN,CVTDT,SIGN,NODE,Z,DONE,SIEN,PCNT,ARRAY
  1.  S DONE=0,PCNT=0,ARRAY=""
  1.  S INVDT="" S INVDT=$O(^AUPNCPL("APDT",PRIEN,TYPE,INVDT))
  1.  Q:INVDT=""
  1.  S CVTDT=9999999-INVDT
  1.  Q:$P(CVTDT,".",1)'=DT
  1.  S CPIEN="" F  S CPIEN=$O(^AUPNCPL("APDT",PRIEN,TYPE,INVDT,CPIEN)) Q:CPIEN=""  D
  1.  .S SIEN=$C(0) S SIEN=$O(^AUPNCPL(CPIEN,11,SIEN),-1)
  1.  .S STATUS=$P($G(^AUPNCPL(CPIEN,11,SIEN,0)),U,1)
  1.  .Q:STATUS'="A"
  1.  .S INVDT2=9999999-$P($G(^AUPNCPL(CPIEN,0)),U,5)
  1.  .S ARRAY(INVDT2,CPIEN)=""
  1.  Q:$D(ARRAY)<10
  1.  S ARRDT="" F  S ARRDT=$O(ARRAY(ARRDT)) Q:'+ARRDT  D
  1.  .S CPIEN="" F  S CPIEN=$O(ARRAY(ARRDT,CPIEN)) Q:'+CPIEN  D
  1.  ..I PCNT=0 S PCNT=1 D
  1.  ...I TYPE="P" D ADD("   -CARE PLANS:")
  1.  ...I TYPE="G" D ADD("   -GOALS:")
  1.  ..S NODE=$G(^AUPNCPL(CPIEN,0))
  1.  ..S PRV=$$GET1^DIQ(9000092,CPIEN,.03,"I")
  1.  ..S PRVNM=$$GET1^DIQ(9000092,CPIEN,.03)
  1.  ..S SIGNDT=$$GET1^DIQ(9000092,CPIEN,.08,"I")
  1.  ..S SIGNDT=$$FMTE^XLFDT($P(SIGNDT,".",1),5)
  1.  ..S SIGN=$$GET1^DIQ(9000092,CPIEN,.07)
  1.  ..S EDATE=$$GET1^DIQ(9000092,CPIEN,.05)
  1.  ..Q:SIGN=""&(PRV'=DUZ)
  1.  ..D TEXT^BTIUPV1(TYPE,CPIEN)
  1.  Q
  1. INPT(DFN,TARGET,VIEN,CP) ;Problems updated this hospitalization
  1.  N PROB,CNT,RET,I,VST
  1.  S CNT=0,CP=$G(CP)
  1.  K @TARGET
  1.  S VIEN=$G(VIEN)
  1.  I VIEN'="" G GETIP
  1.  S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
  1.  I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
  1.  S VIEN=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
  1.  D GETIP
  1.  I CNT=0 S @TARGET@(1,0)="No Problems used during this inpatient record"
  1.  Q "~@"_$NA(@TARGET)
  1.  ;
  1. GETIP ;Get problems to update
  1.  N PRIEN,PCNT,INP,STAT
  1.  S PCNT=0
  1.  S PRIEN="" 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.  .S INP=""
  1.  .F  S INP=$O(^AUPNPROB(PRIEN,15,"B",VIEN,INP)) Q:'+INP  D
  1.  ..D DATA(PRIEN,VIEN)
  1.  Q
  1. DATA(PRIEN,VIEN) ;Get data for a problem
  1.  N NARR,STATUS,ICD
  1.  S PCNT=PCNT+1
  1.  S NARR=$$GET1^DIQ(9000011,PRIEN,.05)
  1.  D ADD($J(PCNT,2)_")"_NARR)
  1.  D QUAL^BTIUPV1(PRIEN,.CNT)
  1.  I CP=2 D
  1.  .D FINDCP^BTIUPV1(PRIEN,"G",.CNT)  ;Add goals
  1.  .D FINDCP^BTIUPV1(PRIEN,"P",.CNT)  ;Add care plans
  1.  I CP>0 D
  1.  .D VIDT^BTIUPV1(PRIEN,VIEN,.CNT)   ;Visit instruction
  1.  .D VTRDT^BTIUPV1(PRIEN,VIEN,.CNT)  ;V treatment/regimens
  1.  .D REFDT^BTIUPV1(PRIEN,VIEN,.CNT)  ;V REFERRALS
  1.  .D EDU^BTIUPV1(PRIEN,VIEN,.CNT)  ;V education by date
  1.  Q
  1. ADD(DATA) ;add to list
  1.  S CNT=CNT+1
  1.  S @TARGET@(CNT,0)=DATA
  1.  Q
  1. TMPGBL(X) ;EP
  1.  K ^TMP("BGOPRDD",$J) Q $NA(^($J))