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

BTIUPRV2.m

Go to the documentation of this file. 
  1. BTIUPRV2 ; IHS/MSC/JS - Problem/Visit Objects ;25-Mar-2014 17:10;DU
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**1012**;MAR 20, 2013;Build 45
  1.  ;Obects for visit-related problem entries from V Visit instructions
  1.  ;V treatment/regimen and V referral files
  1.  Q
  1.  ;
  1. VIDT(DFN,TARGET) ; Visit Instructions for current visit
  1.  N ARRAY,PRIEN,IEN,VCNT,CNT,EDATE,SIGN,STAT,NARR,VST,X,SPRIEN,EIE
  1.  I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
  1.  S CNT=0
  1.  S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
  1.  I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
  1.  S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1  S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
  1.  K @TARGET
  1.  S VCNT=0
  1.  S SPRIEN=0
  1.  S IEN="" F  S IEN=$O(^AUPNVVI("AD",VST,IEN)) Q:IEN=""  D
  1.  .S EIE=$$GET1^DIQ(9000010.58,IEN,.06,"I")
  1.  .Q:EIE=1
  1.  .S PRIEN=$$GET1^DIQ(9000010.58,IEN,.01,"I")
  1.  .S EDATE=$$GET1^DIQ(9000010.58,IEN,1201,"I")
  1.  .S EDATE=$$FMTE^XLFDT(EDATE,5)
  1.  .S SIGN=$$GET1^DIQ(9000010.58,IEN,.04,"E")
  1.  .S NARR=$$GET1^DIQ(9000011,PRIEN,.05)
  1.  .I SPRIEN'=PRIEN S SPRIEN=PRIEN D PDATA(IEN)
  1.  .D TEXT
  1.  I VCNT=0 S @TARGET@(1,0)="No visit instructions for this visit"
  1.  Q "~@"_$NA(@TARGET)
  1.  ;
  1. PDATA(PRIEN) ;Do problem data
  1.  S VCNT=VCNT+1
  1.  S @TARGET@(VCNT,0)="Problem: "_NARR
  1.  Q
  1. TEXT ;do the text
  1.  N TXTIEN
  1.  S VCNT=VCNT+1
  1.  S @TARGET@(VCNT,0)="  INSTRUCTIONS:"
  1.  S TXTIEN=0 F  S TXTIEN=$O(^AUPNVVI(IEN,11,TXTIEN)) Q:'+TXTIEN  D
  1.  .S VCNT=VCNT+1
  1.  .S @TARGET@(VCNT,0)="   "_$G(^AUPNVVI(IEN,11,TXTIEN,0))
  1.  S VCNT=VCNT+1
  1.  S @TARGET@(VCNT,0)="  Signed by: "_SIGN
  1.  S VCNT=VCNT+1
  1.  S @TARGET@(VCNT,0)=""
  1.  Q
  1. VTRDT(DFN,TARGET) ; Visit Treatment/Regimens for this visit
  1.  N ARRAY,IEN,VCNT,EDATE,SIGN,STAT,NARR,VST,X,SNO,PRIEN,TXT,X
  1.  I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
  1.  S CNT=0
  1.  S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
  1.  I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
  1.  S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1  S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
  1.  K @TARGET
  1.  S VCNT=0
  1.  S IEN="" F  S IEN=$O(^AUPNVTXR("AD",VST,IEN)) Q:IEN=""  D
  1.  .S PRIEN=$$GET1^DIQ(9000010.61,IEN,.04,"I")
  1.  .S EDATE=$$GET1^DIQ(9000010.61,IEN,1201,"I")
  1.  .S EDATE=$$FMTE^XLFDT(EDATE,5)
  1.  .;S VCNT=VCNT+1
  1.  .;S @TARGET@(VCNT,0)=EDATE
  1.  .S NARR=$$GET1^DIQ(9000011,PRIEN,.05)
  1.  .S VCNT=VCNT+1
  1.  .S @TARGET@(VCNT,0)="Problem: "_NARR
  1.  .N IN,OUT,ARR,X
  1.  .S SNO=$P($G(^AUPNVTXR(IEN,0)),U,1)
  1.  .S IN=SNO_"^^^1",OUT="ARR"
  1.  .S X=$$CNCLKP^BSTSAPI(.OUT,.IN)
  1.  .I X>0 D
  1.  ..S TXT=ARR(1,"PRE","TRM")
  1.  ..S VCNT=VCNT+1
  1.  ..S @TARGET@(VCNT,0)="  "_TXT
  1.  I VCNT=0 S @TARGET@(1,0)="No Treatment/regimen for this visit"
  1.  Q "~@"_$NA(@TARGET)
  1. REFPR(DFN,TARGET) ; V referrals for this visit
  1.  N ARRAY,IEN,VCNT,EDATE,SIGN,STAT,NARR,VST,X,SNO,PRIEN,TXT,X
  1.  I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
  1.  S CNT=0
  1.  S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
  1.  I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
  1.  S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1  S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
  1.  K @TARGET
  1.  S VCNT=0
  1.  S IEN="" F  S IEN=$O(^AUPNVREF("AD",VST,IEN)) Q:IEN=""  D
  1.  .S PRIEN=$$GET1^DIQ(9000010.59,IEN,.01,"I")
  1.  .S EDATE=$$GET1^DIQ(9000010.59,IEN,1201,"I")
  1.  .S EDATE=$$FMTE^XLFDT(EDATE,5)
  1.  .S NARR=$$GET1^DIQ(9000011,PRIEN,.05)
  1.  .S VCNT=VCNT+1
  1.  .S @TARGET@(VCNT,0)="  "_NARR
  1.  .S SNO=$P($G(^AUPNVREF(IEN,0)),U,1)
  1.  .S X=$$CONC^BSTSAPI(SNO_"^^^1")
  1.  .I +X D
  1.  ..S TXT=$P(X,U,4)
  1.  ..S VCNT=VCNT+1
  1.  ..S @TARGET@(VCNT,0)=EDATE_" "_TXT_"("_SNO_")"
  1.  ..S PRV=$$GET1^DIQ(9000010.59,IEN,1202)
  1.  ..I PRV="" S PRV=$$GET1^DIQ(9000010.59,IEN,1204)
  1.  ..S VCNT=VCNT+1
  1.  ..S @TARGET@(VCNT,0)="Provider: "_PRV
  1.  I VCNT=0 S @TARGET@(1,0)="No Referrals for this visit"
  1.  Q "~@"_$NA(@TARGET)
  1. CARE(DFN,TARGET) ;Care plans entered on this visit
  1.  N CNT,VST,X,RET,LOOP,PRIEN,VCNT
  1.  S RET="",VCNT=0
  1.  ;I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
  1.  S CNT=0,LOOP=0
  1.  ;S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
  1.  ;I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
  1.  ;S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1  S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
  1.  K @TARGET
  1.  D GET^BGOPROB(.RET,DFN)
  1.  F  S LOOP=$O(^TMP("BGO",$J,LOOP)) Q:'+LOOP  D
  1.  .I $P($G(^TMP("BGO",$J,LOOP)),U,1)="P" D
  1.  ..S PRIEN=$P($G(^TMP("BGO",$J,LOOP)),U,2)
  1.  ..D FINDCP(PRIEN)
  1.  I VCNT=0 S @TARGET@(1,0)="No Care Plans/Goals found"
  1.  K ^TMP("BGO",$J)
  1.  Q "~@"_$NA(@TARGET)
  1. FINDCP(PRIEN) ;Find a care plan
  1.  N TYPE,VSTDT,INVDT,STAT,CPIEN,SIEN,EDATE,IEN,NODE,PRV,PRVNM,SIGN,NARR,NODE,Z
  1.  S TYPE=""
  1.  S VSTDT=$P($$NOW^XLFDT,".",1)
  1.  F  S TYPE=$O(^AUPNCPL("APT",PRIEN,TYPE)) Q:TYPE=""  D
  1.  .S CPIEN="" F  S CPIEN=$O(^AUPNCPL("APT",PRIEN,TYPE,CPIEN)) Q:CPIEN=""  D
  1.  ..S SIEN=$C(0) S SIEN=$O(^AUPNCPL(CPIEN,11,SIEN),-1)
  1.  ..S STAT=$P($G(^AUPNCPL(CPIEN,11,SIEN,0)),U,1)
  1.  ..Q:STAT'="A"
  1.  ..S EDATE=$P($P($G(^AUPNCPL(CPIEN,11,SIEN,0)),U,3),".",1)
  1.  ..Q:EDATE'=VSTDT
  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 SIGN=$$GET1^DIQ(9000092,CPIEN,.08)
  1.  ..Q:SIGN=""&(PRV'=DUZ)
  1.  ..S NARR=$$GET1^DIQ(9000011,PRIEN,.05)
  1.  ..S VCNT=VCNT+1
  1.  ..S @TARGET@(VCNT,0)="Problem: "_NARR
  1.  ..S VCNT=VCNT+1
  1.  ..S Z=$S(TYPE="G":"Goal",1:"Care Plan")
  1.  ..S @TARGET@(VCNT,0)=Z_" Provider: "_PRVNM
  1.  ..S VCNT=VCNT+1
  1.  ..S @TARGET@(VCNT,0)="Signed on: "_SIGN
  1.  ..D TEXT2(TYPE)
  1.  Q
  1. TEXT2(TYPE) ;do the text
  1.  N TXTIEN
  1.  S VCNT=VCNT+1
  1.  S @TARGET@(VCNT,0)=$S(TYPE="G":"  GOAL",1:"   CARE PLAN")
  1.  S TXTIEN=0 F  S TXTIEN=$O(^AUPNCPL(CPIEN,12,TXTIEN)) Q:'+TXTIEN  D
  1.  .S VCNT=VCNT+1
  1.  .S @TARGET@(VCNT,0)="   "_$G(^AUPNCPL(CPIEN,12,TXTIEN,0))
  1.  S VCNT=VCNT+1
  1.  S @TARGET@(VCNT,0)=""
  1.  Q