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

BGOVTR.m

Go to the documentation of this file. 
  1. BGOVTR ; IHS/BAO/TMD - pull Visit files associated with problems  ;14-Mar-2016 04:13;du
  1.  ;;1.1;BGO COMPONENTS;**13,19,20**;Mar 20, 2007;Build 6
  1.  ;---------------------------------------------
  1.  ;Get data from V TREATMENT/REGIMEN file
  1.  ;Input= DFN = patient IEN
  1.  ;       PRIEN = problem number
  1.  ;       NUM = number to return, default is 1
  1.  ;       CNT = output counter
  1.  ;      SVIEN= visit IEN
  1.  ;        PRV= provider
  1.  ;--------------------------------------------
  1.  ;Return array
  1.  ;Array(n)="T" [1] ^ TR IEN[2] ^ SNOMED term [3] ^ Prob IEN  [4] ^ Vst Date [5] ^ Facility [6] ^ Prv IEN [7] ^ Location [8] ^ Entered Dt [9] ^ Visit IEN [10] ^ V Cat [11] ^Locked [12] ^ Prov name [13]
  1.  ;
  1. GET(DATA,DFN,PROB,NUM,CNT,SVIEN,PRV) ;EP
  1.  N CT,INVDT,VIN,SNO
  1.  I $G(DATA)="" S DATA=$$TMPGBL
  1.  I $G(NUM)="" S NUM=1
  1.  I $G(CNT)="" S CNT=0
  1.  I $G(PROB)="" S CNT=CNT+1 S DATA(CNT)="-1^Problem not defined" Q
  1.  S PRV=$G(PRV)
  1.  S SVIEN=$G(SVIEN)
  1.  S CT=0,GOOD=0
  1.  I SVIEN="" D
  1.  .I PRV="" D
  1.  ..S INVDT="" F  S INVDT=$O(^AUPNVTXR("APRB",DFN,PROB,INVDT)) Q:INVDT=""!(CT+1>NUM)  D
  1.  ...S VIN="" F  S VIN=$O(^AUPNVTXR("APRB",DFN,PROB,INVDT,VIN)) Q:VIN=""  D
  1.  ....D DATA(VIN,.GOOD)
  1.  ....I GOOD=1 S CT=CT+1
  1.  .E  D
  1.  ..S INVDT="" F  S INVDT=$O(^AUPNVTXR("APRV",PROB,PRV,INVDT)) Q:INVDT=""!(CT+1>NUM)  D
  1.  ...S VIN="" F  S VIN=$O(^AUPNVTXR("APRV",PROB,PRV,INVDT,VIN)) Q:VIN=""  D
  1.  ....D DATA(VIN,.GOOD)
  1.  ....I GOOD=1 S CT=CT+1
  1.  I SVIEN'="" D
  1.  .S VIN="" S VIN=$O(^AUPNVTXR("AD",VIEN,VIN)) Q:'+VIN  D
  1.  ..D DATA(VIN,.GOOD)
  1.  Q
  1. DATA(VIN,GOOD) ;Get the data for this entry
  1.  N X,REC,VCAT,VDT,LOC,FAC,FACNAM,EXNAME,PRVIEN,PRVNAME,SNOMED
  1.  N FNUM,VDATE,VIEN,EDATE,DFN,STDT,COMM,CT2
  1.  S REC=$G(^AUPNVTXR(VIN,0))
  1.  Q:REC=""
  1.  Q:$P(REC,U,5)=1
  1.  S SNOMED=$P(REC,U,1)
  1.  S CT2=$$CONC^BSTSAPI(SNOMED_"^^^1")
  1.  S FNUM=9000010.61
  1.  S PRVIEN=$P($G(^AUPNVTXR(VIN,12)),U,4)
  1.  S PRVNAME=$S('PRVIEN:"",1:$P($G(^VA(200,+PRVIEN,0)),U))
  1.  S VIEN=$P(REC,U,3)
  1.  Q:'VIEN
  1.  S LOC=$P($G(^AUPNVSIT(VIEN,0)),U,6)
  1.  S FAC=$S(LOC:$P($G(^AUTTLOC(LOC,0)),U,10),1:"")
  1.  S FACNAM=$S(LOC:$P($G(^AUTTLOC(LOC,0)),U),1:"")
  1.  S:FACNAM FACNAM=$P($G(^DIC(4,FACNAM,0)),U)
  1.  S:$P($G(^AUPNVSIT(VIEN,21)),U)'="" FACNAM=$P(^(21),U)
  1.  S VCAT=$P($G(^AUPNVSIT(VIEN,0)),U,7)
  1.  S VDT=$P($G(^AUPNVSIT(VIEN,0)),U,1)
  1.  S EDATE=$$GET1^DIQ(9000010,VIEN,1201,"I")
  1.  I EDATE="" S EDATE=VDT
  1.  S VDATE=$$FMTDATE^BGOUTL(VDT)
  1.  S EDATE=$$FMTDATE^BGOUTL(EDATE)
  1.  S CNT=CNT+1,GOOD=1
  1.  S @DATA@(CNT)="T"_U_VIN_U_SNOMED_U_PROB_U_VDATE_U_FACNAM_U_PRVIEN_U_LOC_U_EDATE_U_VIEN_U_VCAT_U_$$ISLOCKED^BEHOENCX(VIEN)_U_PRVNAME_U_$P(CT2,U,4)
  1.  Q
  1.  ; Delete a V Visit Instruction entry
  1. DEL(RET,VTR) ;EP
  1.  D VFDEL^BGOUTL2(.RET,$$FNUM,VTR)
  1.  Q
  1.  ;Set data into this file
  1.  ;LIST(n) = VTR IEN [1] ^ SNOMED [2] ^ Visit IEN [3] ^ Problem IEN [4] ^ Patient IEN [5] ^ Evnt Dt [6] ^ Provider [7]
  1. SET(RET,DFN,LIST) ;EP
  1.  N VFIEN,NEW,INP,VIEN,PROB,ECVT,PRV,TIEN,FDA,IEN,FNUM,INSTR,SNOMED,I,EVDT,VFNEW
  1.  S RET="",TIEN=""
  1.  S FNUM=9000010.61
  1.  S I="" F  S I=$O(LIST(I)) Q:I=""!(RET'="")  D
  1.  .S INP=$G(LIST(I))
  1.  .S VFIEN=+INP
  1.  .I VFIEN=0 S VFIEN="",NEW=1
  1.  .S VFNEW='VFIEN
  1.  .S SNOMED=$P(INP,U,2)
  1.  .S VIEN=$P(INP,U,3)
  1.  .S PROB=$P(INP,U,4)
  1.  .I 'VIEN S RET=$$ERR^BGOUTL(1008) Q
  1.  .;S DFN=$P(INP,U,5)
  1.  .S EVDT=$P(INP,U,5)
  1.  .I '+EVDT S EVDT=$$NOW^XLFDT
  1.  .S PRV=$P(INP,U,6) I PRV="" S PRV=DUZ
  1.  .S RET=$$CHKVISIT^BGOUTL(VIEN,DFN)
  1.  .Q:RET
  1.  .I 'VFIEN D  Q:'VFIEN
  1.  ..D VFNEW^BGOUTL2(.RET,FNUM,SNOMED,VIEN)
  1.  ..S:RET>0 VFIEN=RET,RET=""
  1.  .S FDA=$NA(FDA(FNUM,VFIEN_","))
  1.  .S @FDA@(.04)="`"_PROB
  1.  .S @FDA@(1201)=EVDT
  1.  .S @FDA@(1204)="`"_PRV
  1.  .I VFNEW D
  1.  ..S @FDA@(1216)="N"
  1.  ..S @FDA@(1217)="`"_DUZ
  1.  .S @FDA@(1218)="N"
  1.  .S @FDA@(1219)="`"_DUZ
  1.  .S RET=$$UPDATE^BGOUTL(.FDA,"E@")
  1.  .I RET,VFNEW,$$DELETE^BGOUTL(FNUM,VFIEN)
  1.  .Q:RET
  1.  .S TIEN=TIEN_U_VFIEN
  1.  S RET=TIEN
  1.  Q
  1.  ;Get the list of treatment regimens from the subset
  1. GETTR(DATA,DFN) ;EP
  1.  N OUT,IN,X,CNT,NODE,SNO
  1.  S OUT=$$SNOTMP^BGOSNLK
  1.  S IN="IHS Treatment Regimen^36^1"
  1.  S X=$$SUBLST^BSTSAPI(.OUT,.IN)
  1.  ;1 means success
  1.  I X>0 D
  1.  .M DATA=OUT
  1.  Q
  1.  ;
  1.  ;Input=VIEN
  1.  ;Output=Array
  1.  ;Format= Problem IEN [1] ^ SNOMED CT [2] ^ Txt [3] ^Date enered [4]
  1.  ;^Provider IEN [5] ^ Provider Name [6] ^ V treat IEN [7]
  1. GETPVTR(RET,VIEN) ;Get visit Treatment for problems
  1.  N PROB,EIEN,TREAT,CDATE,EPRV,PRVNAME,CNT,PIEN,CT2
  1.  I $G(RET)="" S RET=$$TMPGBL
  1.  S CNT=0
  1.  S EIEN="" F  S EIEN=$O(^AUPNVTXR("AD",VIEN,EIEN)) Q:EIEN=""  D
  1.  .S PROB=$$GET1^DIQ(9000010.61,EIEN,.04,"I")
  1.  .Q:PROB=""
  1.  .S TREAT=$$GET1^DIQ(9000010.61,EIEN,.01)
  1.  .S CT2=$$CONC^BSTSAPI(TREAT_"^^^1")
  1.  .S CT2=$P(CT2,U,4)
  1.  .S CDATE=$$GET1^DIQ(9000010.61,EIEN,1201,"I")
  1.  .S CDATE=$$FMTDATE^BGOUTL(CDATE)
  1.  .S EPRV=$$GET1^DIQ(9000010.61,EIEN,1204,"I")
  1.  .S PRVNAME=$$GET1^DIQ(9000010.61,EIEN,1204)
  1.  .S CNT=CNT+1
  1.  .S @RET@(CNT)=PROB_U_TREAT_U_CT2_U_CDATE_U_EPRV_U_PRVNAME_U_EIEN
  1.  Q
  1.  ;---------------------------------------------
  1.  ;Get data from CONSULT/REQUEST FILE file
  1.  ;Input= DFN = patient IEN
  1.  ;       PROB = problem number
  1.  ;       NUM = number to return, default is 1
  1.  ;       CNT = output counter
  1.  ;Output="S" (type) ^ Concult service ^ consult date ^ consult status
  1.  ;--------------------------------------------
  1. GETCON(DATA,DFN,PROB,NUM,CNT,PRV) ;EP Get any consults associated with this problem
  1.  N RET,IEN,CDATE,VDT,STAT,SER,CCNT,CPRV,PRVNAME
  1.  I $G(DATA)="" S DATA=$$TMPGBL
  1.  I $G(NUM)="" S NUM=999
  1.  I $G(CNT)="" S CNT=0
  1.  S CCNT=1,PRVNAME="",PRV=$G(PRV)
  1.  I PRV="" D
  1.  .S IEN=$C(0)
  1.  .F  S IEN=$O(^GMR(123,"I",PROB,IEN),-1) Q:'+IEN!(CCNT>NUM)  D
  1.  ..D CONS(.DATA)
  1.  E  D
  1.  .S INVDT="" F  S INVDT=$O(^GMR(123,"APRV",PROB,PRV,INVDT)) Q:'+INVDT!(CCNT>NUM)  D
  1.  ..S IEN="" F  S IEN=$O(^GMR(123,"APRV",PROB,PRV,INVDT,IEN)) Q:'+IEN  D
  1.  ...D CONS(.DATA)
  1.  Q
  1. CONS(DATA) ;Get consult data
  1.  S SER=$$GET1^DIQ(123,IEN,1)
  1.  S VDT=$P($G(^GMR(123,IEN,0)),U,1)
  1.  S CDATE=$$FMTDATE^BGOUTL(VDT)
  1.  S STAT=$$GET1^DIQ(123,IEN,8)
  1.  S CPRV=$$GET1^DIQ(123,IEN,10,"I")
  1.  S PRVNAME=$$GET1^DIQ(123,IEN,10)
  1.  S CNT=CNT+1,CCNT=CCNT+1
  1.  S @DATA@(CNT)="S"_U_SER_U_CDATE_U_STAT_U_CPRV_U_PRVNAME
  1.  Q
  1.  ;---------------------------------------------
  1.  ;Get data from V REFERRAL  file
  1.  ;Input= DFN = patient IEN
  1.  ;       PROB = problem number
  1.  ;       NUM = number to return, default is 999
  1.  ;       CNT = output counter
  1.  ;       VIEN= visit IEN
  1.  ;       PRV = provider
  1.  ;--------------------------------------------
  1. GETREF(DATA,DFN,PROB,NUM,CNT,VIEN,PRV) ;EP Get any referrals associated with this problem
  1.  N RET,IEN,CDATE,VDT,STAT,SNO,RIEN,SER,TO,RCNT,RPRV,PRVNAME,INVDT
  1.  I $G(DATA)="" S DATA=$$TMPGBL
  1.  I $G(NUM)="" S NUM=999
  1.  I $G(CNT)="" S CNT=0
  1.  S VIEN=$G(VIEN),PRV=$G(PRV)
  1.  S RCNT=1
  1.  I VIEN="" D
  1.  .I PRV="" D
  1.  ..S INVDT="" F  S INVDT=$O(^AUPNVREF("APRB",DFN,PROB,INVDT)) Q:'+INVDT!(RCNT>NUM)  D
  1.  ...S IEN="" F  S IEN=$O(^AUPNVREF("APRB",DFN,PROB,INVDT,IEN)) Q:'+IEN  D
  1.  ....D STREF(IEN)
  1.  .E  D
  1.  ..S INVDT="" F  S INVDT=$O(^AUPNVREF("APRV",PROB,PRV,INVDT)) Q:'+INVDT!(RCNT>NUM)  D
  1.  ...S IEN="" F  S IEN=$O(^AUPNVREF("APRV",PROB,PRV,INVDT,IEN)) Q:'+IEN  D
  1.  ....D STREF(IEN)
  1.  I VIEN'="" D
  1.  .S IEN=0
  1.  .S IEN=$O(^AUPNVREF("AD",VIEN,IEN)) Q:'+IEN  D STREF(IEN)
  1.  Q
  1. STREF(IEN) ;Store the referral
  1.  S RIEN=$$GET1^DIQ(9000010.59,IEN,.06,"I")
  1.  S CDATE=$$GET1^DIQ(9000010.59,IEN,1201,"I")
  1.  S CDATE=$$FMTDATE^BGOUTL(CDATE)
  1.  S STAT=$$GET1^DIQ(90001,RIEN,.15)
  1.  S SER=$$GET1^DIQ(90001,RIEN,.07)
  1.  S RPRV=$$GET1^DIQ(90001,RIEN,.06,"I")
  1.  S PRVNAME=$$GET1^DIQ(90001,RIEN,.06)
  1.  I SER="" S TO=$$GET1^DIQ(90001,RIEN,.08)
  1.  I SER="" S TO=$$GET1^DIQ(90001,RIEN,.09)
  1.  S CNT=CNT+1,RCNT=RCNT+1
  1.  S @DATA@(CNT)="R"_U_SER_U_CDATE_U_STAT_U_RPRV_U_PRVNAME
  1.  Q
  1.  ;---------------------------------------------
  1.  ;Get data from V EDUCATION FILE file
  1.  ;Input= DFN = patient IEN
  1.  ;       PROB = problem number
  1.  ;       NUM = number to return, default is 999
  1.  ;       CNT = output counter
  1.  ;Output= "E" (TYPE) ^ education topic ^ entered date
  1.  ;--------------------------------------------
  1. GETEDU(DATA,DFN,PROB,NUM,CNT,VIEN,PRV) ;EP Get any education associated with this problme
  1.  N RET,IEN,CDATE,VDT,STAT,INVDT,TOPIC,ECNT,EPRV,PRVNAME,SNO
  1.  I $G(DATA)="" S DATA=$$TMPGBL
  1.  I $G(NUM)="" S NUM=999
  1.  I $G(CNT)="" S CNT=0
  1.  S PRV=$G(PRV)
  1.  S VIEN=$G(VIEN)
  1.  S ECNT=1
  1.  S INVDT=""
  1.  ;Get the SNOMED CT for this problem
  1.  F  S INVDT=$O(^AUPNVPED("APRB",DFN,PROB,INVDT)) Q:'+INVDT!(ECNT>NUM)  D
  1.  .S IEN="" F  S IEN=$O(^AUPNVPED("APRB",DFN,PROB,INVDT,IEN)) Q:'+IEN!(ECNT>NUM)  D
  1.  ..S TOPIC=$$GET1^DIQ(9000010.16,IEN,.01)
  1.  ..S CDATE=$$GET1^DIQ(9000010.16,IEN,1201,"I")
  1.  ..S CDATE=$$FMTDATE^BGOUTL(CDATE)
  1.  ..S EPRV=$$GET1^DIQ(9000010.16,IEN,1204,"I")
  1.  ..S SNO=$$GET1^DIQ(9000010.16,IEN,1301)
  1.  ..Q:PRV'=""&(PRV'=EPRV)
  1.  ..S PRVNAME=$$GET1^DIQ(9000010.16,IEN,1204)
  1.  ..S CNT=CNT+1,ECNT=ECNT+1
  1.  ..S @DATA@(CNT)="E"_U_TOPIC_U_CDATE_U_PRV_U_PRVNAME_U_IEN_U_SNO
  1.  Q
  1. TMPGBL(X) ;EP
  1.  K ^TMP("BGOVIN",$J) Q $NA(^($J))
  1.  ; Return file number
  1. FNUM() Q 9000010.61