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