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

BTIUPRVI.m

Go to the documentation of this file. 
  1. BTIUPRVI ; IHS/MSC/JS - Problem/Visit Objects ;24-Apr-2014 15:51;DU
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**1012,1013**;MAR 20, 2013;Build 33
  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,NUM) ; Visit Instructions by date
  1.  ;Get last (n) date entries for each date  of visit instructions
  1.  ;Default is 99
  1.  N ARRAY,PRIEN,INVDT,IEN,VCNT,CNT,EDATE,SIGN,STAT,NARR,SPRIEN,EIE
  1.  K @TARGET
  1.  S VCNT=0,CNT=0
  1.  I $G(NUM)="" S NUM=99
  1.  S PRIEN="" F  S PRIEN=$O(^AUPNVVI("AE",DFN,PRIEN)) Q:PRIEN=""  D
  1.  .S INVDT="" F  S INVDT=$O(^AUPNVVI("AE",DFN,PRIEN,INVDT)) Q:INVDT=""  D
  1.  ..S IEN="" F  S IEN=$O(^AUPNVVI("AE",DFN,PRIEN,INVDT,IEN)) Q:IEN=""  D
  1.  ...S EIE=$$GET1^DIQ(9000010.58,IEN,.06,"I")
  1.  ...Q:EIE=1
  1.  ...S STAT=$P($G(^AUPNPROB(PRIEN,0)),U,12)
  1.  ...Q:STAT="D"
  1.  ...S ARRAY($P(INVDT,".",1),PRIEN,IEN)=""
  1.  S INVDT="" F  S INVDT=$O(ARRAY(INVDT)) Q:INVDT=""!(CNT>NUM)  D
  1.  .S CNT=CNT+1
  1.  .Q:CNT>NUM
  1.  .S EDATE=9999999-INVDT-1
  1.  .S EDATE=$$FMTE^XLFDT(EDATE,5)
  1.  .S VCNT=VCNT+1
  1.  .S @TARGET@(VCNT,0)=EDATE
  1.  .S SPRIEN=0
  1.  .S PRIEN="" F  S PRIEN=$O(ARRAY(INVDT,PRIEN)) Q:PRIEN=""!(CNT>NUM)  D
  1.  ..S IEN="" F  S IEN=$O(ARRAY(INVDT,PRIEN,IEN)) Q:IEN=""  D
  1.  ...S SIGN=$$GET1^DIQ(9000010.58,IEN,.04,"E")
  1.  ...S NARR=$$GET1^DIQ(9000011,PRIEN,.05)
  1.  ...I SPRIEN'=PRIEN D
  1.  ....S SPRIEN=PRIEN
  1.  ....D PDATA(IEN)
  1.  ...D TEXT
  1.  I VCNT=0 S @TARGET@(1,0)="No visit instructions"
  1.  Q "~@"_$NA(@TARGET)
  1. PDATA(IEN) ;Get problem data
  1.  S VCNT=VCNT+1
  1.  S @TARGET@(VCNT,0)="Problem: "_NARR
  1.  Q
  1.  ;
  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. VIPR(DFN,TARGET,NUM) ;Visit instructions by problem
  1.  N ARRAY,PRIEN,INVDT,IEN,VCNT,EDATE,SIGN,STAT,SDATE,EIE,IENCNT
  1.  K @TARGET
  1.  S VCNT=0,CNT=0
  1.  I $G(NUM)="" S NUM=99
  1.  S PRIEN="" F  S PRIEN=$O(^AUPNVVI("AE",DFN,PRIEN)) Q:PRIEN=""  D
  1.  .S STAT=$P($G(^AUPNPROB(PRIEN,0)),U,12)
  1.  .S CNT=0
  1.  .Q:STAT="D"
  1.  .S NARR=$$GET1^DIQ(9000011,PRIEN,.05)
  1.  .S VCNT=VCNT+1
  1.  .S @TARGET@(VCNT,0)=NARR
  1.  .S SDATE=0
  1.  .S INVDT="" F  S INVDT=$O(^AUPNVVI("AE",DFN,PRIEN,INVDT)) Q:INVDT=""!(CNT>NUM)  D
  1.  ..I SDATE'=$P(INVDT,".",1) S SDATE=$P(INVDT,".",1),CNT=CNT+1,IENCNT=0
  1.  ..Q:CNT>NUM
  1.  ..S IEN="" F  S IEN=$O(^AUPNVVI("AE",DFN,PRIEN,INVDT,IEN)) Q:IEN=""  D
  1.  ...S EIE=$$GET1^DIQ(9000010.58,IEN,.06,"I")
  1.  ...I EIE=1 Q
  1.  ...S IENCNT=IENCNT+1
  1.  ...S EDATE=$$GET1^DIQ(9000010.58,IEN,1201,"E")
  1.  ...S SIGN=$$GET1^DIQ(9000010.58,IEN,.04,"E")
  1.  ...S VCNT=VCNT+1
  1.  ...S @TARGET@(VCNT,0)="  "_EDATE
  1.  ...D TEXT
  1.  ..I IENCNT=0 S CNT=CNT-1
  1.  I VCNT=0 S @TARGET@(1,0)="No visit instructions"
  1.  Q "~@"_$NA(@TARGET)
  1. VTRDT(DFN,TARGET,NUM) ; Visit Treatment/Regimens  by date
  1.  ;Get last (n) date entries for each problem  of treatments
  1.  ;Default is 99
  1.  N ARRAY,PRIEN,INVDT,IEN,VCNT,EDATE,SIGN,STAT,SNO,IN,OUT,ARR,X,TXT
  1.  K @TARGET
  1.  S VCNT=0,CNT=0
  1.  I $G(NUM)="" S NUM=99
  1.  E  S NUM=NUM-1
  1.  S SNO="" F  S SNO=$O(^AUPNVTXR("AE",DFN,SNO)) Q:SNO=""  D
  1.  .S INVDT="" F  S INVDT=$O(^AUPNVTXR("AE",DFN,SNO,INVDT)) Q:INVDT=""  D
  1.  ..S IEN="" F  S IEN=$O(^AUPNVTXR("AE",DFN,SNO,INVDT,IEN)) Q:IEN=""  D
  1.  ...S PRIEN=$P($G(^AUPNVTXR(IEN,0)),U,4)
  1.  ...S STAT=$P($G(^AUPNPROB(PRIEN,0)),U,12)
  1.  ...Q:STAT="D"
  1.  ...S ARRAY(INVDT,PRIEN,IEN)=""
  1.  S INVDT="" F  S INVDT=$O(ARRAY(INVDT)) Q:INVDT=""  D
  1.  .S EDATE=9999999-INVDT
  1.  .S EDATE=$$FMTE^XLFDT(EDATE,5)
  1.  .S VCNT=VCNT+1
  1.  .S @TARGET@(VCNT,0)=EDATE
  1.  .S PRIEN="" F  S PRIEN=$O(ARRAY(INVDT,PRIEN)) Q:PRIEN=""  D
  1.  ..S NARR=$$GET1^DIQ(9000011,PRIEN,.05)
  1.  ..S VCNT=VCNT+1,CNT=CNT+1
  1.  ..S @TARGET@(VCNT,0)="  "_NARR
  1.  ..S IEN="" F  S IEN=$O(ARRAY(INVDT,PRIEN,IEN)) Q:IEN=""  D
  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.  ..S VCNT=VCNT+1
  1.  ..S @TARGET@(VCNT,0)=""
  1.  I VCNT=0 S @TARGET@(1,0)="No visit treatments"
  1.  Q "~@"_$NA(@TARGET)
  1. VTRPR(DFN,TARGET,NUM) ; Visit Treatment/Regimens  by problem
  1.  ;Default is 99
  1.  N ARRAY,PRIEN,INVDT,IEN,VCNT,EDATE,SIGN,STAT,SNO,IN,OUT,ARR,X
  1.  K @TARGET
  1.  S VCNT=0,CNT=0
  1.  I $G(NUM)="" S NUM=99
  1.  E  S NUM=NUM-1
  1.  S SNO="" F  S SNO=$O(^AUPNVTXR("AE",DFN,SNO)) Q:SNO=""  D
  1.  .S INVDT="" F  S INVDT=$O(^AUPNVTXR("AE",DFN,SNO,INVDT)) Q:INVDT=""  D
  1.  ..S IEN="" F  S IEN=$O(^AUPNVTXR("AE",DFN,SNO,INVDT,IEN)) Q:IEN=""  D
  1.  ...S PRIEN=$P($G(^AUPNVTXR(IEN,0)),U,4)
  1.  ...Q:PRIEN=""
  1.  ...S STAT=$P($G(^AUPNPROB(PRIEN,0)),U,12)
  1.  ...Q:STAT="D"
  1.  ...S ARRAY(PRIEN,INVDT,IEN)=""
  1.  S PRIEN="" F  S PRIEN=$O(ARRAY(PRIEN)) Q:PRIEN=""  D
  1.  .S NARR=$$GET1^DIQ(9000011,PRIEN,.05)
  1.  .S VCNT=VCNT+1
  1.  .S @TARGET@(VCNT,0)=NARR
  1.  .S INVDT="" F  S INVDT=$O(ARRAY(PRIEN,INVDT)) Q:INVDT=""  D
  1.  ..S CNT=CNT+1
  1.  ..S EDATE=9999999-INVDT
  1.  ..S EDATE=$$FMTE^XLFDT(EDATE,5)
  1.  ..S VCNT=VCNT+1
  1.  ..S @TARGET@(VCNT,0)="  Date:"_EDATE
  1.  ..S IEN="" F  S IEN=$O(ARRAY(PRIEN,INVDT,IEN)) Q:IEN=""  D
  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.  ..S VCNT=VCNT+1
  1.  ..S @TARGET@(VCNT,0)=""
  1.  I VCNT=0 S @TARGET@(1,0)="No visit treatments"
  1.  Q "~@"_$NA(@TARGET)
  1. REFPR(DFN,TARGET,NUM) ; V referrals by problem
  1.  ;Default is 99
  1.  N ARRAY,PRIEN,INVDT,IEN,VCNT,EDATE,SIGN,STAT,SNO,IN,OUT,ARR,X,PRV
  1.  K @TARGET
  1.  S VCNT=0,CNT=0
  1.  I $G(NUM)="" S NUM=99
  1.  E  S NUM=NUM-1
  1.  S SNO="" F  S SNO=$O(^AUPNVREF("AE",DFN,SNO)) Q:SNO=""  D
  1.  .S INVDT="" F  S INVDT=$O(^AUPNVREF("AE",DFN,SNO,INVDT)) Q:INVDT=""  D
  1.  ..S IEN="" F  S IEN=$O(^AUPNVREF("AE",DFN,SNO,INVDT,IEN)) Q:IEN=""  D
  1.  ...S PRIEN=$P($G(^AUPNVREF(IEN,0)),U,4)
  1.  ...Q:PRIEN=""
  1.  ...S STAT=$P($G(^AUPNPROB(PRIEN,0)),U,12)
  1.  ...Q:STAT="D"
  1.  ...S ARRAY(PRIEN,INVDT,IEN)=""
  1.  S PRIEN="" F  S PRIEN=$O(ARRAY(PRIEN)) Q:PRIEN=""  D
  1.  .S NARR=$$GET1^DIQ(9000011,PRIEN,.05)
  1.  .S VCNT=VCNT+1
  1.  .S @TARGET@(VCNT,0)="Problem: "_NARR
  1.  .S INVDT="" F  S INVDT=$O(ARRAY(PRIEN,INVDT)) Q:INVDT=""  D
  1.  ..S CNT=CNT+1
  1.  ..S EDATE=9999999-INVDT
  1.  ..S EDATE=$P($$FMTE^XLFDT(EDATE,5),"@",1)
  1.  ..S IEN="" F  S IEN=$O(ARRAY(PRIEN,INVDT,IEN)) Q:IEN=""  D
  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_" Referral: "_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 problem referrals"
  1.  Q "~@"_$NA(@TARGET)
  1. REFDT(DFN,TARGET,NUM) ; V referrals  by date
  1.  ;Get last (n) date entries for each problem  of visit referrals
  1.  ;Default is 99
  1.  N ARRAY,PRIEN,INVDT,IEN,VCNT,EDATE,SIGN,STAT,SNO,IN,OUT,ARR,X,TXT
  1.  K @TARGET
  1.  S VCNT=0,CNT=0,STAT=""
  1.  I $G(NUM)="" S NUM=99
  1.  E  S NUM=NUM-1
  1.  S SNO="" F  S SNO=$O(^AUPNVREF("AE",DFN,SNO)) Q:SNO=""  D
  1.  .S INVDT="" F  S INVDT=$O(^AUPNVREF("AE",DFN,SNO,INVDT)) Q:INVDT=""  D
  1.  ..S IEN="" F  S IEN=$O(^AUPNVREF("AE",DFN,SNO,INVDT,IEN)) Q:IEN=""  D
  1.  ...S PRIEN=$P($G(^AUPNVREF(IEN,0)),U,4)
  1.  ...;Q:PRIEN=""
  1.  ...I PRIEN'="" S STAT=$P($G(^AUPNPROB(PRIEN,0)),U,12)
  1.  ...Q:STAT="D"
  1.  ...S ARRAY(INVDT,IEN)=""
  1.  S INVDT="" F  S INVDT=$O(ARRAY(INVDT)) Q:INVDT=""  D
  1.  .S EDATE=9999999-INVDT
  1.  .S EDATE=$P($$FMTE^XLFDT(EDATE,5),".")
  1.  .S VCNT=VCNT+1,CNT=CNT+1
  1.  .S @TARGET@(VCNT,0)=EDATE
  1.  .S IEN="" F  S IEN=$O(ARRAY(INVDT,IEN)) Q:IEN=""  D
  1.  ..S PRIEN=$P($G(^AUPNVREF(IEN,0)),U,4)
  1.  ..I +PRIEN D
  1.  ...S NARR=$$GET1^DIQ(9000011,PRIEN,.05)
  1.  ...S VCNT=VCNT+1
  1.  ...S @TARGET@(VCNT,0)="Problem: "_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)="Referral: "_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.  ..S VCNT=VCNT+1
  1.  ..S @TARGET@(VCNT,0)=""
  1.  I VCNT=0 S @TARGET@(1,0)="No visit referrals"
  1.  Q "~@"_$NA(@TARGET)