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

BTIUCPL.m

Go to the documentation of this file. 
  1. BTIUCPL ; IHS/MSC/JS - TIU V Care Plan Object ;25-Nov-2013 10:05;DU
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**1012**;MAR 20, 2013;Build 45
  1.  ;5/22/13 - TO TEST EHR GUI, PARAMETER 'PARAM' HARDSET = 265 (PROBLEM IEN)
  1.  ;
  1.  ; <<< USE VISIT IEN 2434 (FEB 22 2013 @13:59) PATIENT TEST,MAX >>>
  1.  ;
  1.  ;
  1.  ;NUMBER: 668    NAME: V CARE PLAN
  1.  ;DESCRIPTION:   Artifact 13530 - MU TIU Objects for Care Plan
  1.  ;
  1.  ;OBJECT METHOD: S RET=$$CPL^BTIUCPL(DFN,"^TMP(""BTIUCPL"",$J)",+$G(TIU("VISIT"),$G(PARAM)))
  1.  ;
  1.  ;TEST DIRECT:   S RET=$$CPL^BTIUCPL(DFN,"^TMP(""BTIUCPL"",$J)",+$G(TIU("VISIT"),$G(PARAM)))
  1.  ;                               (DFN=76,PRIEN=265,PARAM="L")
  1.  ;
  1.  ;               S RET=$$CPL^BTIUCPL(76,"BTIUCPL",2434,265)
  1.  ;
  1.  ; ^AUPNCPL("ASDT",265,"G",6869670.869591,"A",1,1)=""
  1.  ; ^AUPNCPL("ASDT",266,"P",6869669.884771,"A",2,1)=""
  1.  ; ^AUPNCPL("ASDT",267,"G",6869669.884586,"A",3,1)=""
  1.  ; ^AUPNCPL("ASDT",268,"G",6869596.906661,"A",4,1)=""
  1.  ;
  1.  ; ^AUPNCPL("B",265,1)=""
  1.  ; ^AUPNCPL("B",266,2)=""
  1.  ; ^AUPNCPL("B",267,3)=""
  1.  ; ^AUPNCPL("B",268,4)=""
  1.  ;
  1. CPL(DFN,TARGET,VIEN,PARAM) ;EHR p12
  1.  ;  DFN    = The patient this problem belongs to
  1.  ;  TARGET = Location of object report
  1.  ;  VIEN   = Visit ien (optional)   [IF VIEN PASSED, PROBLEM(S) RETURNED ARE 'Purpose of Visit' POV]
  1.  ;  PARAM  = A  All problems        [IF VIEN NULL AND PARAM NULL, DEFAULTS TO 'L' LAST DATE PROBLEM]
  1.  ;           C  Active problems
  1.  ;           L  Last date problem
  1.  ;           Problem ien
  1.  ;
  1.  N CNT,CONIEN,CPLANG,CPLANP,CPLARR,CPLCON,CPLVED,CPLVTR,CPLVVI,FNUM,IEN,SNO,STATUS
  1.  N VED,VST,VTRIN,VVIN,VVISIT
  1.  I $G(TARGET)="" S TARGET=$$TMPGBL
  1.  ;I $G(TARGET)="" S TARGET="BTIUCPL"
  1.  K @TARGET
  1.  S RET=""
  1.  S CNT=0
  1.  I $G(DFN)="" S @TARGET@(1,0)="Invalid input - Missing Patient DFN" Q "~@"_$NA(@TARGET)
  1.  I $G(VIEN)="" S @TARGET@(1,0)="Invalid input - Missing Visit ien" Q "~@"_$NA(@TARGET)
  1.  I $G(PARAM)="" S @TARGET@(1,0)="Invalid input - PARAM not a valid Problem ien" Q "~@"_$NA(@TARGET)
  1.  I $G(PARAM)]"" I PARAM'?1N.E S @TARGET@(1,0)="Invalid input - PARAM not a valid Problem ien" Q "~@"_$NA(@TARGET)
  1.  ;
  1.  I $G(PARAM)="" S PARAM="L" ;  default to last date  <<<< future, if 'L' use VVI lkup  5/22/13 <<<<
  1.  ;
  1.  I $G(PARAM)]"" I PARAM?1N.E D PRIEN(PARAM)
  1.  Q "~@"_$NA(@TARGET)
  1.  ;
  1. PRIEN(PRIEN) ;
  1. 1 ;-- Get the patient care plan data record(s) --
  1.  N X S X="" D CPLAN(.X,PRIEN,DFN,"G",.CNT) ;   Care Plan Goals
  1.  N X S X="" D CPLAN(.X,PRIEN,DFN,"P",.CNT) ;   Care Plan of Care
  1.  N X S X="" D CPLVVI(.X,DFN,PRIEN,.CNT) ;      Visit Instructions
  1.  N X S X="" D CPLVTR(.X,DFN,PRIEN,.CNT) ;      Treatment/Regimen
  1.  N X S X="" D CPLVED(.X,DFN,PRIEN,.CNT) ;      Patient Education
  1.  N X S X="" D CPLCON(.X,DFN,PRIEN,.CNT) ;      Consults
  1.  ;
  1.  I CNT=0 S @TARGET@(1,0)="No Care Plan record found for patient" Q "~@"_$NA(@TARGET)
  1.  ;
  1. 2 ; -- call GETS^DIQ for file entries --
  1.  S IEN="",FNUM=9000092 F  S IEN=$O(CPLANG(IEN)) Q:IEN=""  D GETDATA
  1.  S IEN="",FNUM=9000092 F  S IEN=$O(CPLANP(IEN)) Q:IEN=""  D GETDATA
  1.  S IEN="",FNUM=9000010.58 F  S IEN=$O(CPLVVI(IEN)) Q:IEN=""  D GETDATA
  1.  S IEN="",FNUM=9000010.61 F  S IEN=$O(CPLVTR(IEN)) Q:IEN=""  D GETDATA
  1.  S IEN="",FNUM=9000010.16 F  S IEN=$O(CPLVED(IEN)) Q:IEN=""  D GETDATA
  1.  S IEN="",FNUM=123 F  S IEN=$O(CPLCON(IEN)) Q:IEN=""  D GETDATA
  1.  ;
  1. 3 ; -- format object report --
  1.  N CNT,SPACE,STRPAD
  1.  S CNT=0
  1.  S $P(SPACE," ",1)=""
  1.  S $P(STRPAD," ",3)=""
  1.  S IEN="",FNUM=9000092 F  S IEN=$O(CPLANG(IEN)) Q:IEN=""  D OUT^BTIUCPL1
  1.  S IEN="",FNUM=9000092 F  S IEN=$O(CPLANP(IEN)) Q:IEN=""  D OUT^BTIUCPL1
  1.  S IEN="",FNUM=9000010.58 F  S IEN=$O(CPLVVI(IEN)) Q:IEN=""  D OUT^BTIUCPL1
  1.  S IEN="",FNUM=9000010.61 F  S IEN=$O(CPLVTR(IEN)) Q:IEN=""  D OUT^BTIUCPL1
  1.  S IEN="",FNUM=9000010.16 F  S IEN=$O(CPLVED(IEN)) Q:IEN=""  D OUT^BTIUCPL1
  1.  S IEN="",FNUM=123 F  S IEN=$O(CPLCON(IEN)) Q:IEN=""  D OUT^BTIUCPL1
  1.  ;
  1. CPLAN(DATA,IEN,DFN,TYPE,CNT) ;
  1.  N INVDT,RET
  1.  S INVDT=""
  1.  F  S INVDT=$O(^AUPNCPL("ASDT",IEN,TYPE,INVDT)) Q:INVDT=""  D
  1.  .S STATUS="" F  S STATUS=$O(^AUPNCPL("ASDT",IEN,TYPE,INVDT,STATUS)) Q:STATUS=""  D
  1.  ..Q:STATUS="E"
  1.  ..N CPIEN,SIEN
  1.  ..S CPIEN="" S CPIEN=$O(^AUPNCPL("ASDT",IEN,TYPE,INVDT,STATUS,CPIEN)) Q:CPIEN=""  D
  1.  ...S SIEN="" F  S SIEN=$O(^AUPNCPL("ASDT",IEN,TYPE,INVDT,STATUS,CPIEN,SIEN)) Q:SIEN=""  D
  1.  ....N REC,RECDFN S REC=$G(^AUPNCPL(SIEN,0))
  1.  ....Q:REC=""
  1.  ....S RECDFN=$P(REC,U,2)
  1.  ....Q:RECDFN'=DFN
  1.  ....I TYPE="G" S CPLANG(SIEN)="" S CNT=CNT+1
  1.  ....I TYPE="P" S CPLANP(SIEN)="" S CNT=CNT+1
  1.  Q
  1.  ;
  1. CPLVVI(DATA,DFN,PROB,CNT) ;
  1.  N FNUM,VVIN
  1.  ;Return the instructions for the last visit by default
  1.  S VVIN="" F  S VVIN=$O(^AUPNVVI("B",PROB,VVIN)) Q:VVIN=""  D
  1.  .N REC,RECDFN S REC=$G(^AUPNVVI(VVIN,0))
  1.  .Q:REC=""
  1.  .S RECDFN=$P(REC,U,2)
  1.  .Q:RECDFN'=DFN
  1.  .S VVISIT=$P(REC,U,3)
  1.  .Q:'VVISIT
  1.  .S CPLVVI(VVIN)="" S CNT=CNT+1
  1.  Q
  1.  ;
  1. CPLVTR(DATA,DFN,PROB,CNT) ;
  1.  S VST="" F  S VST=$O(^AUPNVTXR("AF",DFN,VST)) Q:VST=""  D
  1.  .S SNO="" F  S SNO=$O(^AUPNVTXR("AF",DFN,VST,SNO)) Q:SNO=""  D
  1.  ..S VTRIN="" F  S VTRIN=$O(^AUPNVTXR("AF",DFN,VST,SNO,VTRIN)) Q:VTRIN=""  D
  1.  ...N REC,RECDFN S REC=$G(^AUPNVTXR(VTRIN,0))
  1.  ...Q:REC=""
  1.  ...S RECDFN=$P(REC,U,2)
  1.  ...Q:RECDFN'=DFN
  1.  ...Q:$P(REC,U,4)'=PROB
  1.  ...Q:$P(REC,U,5)=1  ; -- DISCONTINUED
  1.  ...S CPLVTR(VTRIN)="" S CNT=CNT+1
  1.  Q
  1.  ;
  1. CPLVED(DATA,DFN,PROB,CNT) ;
  1.  I $G(VVISIT)="" Q
  1.  S VED="" F  S VED=$O(^AUPNVPED("AC",DFN,VED)) Q:VED=""  D
  1.  .N REC,RECDFN S REC=$G(^AUPNVPED(VED,0))
  1.  .Q:REC=""
  1.  .S RECDFN=$P(REC,U,2)
  1.  .Q:RECDFN'=DFN
  1.  .Q:$P(REC,U,3)'=VVISIT
  1.  .S CPLVED(VED)="" S CNT=CNT+1
  1.  Q
  1.  ;
  1. CPLCON(DATA,DFN,PROB,CNT) ;
  1.  S CONIEN=""
  1.  F  S CONIEN=$O(^GMR(123,"I",PROB,CONIEN),-1) Q:'+CONIEN  D
  1.  .N REC,RECDFN S REC=$G(^GMR(123,CONIEN,0))
  1.  .Q:REC=""
  1.  .S RECDFN=$P(REC,U,2)
  1.  .Q:RECDFN'=DFN
  1.  .S CPLCON(CONIEN)="" S CNT=CNT+1
  1.  Q
  1.  ;
  1. GETDATA ;
  1.  K CPLERR
  1.  D GETS^DIQ(FNUM,IEN_",","**","E","CPLARR","CPLERR")
  1.  I $D(CPLERR) D   Q "~@"_$NA(@TARGET)
  1.  .S @TARGET@(1,0)="Server error: "_$G(FNUM)_$G(CPLERR("DIERR",1))_U_$G(CPLERR("DIERR",1,"TEXT",1))
  1.  Q
  1.  ;
  1. TMPGBL(X) ;EP
  1.  K ^TMP("BTIUCPL",$J) Q $NA(^($J))