BGOVEXAM ; IHS/BAO/TMD - V Exam Management ;02-Oct-2013 13:02;PLS
;;1.1;BGO COMPONENTS;**1,3,11,12,13**;Mar 20, 2007;Build 3
; Return exam records for a patient
; DFN = Patient IEN
; .RET = Returned as a list of record in one of two formats:
; For exams:
; E ^ Exam Name [2] ^ Visit Date [3] ^ Result [4] ^ Comment [5] ^ Provider Name [6] ^ Facility Name [7] ^
; Provider IEN [8] ^ Location Name [9] ^ Exam IEN [10] ^ V File IEN [11] ^ Visit IEN [12] ^ Visit Category [13] ^
; Visit Locked [14] ^ Event date [15]
;
; For refusals:
; R ^ Exam Name [2] ^ Refusal Date [3] ^ Reason [4] ^ Comment [5] ^ Exam IEN [6] ^ V File IEN [7] ^
; Refusal Locked [8]
GET(RET,DFN) ;EP
N X,CNT,REC,VCAT,EXAM,VDT,VXAM,RESULT,LOC,FAC,FACNAM,EXNAME,PRVIEN,PRVNAME,EVNDT
N EXAM,VDATE,VIEN,COMMENT
S RET=$$TMPGBL^BGOUTL
S (CNT,EXAM)=0
F S EXAM=$O(^AUPNVXAM("AA",DFN,EXAM)) Q:'EXAM D
.S VDT=0
.F S VDT=$O(^AUPNVXAM("AA",DFN,EXAM,VDT)) Q:'VDT D
..S VXAM=0
..F S VXAM=$O(^AUPNVXAM("AA",DFN,EXAM,VDT,VXAM)) Q:'VXAM D
...S REC=$G(^AUPNVXAM(VXAM,0))
...Q:REC=""
...S RESULT=$$EXTERNAL^DILFD($$FNUM,.04,,$P(REC,U,4))
...I RESULT="",$O(^AUPNPREF("AA",DFN,9999999.15,EXAM,VDT,"")) Q
...S EXNAME=$P($G(^AUTTEXAM(EXAM,0)),U)
...S PRVIEN=$P($G(^AUPNVXAM(VXAM,12)),U,4)
...;Patch 11
...S EVNDT=$$FMTDATE^BGOUTL($P($G(^AUPNVXAM(VXAM,12)),U,1))
...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 VDATE=$$FMTDATE^BGOUTL(9999999-VDT)
...S COMMENT=$P($G(^AUPNVXAM(VXAM,811)),U)
...S CNT=CNT+1
...S @RET@(CNT)="E"_U_EXNAME_U_VDATE_U_RESULT_U_COMMENT_U_PRVNAME_U_FACNAM_U_PRVIEN_U_LOC_U_EXAM_U_VXAM_U_VIEN_U_VCAT_U_$$ISLOCKED^BEHOENCX(VIEN)_U_EVNDT
; Add refusal data
N ARRAY,CNT2,Z,STR,SAVE,SAVE2,DATA
S CNT2=0,ARRAY="DATA"
D REFGET^BGOUTL2(.ARRAY,DFN,9999999.15,.CNT2)
S Z=0 F S Z=$O(@ARRAY@(Z)) Q:Z="" D
.S STR=$G(@ARRAY@(Z))
.S SAVE=$P(STR,U,13),SAVE2=$P(STR,U,11)
.I SAVE'="" S $P(STR,U,11)=SAVE,$P(STR,U,13)=SAVE2
.S CNT=CNT+1
.S @RET@(CNT)=STR
Q
; Return a list of exam types
; Returned as a list of records in the format:
; Exam Type IEN ^ Exam Name ^ Exam Code ^ CPT Code
GETTYPES(RET,DUMMY) ;EP
N EXAM,CNT,REC,NAME,CODE,CPT
S RET=$$TMPGBL^BGOUTL
S (CNT,EXAM)=0
F S EXAM=$O(^AUTTEXAM(EXAM)) Q:'EXAM D
.S REC=$G(^AUTTEXAM(EXAM,0))
.Q:'$L(REC)
.Q:$P(REC,U,4)=1
.;Do not allow nutritional screening in list
.Q:$P(REC,U,2)=40
.S NAME=$P(REC,U)
.S CODE=$P(REC,U,2)
.S CPT=$P(REC,U,11)
.S CNT=CNT+1,@RET@(CNT)=EXAM_U_NAME_U_CODE_U_CPT
Q
; Get list of valid results for a given EXAM Name or IEN
GETRSLTS(RET,EXAM) ;EP
N CNT,RL,RLIST
;S RET=$$TMPGBL^BGOUTL,CNT=0
K RET
S CNT=0
Q:$G(EXAM)=""
I EXAM'?1.N D
.S EXAM=$O(^AUTTEXAM("B",EXAM,""))
Q:'EXAM
D VXAMR^AUPNCIX(EXAM,"RLIST")
S RL=0
F S RL=$O(RLIST(RL)) Q:'RL S CNT=CNT+1,RET(CNT)=$P(RLIST(RL),U,2)
Q
; Get primary provider for this V EXAM
PRIPRV(RET,VXAM) ;EP
S RET=$$PRIPRV^BGOUTL($P(^AUPNVXAM(VXAM,0),U,3))
Q
; Delete a V EXAM or associated refusal
; INP = IEN ^ "R" if refusal, otherwise null
DEL(RET,INP) ;EP
N IEN,REFUSAL
S IEN=+INP
S REFUSAL=$P(INP,U,2)="R"
I 'IEN S RET=$$ERR^BGOUTL(1008)
E I REFUSAL S RET=$$REFDEL^BGOUTL2(IEN)
E D VFDEL^BGOUTL2(.RET,$$FNUM,IEN)
Q
; Set exam or refusal record
; INP = V Exam IEN (if edit) [1] ^ Exam IEN [2] ^ Visit IEN [3] ^ Provider IEN [4] ^ Result [5] ^ Comment [6] ^
; Event Date [7] ^ Location IEN [8] ^ Other Location [9] ^ Historical Flag [10] ^ DFN [11]
; .RET = Returned as -1^error text if error
SET(RET,INP) ;EP
N VFIEN,VCAT,TYPE,VIEN,DFN,PROV,RESULT,COMMENT,EVNTDT,LOCIEN,OUTLOC,HIST,FDA,FNUM,VFNEW
S RET="",FNUM=$$FNUM
S VFIEN=$P(INP,U)
S VFNEW='VFIEN
S TYPE=$P(INP,U,2)
S VIEN=+$P(INP,U,3)
I 'TYPE S RET=$$ERR^BGOUTL(1077) Q
S HIST=$P(INP,U,10)
S DFN=$P(INP,U,11)
I 'VIEN,'HIST S RET=$$ERR^BGOUTL(1002) Q
S VCAT=$P($G(^AUPNVSIT(VIEN,0)),U,7)
S:VCAT="E" HIST=1
S PROV=$P(INP,U,4)
;IHS/MSC/MGH Patch 11
I PROV="" S PROV=DUZ
I 'PROV,'VFIEN S RET=$$ERR^BGOUTL(1027) Q
S RESULT=$P(INP,U,5)
S:RESULT="NORMAL"!(RESULT="NEGATIVE") RESULT="N"
S COMMENT=$P(INP,U,6)
S EVNTDT=$P(INP,U,7)
I EVNTDT="" S EVNTDT=$$NOW^XLFDT
S LOCIEN=$P(INP,U,8)
S OUTLOC=$P(INP,U,9)
I HIST D Q:RET
.S RET=$$MAKEHIST^BGOUTL(DFN,EVNTDT,$S($L(OUTLOC):OUTLOC,1:LOCIEN),VIEN)
.S:RET>0 VIEN=RET,RET="",VCAT="E"
S RET=$$CHKVISIT^BGOUTL(VIEN,DFN)
Q:RET
I 'VFIEN D Q:'VFIEN
.D VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN,"Exam")
.S:RET>0 VFIEN=RET,RET=""
S FDA=$NA(FDA(FNUM,VFIEN_","))
S @FDA@(.01)="`"_TYPE
S @FDA@(.04)=RESULT
S:'VFNEW!$L(COMMENT) @FDA@(81101)=COMMENT
;IHS/MSC/MGH Patch 11 change for new fields
;S @FDA@(1204)="`"_DUZ
S @FDA@(1204)="`"_PROV
S @FDA@(1201)=EVNTDT
;Patch 11 Set date entered
I VFNEW D
.S @FDA@(1216)="N"
.S @FDA@(1217)="`"_DUZ
;Patch 11 Set last modified
S @FDA@(1218)="N"
S @FDA@(1219)="`"_DUZ
S RET=$$UPDATE^BGOUTL(.FDA,"E")
I RET,VFNEW,$$DELETE^BGOUTL(FNUM,VFIEN)
D:'RET VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)
S:'RET RET=VFIEN
Q
; Return V File #
FNUM() Q 9000010.13
BGOVEXAM ; IHS/BAO/TMD - V Exam Management ;02-Oct-2013 13:02;PLS
+1 ;;1.1;BGO COMPONENTS;**1,3,11,12,13**;Mar 20, 2007;Build 3
+2 ; Return exam records for a patient
+3 ; DFN = Patient IEN
+4 ; .RET = Returned as a list of record in one of two formats:
+5 ; For exams:
+6 ; E ^ Exam Name [2] ^ Visit Date [3] ^ Result [4] ^ Comment [5] ^ Provider Name [6] ^ Facility Name [7] ^
+7 ; Provider IEN [8] ^ Location Name [9] ^ Exam IEN [10] ^ V File IEN [11] ^ Visit IEN [12] ^ Visit Category [13] ^
+8 ; Visit Locked [14] ^ Event date [15]
+9 ;
+10 ; For refusals:
+11 ; R ^ Exam Name [2] ^ Refusal Date [3] ^ Reason [4] ^ Comment [5] ^ Exam IEN [6] ^ V File IEN [7] ^
+12 ; Refusal Locked [8]
GET(RET,DFN) ;EP
+1 NEW X,CNT,REC,VCAT,EXAM,VDT,VXAM,RESULT,LOC,FAC,FACNAM,EXNAME,PRVIEN,PRVNAME,EVNDT
+2 NEW EXAM,VDATE,VIEN,COMMENT
+3 SET RET=$$TMPGBL^BGOUTL
+4 SET (CNT,EXAM)=0
+5 FOR
SET EXAM=$ORDER(^AUPNVXAM("AA",DFN,EXAM))
IF 'EXAM
QUIT
Begin DoDot:1
+6 SET VDT=0
+7 FOR
SET VDT=$ORDER(^AUPNVXAM("AA",DFN,EXAM,VDT))
IF 'VDT
QUIT
Begin DoDot:2
+8 SET VXAM=0
+9 FOR
SET VXAM=$ORDER(^AUPNVXAM("AA",DFN,EXAM,VDT,VXAM))
IF 'VXAM
QUIT
Begin DoDot:3
+10 SET REC=$GET(^AUPNVXAM(VXAM,0))
+11 IF REC=""
QUIT
+12 SET RESULT=$$EXTERNAL^DILFD($$FNUM,.04,,$PIECE(REC,U,4))
+13 IF RESULT=""
IF $ORDER(^AUPNPREF("AA",DFN,9999999.15,EXAM,VDT,""))
QUIT
+14 SET EXNAME=$PIECE($GET(^AUTTEXAM(EXAM,0)),U)
+15 SET PRVIEN=$PIECE($GET(^AUPNVXAM(VXAM,12)),U,4)
+16 ;Patch 11
+17 SET EVNDT=$$FMTDATE^BGOUTL($PIECE($GET(^AUPNVXAM(VXAM,12)),U,1))
+18 SET PRVNAME=$SELECT('PRVIEN:"",1:$PIECE($GET(^VA(200,+PRVIEN,0)),U))
+19 SET VIEN=$PIECE(REC,U,3)
+20 IF 'VIEN
QUIT
+21 SET LOC=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,6)
+22 SET FAC=$SELECT(LOC:$PIECE($GET(^AUTTLOC(LOC,0)),U,10),1:"")
+23 SET FACNAM=$SELECT(LOC:$PIECE($GET(^AUTTLOC(LOC,0)),U),1:"")
+24 IF FACNAM
SET FACNAM=$PIECE($GET(^DIC(4,FACNAM,0)),U)
+25 IF $PIECE($GET(^AUPNVSIT(VIEN,21)),U)'=""
SET FACNAM=$PIECE(^(21),U)
+26 SET VCAT=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,7)
+27 SET VDATE=$$FMTDATE^BGOUTL(9999999-VDT)
+28 SET COMMENT=$PIECE($GET(^AUPNVXAM(VXAM,811)),U)
+29 SET CNT=CNT+1
+30 SET @RET@(CNT)="E"_U_EXNAME_U_VDATE_U_RESULT_U_COMMENT_U_PRVNAME_U_FACNAM_U_PRVIEN_U_LOC_U_EXAM_U_VXAM_U_VIEN_U_VCAT_U_$$ISLOCKED^BEHOENCX(VIEN)_U_EVNDT
End DoDot:3
End DoDot:2
End DoDot:1
+31 ; Add refusal data
+32 NEW ARRAY,CNT2,Z,STR,SAVE,SAVE2,DATA
+33 SET CNT2=0
SET ARRAY="DATA"
+34 DO REFGET^BGOUTL2(.ARRAY,DFN,9999999.15,.CNT2)
+35 SET Z=0
FOR
SET Z=$ORDER(@ARRAY@(Z))
IF Z=""
QUIT
Begin DoDot:1
+36 SET STR=$GET(@ARRAY@(Z))
+37 SET SAVE=$PIECE(STR,U,13)
SET SAVE2=$PIECE(STR,U,11)
+38 IF SAVE'=""
SET $PIECE(STR,U,11)=SAVE
SET $PIECE(STR,U,13)=SAVE2
+39 SET CNT=CNT+1
+40 SET @RET@(CNT)=STR
End DoDot:1
+41 QUIT
+42 ; Return a list of exam types
+43 ; Returned as a list of records in the format:
+44 ; Exam Type IEN ^ Exam Name ^ Exam Code ^ CPT Code
GETTYPES(RET,DUMMY) ;EP
+1 NEW EXAM,CNT,REC,NAME,CODE,CPT
+2 SET RET=$$TMPGBL^BGOUTL
+3 SET (CNT,EXAM)=0
+4 FOR
SET EXAM=$ORDER(^AUTTEXAM(EXAM))
IF 'EXAM
QUIT
Begin DoDot:1
+5 SET REC=$GET(^AUTTEXAM(EXAM,0))
+6 IF '$LENGTH(REC)
QUIT
+7 IF $PIECE(REC,U,4)=1
QUIT
+8 ;Do not allow nutritional screening in list
+9 IF $PIECE(REC,U,2)=40
QUIT
+10 SET NAME=$PIECE(REC,U)
+11 SET CODE=$PIECE(REC,U,2)
+12 SET CPT=$PIECE(REC,U,11)
+13 SET CNT=CNT+1
SET @RET@(CNT)=EXAM_U_NAME_U_CODE_U_CPT
End DoDot:1
+14 QUIT
+15 ; Get list of valid results for a given EXAM Name or IEN
GETRSLTS(RET,EXAM) ;EP
+1 NEW CNT,RL,RLIST
+2 ;S RET=$$TMPGBL^BGOUTL,CNT=0
+3 KILL RET
+4 SET CNT=0
+5 IF $GET(EXAM)=""
QUIT
+6 IF EXAM'?1.N
Begin DoDot:1
+7 SET EXAM=$ORDER(^AUTTEXAM("B",EXAM,""))
End DoDot:1
+8 IF 'EXAM
QUIT
+9 DO VXAMR^AUPNCIX(EXAM,"RLIST")
+10 SET RL=0
+11 FOR
SET RL=$ORDER(RLIST(RL))
IF 'RL
QUIT
SET CNT=CNT+1
SET RET(CNT)=$PIECE(RLIST(RL),U,2)
+12 QUIT
+13 ; Get primary provider for this V EXAM
PRIPRV(RET,VXAM) ;EP
+1 SET RET=$$PRIPRV^BGOUTL($PIECE(^AUPNVXAM(VXAM,0),U,3))
+2 QUIT
+3 ; Delete a V EXAM or associated refusal
+4 ; INP = IEN ^ "R" if refusal, otherwise null
DEL(RET,INP) ;EP
+1 NEW IEN,REFUSAL
+2 SET IEN=+INP
+3 SET REFUSAL=$PIECE(INP,U,2)="R"
+4 IF 'IEN
SET RET=$$ERR^BGOUTL(1008)
+5 IF '$TEST
IF REFUSAL
SET RET=$$REFDEL^BGOUTL2(IEN)
+6 IF '$TEST
DO VFDEL^BGOUTL2(.RET,$$FNUM,IEN)
+7 QUIT
+8 ; Set exam or refusal record
+9 ; INP = V Exam IEN (if edit) [1] ^ Exam IEN [2] ^ Visit IEN [3] ^ Provider IEN [4] ^ Result [5] ^ Comment [6] ^
+10 ; Event Date [7] ^ Location IEN [8] ^ Other Location [9] ^ Historical Flag [10] ^ DFN [11]
+11 ; .RET = Returned as -1^error text if error
SET(RET,INP) ;EP
+1 NEW VFIEN,VCAT,TYPE,VIEN,DFN,PROV,RESULT,COMMENT,EVNTDT,LOCIEN,OUTLOC,HIST,FDA,FNUM,VFNEW
+2 SET RET=""
SET FNUM=$$FNUM
+3 SET VFIEN=$PIECE(INP,U)
+4 SET VFNEW='VFIEN
+5 SET TYPE=$PIECE(INP,U,2)
+6 SET VIEN=+$PIECE(INP,U,3)
+7 IF 'TYPE
SET RET=$$ERR^BGOUTL(1077)
QUIT
+8 SET HIST=$PIECE(INP,U,10)
+9 SET DFN=$PIECE(INP,U,11)
+10 IF 'VIEN
IF 'HIST
SET RET=$$ERR^BGOUTL(1002)
QUIT
+11 SET VCAT=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,7)
+12 IF VCAT="E"
SET HIST=1
+13 SET PROV=$PIECE(INP,U,4)
+14 ;IHS/MSC/MGH Patch 11
+15 IF PROV=""
SET PROV=DUZ
+16 IF 'PROV
IF 'VFIEN
SET RET=$$ERR^BGOUTL(1027)
QUIT
+17 SET RESULT=$PIECE(INP,U,5)
+18 IF RESULT="NORMAL"!(RESULT="NEGATIVE")
SET RESULT="N"
+19 SET COMMENT=$PIECE(INP,U,6)
+20 SET EVNTDT=$PIECE(INP,U,7)
+21 IF EVNTDT=""
SET EVNTDT=$$NOW^XLFDT
+22 SET LOCIEN=$PIECE(INP,U,8)
+23 SET OUTLOC=$PIECE(INP,U,9)
+24 IF HIST
Begin DoDot:1
+25 SET RET=$$MAKEHIST^BGOUTL(DFN,EVNTDT,$SELECT($LENGTH(OUTLOC):OUTLOC,1:LOCIEN),VIEN)
+26 IF RET>0
SET VIEN=RET
SET RET=""
SET VCAT="E"
End DoDot:1
IF RET
QUIT
+27 SET RET=$$CHKVISIT^BGOUTL(VIEN,DFN)
+28 IF RET
QUIT
+29 IF 'VFIEN
Begin DoDot:1
+30 DO VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN,"Exam")
+31 IF RET>0
SET VFIEN=RET
SET RET=""
End DoDot:1
IF 'VFIEN
QUIT
+32 SET FDA=$NAME(FDA(FNUM,VFIEN_","))
+33 SET @FDA@(.01)="`"_TYPE
+34 SET @FDA@(.04)=RESULT
+35 IF 'VFNEW!$LENGTH(COMMENT)
SET @FDA@(81101)=COMMENT
+36 ;IHS/MSC/MGH Patch 11 change for new fields
+37 ;S @FDA@(1204)="`"_DUZ
+38 SET @FDA@(1204)="`"_PROV
+39 SET @FDA@(1201)=EVNTDT
+40 ;Patch 11 Set date entered
+41 IF VFNEW
Begin DoDot:1
+42 SET @FDA@(1216)="N"
+43 SET @FDA@(1217)="`"_DUZ
End DoDot:1
+44 ;Patch 11 Set last modified
+45 SET @FDA@(1218)="N"
+46 SET @FDA@(1219)="`"_DUZ
+47 SET RET=$$UPDATE^BGOUTL(.FDA,"E")
+48 IF RET
IF VFNEW
IF $$DELETE^BGOUTL(FNUM,VFIEN)
+49 IF 'RET
DO VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)
+50 IF 'RET
SET RET=VFIEN
+51 QUIT
+52 ; Return V File #
FNUM() QUIT 9000010.13
