BTIULO8 ;IHS/ITSC/LJF - IHS OBJECTS ADDED IN PATCHES;08-Jul-2013 15:26;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1002,1006,1012**;NOV 04, 2004;Build 45
;1006 Updated family history object
;
TODAYRAD(PAT,PROV) ;EP; returns all radiology exams taken today;PATCH 1002 new code
; If PROV=1, include providers (ordering and encounter)
NEW VDT,END,VISIT,COUNT,TIUX,LINE,TIUA
K ^TMP("BTIULO",$J)
;
; for each visit patient had today, find all exams
S VDT=9999999-DT,END=VDT_".2359"
F S VDT=$O(^AUPNVSIT("AA",PAT,VDT)) Q:'VDT Q:VDT>END D
. S VISIT=0 F S VISIT=$O(^AUPNVSIT("AA",PAT,VDT,VISIT)) Q:'VISIT D
. . S TIUX=0,LINE="" F S TIUX=$O(^AUPNVRAD("AD",VISIT,TIUX)) Q:'TIUX D
. . . K TIUA D ENP^XBDIQ1(9000010.22,TIUX,".01;.05;1202;1204","TIUA(")
. . . S LINE=TIUA(.01) ;exam name
. . . I TIUA(.05)]"" S LINE=LINE_" ("_TIUA(.05)_")" ;abnormal vs normal
. . . I +$G(PROV)&(TIUA(1202)]"") S LINE=LINE_" ["_TIUA(1202)_"/"_TIUA(1204)_"]" ;providers
. . . S COUNT=$G(COUNT)+1 S ^TMP("BTIULO",$J,COUNT,0)=LINE
;
I '$D(^TMP("BTIULO",$J)) Q "No Radiology Exams Found for Today"
Q "~@^TMP(""BTIULO"",$J)"
;
TODAYIMM(PAT,PROV) ;EP; returns all immunizations given today;PATCH 1002 new code
NEW VDT,END,VISIT,COUNT,TIUX,LINE,TIUA
K ^TMP("BTIULO",$J)
;
; for each visit patient had today, find all immunizations
S VDT=9999999-DT,END=VDT_".2359"
F S VDT=$O(^AUPNVSIT("AA",PAT,VDT)) Q:'VDT Q:VDT>END D
. S VISIT=0 F S VISIT=$O(^AUPNVSIT("AA",PAT,VDT,VISIT)) Q:'VISIT D
. . S TIUX=0,LINE="" F S TIUX=$O(^AUPNVIMM("AD",VISIT,TIUX)) Q:'TIUX D
. . . K TIUA D ENP^XBDIQ1(9000010.11,TIUX,".01;.04;1204","TIUA(")
. . . S LINE=TIUA(.01) ;immunization name
. . . I TIUA(.04)]"" S LINE=LINE_" ("_TIUA(.04)_")" ;series
. . . I +$G(PROV)&(TIUA(1204)]"") S LINE=LINE_" ["_TIUA(1204)_"]" ;encounter provider
. . . S COUNT=$G(COUNT)+1 S ^TMP("BTIULO",$J,COUNT,0)=LINE
;
I '$D(^TMP("BTIULO",$J)) Q "No Immunizations Found for Today"
Q "~@^TMP(""BTIULO"",$J)"
;
FAMHX(PAT,DATE) ;EP; returns multi-line listing of patient's family history;PATCH 1002 new code
; If DATE=1, return date each item obtained
NEW COUNT,TIUX,TIUY,TIUZ,TIUA,LINE,TIUA,REL,RELIEN,RELNAME,CODE
K ^TMP("BTIULO",$J)
S COUNT=0
; for this patient, find all family history entries
S REL=0,LINE="" F S REL=$O(^AUPNFHR("AA",PAT,REL)) Q:REL="" D
.S TIUX=0 F S TIUX=$O(^AUPNFHR("AA",PAT,REL,TIUX)) Q:TIUX="" D
..D ENP^XBDIQ1(9000014.1,TIUX,".01:.06","TIUZ(")
..S LINE=TIUZ(.01)_"["_TIUZ(.03)_"] "_TIUZ(.04)
..S COUNT=$G(COUNT)+1 S ^TMP("BTIULO",$J,COUNT,0)=LINE
..S LINE=""
..I TIUZ(.05)'="" S LINE=" Deceased: "_TIUZ(.05)
..I TIUZ(.06)'="" S LINE=LINE_" Cause of death: "_TIUZ(.06)
..I LINE'="" S COUNT=$G(COUNT)+1 S ^TMP("BTIULO",$J,COUNT,0)=LINE
..S TIUY=0 F S TIUY=$O(^AUPNFH("AE",TIUX,TIUY)) Q:'TIUY D
...D ENP^XBDIQ1(9000014,TIUY,".01:.14","TIUA(")
...S CODE=TIUA(.14) I CODE="" S CODE=TIUA(.01) ;SNOMED CODE patch 1012
...S LINE=" DX: "_TIUA(.04)_" ["_CODE_"]" ;prov narrative Patch 1012[SNOMED code]
...I $G(DATE) S LINE=LINE_" - "_TIUA(.03) ;date noted
...S COUNT=$G(COUNT)+1 S ^TMP("BTIULO",$J,COUNT,0)=LINE
;
I '$D(^TMP("BTIULO",$J)) Q "No Family History Found for Patient"
Q "~@^TMP(""BTIULO"",$J)"
BTIULO8 ;IHS/ITSC/LJF - IHS OBJECTS ADDED IN PATCHES;08-Jul-2013 15:26;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1002,1006,1012**;NOV 04, 2004;Build 45
+2 ;1006 Updated family history object
+3 ;
TODAYRAD(PAT,PROV) ;EP; returns all radiology exams taken today;PATCH 1002 new code
+1 ; If PROV=1, include providers (ordering and encounter)
+2 NEW VDT,END,VISIT,COUNT,TIUX,LINE,TIUA
+3 KILL ^TMP("BTIULO",$JOB)
+4 ;
+5 ; for each visit patient had today, find all exams
+6 SET VDT=9999999-DT
SET END=VDT_".2359"
+7 FOR
SET VDT=$ORDER(^AUPNVSIT("AA",PAT,VDT))
IF 'VDT
QUIT
IF VDT>END
QUIT
Begin DoDot:1
+8 SET VISIT=0
FOR
SET VISIT=$ORDER(^AUPNVSIT("AA",PAT,VDT,VISIT))
IF 'VISIT
QUIT
Begin DoDot:2
+9 SET TIUX=0
SET LINE=""
FOR
SET TIUX=$ORDER(^AUPNVRAD("AD",VISIT,TIUX))
IF 'TIUX
QUIT
Begin DoDot:3
+10 KILL TIUA
DO ENP^XBDIQ1(9000010.22,TIUX,".01;.05;1202;1204","TIUA(")
+11 ;exam name
SET LINE=TIUA(.01)
+12 ;abnormal vs normal
IF TIUA(.05)]""
SET LINE=LINE_" ("_TIUA(.05)_")"
+13 ;providers
IF +$GET(PROV)&(TIUA(1202)]"")
SET LINE=LINE_" ["_TIUA(1202)_"/"_TIUA(1204)_"]"
+14 SET COUNT=$GET(COUNT)+1
SET ^TMP("BTIULO",$JOB,COUNT,0)=LINE
End DoDot:3
End DoDot:2
End DoDot:1
+15 ;
+16 IF '$DATA(^TMP("BTIULO",$JOB))
QUIT "No Radiology Exams Found for Today"
+17 QUIT "~@^TMP(""BTIULO"",$J)"
+18 ;
TODAYIMM(PAT,PROV) ;EP; returns all immunizations given today;PATCH 1002 new code
+1 NEW VDT,END,VISIT,COUNT,TIUX,LINE,TIUA
+2 KILL ^TMP("BTIULO",$JOB)
+3 ;
+4 ; for each visit patient had today, find all immunizations
+5 SET VDT=9999999-DT
SET END=VDT_".2359"
+6 FOR
SET VDT=$ORDER(^AUPNVSIT("AA",PAT,VDT))
IF 'VDT
QUIT
IF VDT>END
QUIT
Begin DoDot:1
+7 SET VISIT=0
FOR
SET VISIT=$ORDER(^AUPNVSIT("AA",PAT,VDT,VISIT))
IF 'VISIT
QUIT
Begin DoDot:2
+8 SET TIUX=0
SET LINE=""
FOR
SET TIUX=$ORDER(^AUPNVIMM("AD",VISIT,TIUX))
IF 'TIUX
QUIT
Begin DoDot:3
+9 KILL TIUA
DO ENP^XBDIQ1(9000010.11,TIUX,".01;.04;1204","TIUA(")
+10 ;immunization name
SET LINE=TIUA(.01)
+11 ;series
IF TIUA(.04)]""
SET LINE=LINE_" ("_TIUA(.04)_")"
+12 ;encounter provider
IF +$GET(PROV)&(TIUA(1204)]"")
SET LINE=LINE_" ["_TIUA(1204)_"]"
+13 SET COUNT=$GET(COUNT)+1
SET ^TMP("BTIULO",$JOB,COUNT,0)=LINE
End DoDot:3
End DoDot:2
End DoDot:1
+14 ;
+15 IF '$DATA(^TMP("BTIULO",$JOB))
QUIT "No Immunizations Found for Today"
+16 QUIT "~@^TMP(""BTIULO"",$J)"
+17 ;
FAMHX(PAT,DATE) ;EP; returns multi-line listing of patient's family history;PATCH 1002 new code
+1 ; If DATE=1, return date each item obtained
+2 NEW COUNT,TIUX,TIUY,TIUZ,TIUA,LINE,TIUA,REL,RELIEN,RELNAME,CODE
+3 KILL ^TMP("BTIULO",$JOB)
+4 SET COUNT=0
+5 ; for this patient, find all family history entries
+6 SET REL=0
SET LINE=""
FOR
SET REL=$ORDER(^AUPNFHR("AA",PAT,REL))
IF REL=""
QUIT
Begin DoDot:1
+7 SET TIUX=0
FOR
SET TIUX=$ORDER(^AUPNFHR("AA",PAT,REL,TIUX))
IF TIUX=""
QUIT
Begin DoDot:2
+8 DO ENP^XBDIQ1(9000014.1,TIUX,".01:.06","TIUZ(")
+9 SET LINE=TIUZ(.01)_"["_TIUZ(.03)_"] "_TIUZ(.04)
+10 SET COUNT=$GET(COUNT)+1
SET ^TMP("BTIULO",$JOB,COUNT,0)=LINE
+11 SET LINE=""
+12 IF TIUZ(.05)'=""
SET LINE=" Deceased: "_TIUZ(.05)
+13 IF TIUZ(.06)'=""
SET LINE=LINE_" Cause of death: "_TIUZ(.06)
+14 IF LINE'=""
SET COUNT=$GET(COUNT)+1
SET ^TMP("BTIULO",$JOB,COUNT,0)=LINE
+15 SET TIUY=0
FOR
SET TIUY=$ORDER(^AUPNFH("AE",TIUX,TIUY))
IF 'TIUY
QUIT
Begin DoDot:3
+16 DO ENP^XBDIQ1(9000014,TIUY,".01:.14","TIUA(")
+17 ;SNOMED CODE patch 1012
SET CODE=TIUA(.14)
IF CODE=""
SET CODE=TIUA(.01)
+18 ;prov narrative Patch 1012[SNOMED code]
SET LINE=" DX: "_TIUA(.04)_" ["_CODE_"]"
+19 ;date noted
IF $GET(DATE)
SET LINE=LINE_" - "_TIUA(.03)
+20 SET COUNT=$GET(COUNT)+1
SET ^TMP("BTIULO",$JOB,COUNT,0)=LINE
End DoDot:3
End DoDot:2
End DoDot:1
+21 ;
+22 IF '$DATA(^TMP("BTIULO",$JOB))
QUIT "No Family History Found for Patient"
+23 QUIT "~@^TMP(""BTIULO"",$J)"
