- 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)"
