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

BTIUPCC.m

Go to the documentation of this file. 
  1. BTIUPCC ; IHS/ITSC/LJF - IHS PCC LINKS WITH TIU ;09-Mar-2007 15:58;MGH
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**1001,1003,1004,1005*;NOV 04, 2004
  1.  ;IHS/ITSC/LJF 01/26/2005 PATCH 1001 added code to return brief lab result
  1.  ;IHS/CIA/MGH 09/20/2005 PATCH 1003
  1.  ;IHS/CIA/MGH 04/03/2006 PATCH 1004 fixed a bug with changes in 1003
  1.  ;IHS/MSC/MGH PATCH 1005 added lookup by date only
  1. GETV(TIUVSIT,DFN,VLOC,VDATE,CATEGORY) ;EP
  1.  ; returns visit ien for patient, date, srv cat
  1.  NEW TIUX,TIUD,TIUEND,TIUV
  1.  S (TIUD,TIUEND)=9999999-(VDATE\1),TIUVSIT=0
  1.  F  S TIUD=$O(^AUPNVSIT("AA",DFN,TIUD)) Q:TIUD=""!($P(TIUD,".")'=TIUEND)!($G(TIUVSIT))  D
  1.  . S TIUV=0
  1.  . F  S TIUV=$O(^AUPNVSIT("AA",DFN,TIUD,TIUV)) Q:TIUV=""!($G(TIUVSIT))  D
  1.  .. Q:$$GET1^DIQ(9000010,TIUV,.07,"I")'=CATEGORY
  1.  .. S TIUVSIT=TIUV
  1.  Q
  1.  ;
  1.  ;IHS/ITSC/LJF 01/26/2005 PATCH 1001 added code to handle brief result; see lines wiht "PATCH 1001"
  1. SLAB(DFN,TIUTST,TIULAST,BRIEF) ;EP; -- returns most current lab result for single test  ;PATCH 1001
  1.  ; BRIEF=1 means brief result, BRIEF=2 no caption or date; optional                       ;PATCH 1001
  1.  ; BRIEF=3 means date only
  1.  NEW LAB,VDT,IEN,X,TIU,LINE,ARR,DATE,BTIUQ
  1.  S LAB=$O(^LAB(60,"B",TIUTST,0)) I LAB="" Q ""
  1.  S VDT=0
  1.  F  S VDT=$O(^AUPNVLAB("AA",DFN,LAB,VDT)) Q:'VDT!($G(LINE)]"")  D
  1.  .S IEN=0
  1.  .;IHS/CIA/MGH
  1.  .;F  S IEN=$O(^AUPNVLAB("AA",DFN,LAB,VDT,IEN)) Q:'IEN!($G(LINE)]"")  D
  1.  .F  S IEN=$O(^AUPNVLAB("AA",DFN,LAB,VDT,IEN)) Q:'IEN  D
  1.  ..K TIU D ENP^XBDIQ1(9000010.09,IEN,".03:.05;1109;1201","TIU(")
  1.  ..S DATE=$S(TIU(1201)]"":TIU(1201),1:TIU(.03))
  1.  ..I TIU(.04)="" D  Q
  1.  ...;I '$O(^AUPNVLAB("AA",DFN,LAB,VDT,IEN)) S LINE=$$PAD(TIU(1109),25)_DATE         ;PATCH 1001
  1.  ...I '$O(^AUPNVLAB("AA",DFN,LAB,VDT)) S:'$G(BRIEF) LINE=$$PAD(TIU(1109),25)_DATE   ;PATCH 1001
  1.  ..I $G(BRIEF)=1 S LINE=TIU(.04)                                          ;PATCH 1001
  1.  ..I $G(BRIEF)=3 S LINE=DATE
  1.  ..E  S LINE=$$PAD($J(TIU(.04),8)_"  "_TIU(.05),10)_DATE
  1.  ..;Added for multiple of the same test on the same day IHS/CIA/MGH
  1.  ..S ARR(DATE,IEN)=LINE  ; PATCH 1003
  1.  ;
  1.  I '$D(ARR) Q $S($G(BRIEF):" - Not Done -",1:$$PAD(TIUTST,20)_" -Not Done-")             ;PATCH 1003
  1.  S DATE=$O(ARR(""),-1)       ;PATCH 1003
  1.  S IEN=$O(ARR(DATE,""),-1)   ;PATCH 1003
  1.  S LINE=ARR(DATE,IEN)        ;PATCH 1003
  1.  ;End fix  IHS/CIA/MGH
  1.  S X=$S($G(TIULAST)]"":TIULAST,1:"Last ")_$$PAD(TIUTST,20)  ;PATCH 1003
  1.  I $G(BRIEF) S BTIUQ=$G(LINE)  ;PATCH 1004
  1.  E  S BTIUQ=X_" "_$G(LINE)     ;PATCH 1004
  1.  Q BTIUQ
  1.  ;Q $S($G(BRIEF):$G(LINE),1:X_" "_$S($G(LINE)]"":LINE)   ;PATCH 1001
  1.  ;
  1. LABPANL(DFN,TIUPANL,TIUCNT) ;EP; -- mult line answer for results under panel
  1.  NEW LAB,TEST,TIUTST,X
  1.  K ^TMP("BTIULO",$J)
  1.  S LAB=$O(^LAB(60,"B",TIUPANL,0)) I LAB="" Q ""
  1.  S TIUCNT=$G(TIUCNT)+1,X=$S(TIUCNT>1:"  ",1:"")
  1.  S ^TMP("BTIULO",$J,TIUCNT,0)=X_"Last "_TIUPANL_":"
  1.  S TEST=0 F  S TEST=$O(^LAB(60,LAB,2,TEST)) Q:'TEST  D
  1.  . S TIUTST=+^LAB(60,LAB,2,TEST,0)
  1.  . I $P(^LAB(60,TIUTST,0),U,3)="N" Q  ;type=neither
  1.  . I $O(^LAB(60,TIUTST,2,0)) S X=$$LABPANL(DFN,$P(^LAB(60,TIUTST,0),U),.TIUCNT) Q
  1.  . S X=$$SLAB(DFN,$P(^LAB(60,TIUTST,0),U),$$SP(5)) Q:X=""
  1.  . S TIUCNT=$G(TIUCNT)+1,^TMP("BTIULO",$J,TIUCNT,0)=" "_X
  1.  Q "~@^TMP(""BTIULO"",$J)"
  1.  ;
  1. SMEAS(V,TYPE) ;EP; -- returns a single measurement taken during visit
  1.  NEW APCLV,E,X,Y
  1.  S X="APCLV" X ^%ZOSF("TEST") I '$T Q ""
  1.  S E=$$PCCVF^APCLV(V,"MEASUREMENT","7;8") I E Q ""
  1.  S Y="",X=0 F  S X=$O(APCLV(X)) Q:'X  D
  1.  . Q:$P(APCLV(X),U)'=TYPE
  1.  . S Y=Y_$P(APCLV(X),U,2)_";"
  1.  Q $S(Y="":Y,1:$E(Y,1,$L(Y)-1))
  1.  ;
  1. MMEAS(V) ;EP; -- returns all measurements for a visit
  1.  NEW APCLV,E,X,Y,TIUZ
  1.  S X="APCLV" X ^%ZOSF("TEST") I '$T Q ""
  1.  S E=$$PCCVF^APCLV(V,"MEASUREMENT","7;8") I E Q ""
  1.  S X=0 F  S X=$O(APCLV(X)) Q:'X  D
  1.  . S TIUZ($P(APCLV(X),U))=$G(TIU($P(APCLV(X),U)))_$P(APCLV(X),U,2)_";"
  1.  S Y="",X=0 F  S X=$O(TIUZ(X)) Q:X=""  S Y=Y_X_":"_TIUZ(X)_" "
  1.  Q Y
  1.  ;
  1. MIMM(V) ;EP; -- returns all immunizations for a visit
  1.  NEW X,BTIUN,E,BTIUY
  1.  S X="APCLV" X ^%ZOSF("TEST") I '$T Q ""
  1.  I 'V Q ""
  1.  F BTIUN=1:1 S E=$$IMM^APCLV(V,"E",BTIUN) Q:E=""  D
  1.  . S BTIUY=$G(BTIUY)_"; "_E
  1.  Q $P($G(BTIUY),";",2,99)
  1.  ;
  1. VV(N) ;EP; -- displays visit
  1.  ; -- called by TIUVSIT
  1.  NEW DFN,APCDVSIT
  1.  I $L(N)=1 W !,*7,"You MUST type ""V"" plus the item # (i.e. V3).",!! Q
  1.  S APCDVSIT=$G(^TMP("TIUIHSV",$J,$E(N,2,99))) Q:'APCDVSIT
  1.  D EN^APCDVD     ;calling PEP in PCC
  1.  Q
  1.  ;
  1. VNOTE(NOTE,VISIT,DFN,MODE) ;EP; -- create v note entry
  1.  ; -- called by TIUEDIT
  1.  I $$GET1^DIQ(8925,NOTE,.03,"I")'=+VISIT D ERRMSG(1) Q
  1.  I $$GET1^DIQ(9000010,+VISIT,.05,"I")'=DFN D ERRMSG(2) Q
  1.  NEW APCDALVR,APCDADFN,APCDAFLG,APCDLOOK
  1.  I MODE="ADD",$O(^AUPNVNOT("B",NOTE,0)) S MODE="MOD",APCDALVR("APCDLOOK")="`"_$O(^AUPNVNOT("B",NOTE,0))
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.28 ("_MODE_")]"
  1.  S APCDALVR("APCDPAT")=DFN
  1.  S APCDALVR("APCDVSIT")=+VISIT
  1.  S APCDALVR("APCDTDOC")="`"_NOTE
  1.  S APCDALVR("APCDTCDT")=$$GET1^DIQ(8925,NOTE,1201,"I")
  1.  I $G(BTIURX) S X=$$ORDPRV(+VISIT) I X]"" S APCDALVR("APCDTEPR")="`"_X
  1.  S X=$$GET1^DIQ(8925,NOTE,1202,"I") I X]"" S APCDALVR("APCDTPRV")="`"_X
  1.  D EN^APCDALVR        ;calling PEP in PCC
  1.  I $G(APCDAFLG) D ERRMSG(2) Q
  1.  Q
  1.  ;
  1. ORDPRV(V) ; -- returns ien for ordering provider on 1st v med entry for visit
  1.  ; called when v note entered as part of pharmacy process
  1.  NEW X S X=$O(^AUPNVMED("AD",V,0)) I X="" Q ""
  1.  Q $$GET1^DIQ(9000010.14,X,1202,"I")
  1.  ;
  1.  ;
  1. ERRMSG(N) ; -- store error if v note add bombs
  1.  I $D(ZTQUEUED) S ^TIUZZ("ERROR",+$G(N))=$G(VISIT) Q
  1.  I N=1 W !!,*7,"VISIT=",VISIT,!! Q
  1.  W !!,*7,$G(APCDAFLG),!!
  1.  Q
  1.  ;
  1.  ;
  1. DEMOG(NOTE) ;EP; -- sets up line of demographic data
  1.  ; NOTE=document ien
  1.  NEW PT,TIUZZ
  1.  S PT=$$GET1^DIQ(8925,NOTE,.02,"I") I PT="" Q ""
  1.  D ENP^XBDIQ1(9000001,PT,"1101.2;1102.2;1102.98","TIUZZ(")
  1.  S LINE=TIUZZ(1101.2)_"  DOB: "_$$FMTE^XLFDT(TIUZZ(1102.2),"5D")
  1.  S LINE=LINE_" ("_TIUZZ(1102.98)_")" ;age
  1.  Q LINE
  1.  ;
  1. VLINE(NOTE) ;EP; -- sets up visit display lines for ^tmp(tiur,$j arrays
  1.  ; NOTE=document ien
  1.  NEW TIUZZ,VST,PAT
  1.  S VST=+$$GET1^DIQ(8925,NOTE,.03,"I") I VST=0 Q "*** NO VISIT ATTACHED ***"
  1.  S PAT=+$$GET1^DIQ(8925,NOTE,.02,"I")
  1.  D ENP^XBDIQ1(9000010,VST,".01;.05:.08;.22","TIUZZ(","I")
  1.  I TIUZZ(.05,"I")'=PAT Q "**** BAD VISIT LINK ****"
  1.  I TIUZZ(.07,"I")="H" Q $$HOSLINE(VST)
  1.  I TIUZZ(.07,"I")="E" Q $$EVTLINE(VST)
  1.  Q $$AMBLINE(VST)
  1.  ;
  1. AMBLINE(VST) ; -- returns line of readable ambulatory data
  1.  NEW LINE
  1.  S LINE=" Visit: "_$$FMTE^XLFDT(TIUZZ(.01,"I"),1) ;visit date
  1.  S LINE=$$PAD(LINE,28)_TIUZZ(.07)_"-"  ;ser cat
  1.  S LINE=LINE_$$PAD($$CLINIC,6) ;clinic type & name
  1.  S LINE=LINE_" Dx: "_$$POV(VST,1)  ;prim dx
  1.  Q LINE
  1.  ;
  1. EVTLINE(VST) ; -- returns line of readable historical event data
  1.  NEW LINE
  1.  S LINE=" Visit: "_$$FMTE^XLFDT(TIUZZ(.01,"I"),1) ;visit date
  1.  S LINE=$$PAD(LINE,28)_TIUZZ(.07)_" at "          ;service category
  1.  ; location of encounter and chart # at that location
  1.  S LINE=LINE_$$PAD($$GET1^DIQ(9999999.06,TIUZZ(.06,"I"),.02),13)
  1.  S LINE=LINE_"- Chart #"_$$HRCN(TIUZZ(.05,"I"),TIUZZ(.06,"I"))
  1.  Q LINE
  1.  ;
  1. HOSLINE(VST) ; -- returns line of readable hospitalization data
  1.  NEW LINE
  1.  S LINE="Inpt: "_$$VD^APCLV(VST,"S")_"-"_$$DSCH(VST)
  1.  S LINE=$$PAD(LINE,25)_"admt by "_$$PAD($$PROV(NOTE),18)  ;admt prov
  1.  S LINE=LINE_$$PAD($$SRV,5) ;service
  1.  S LINE=LINE_" Dx: "_$$POV(VST,"P")  ;prim dx
  1.  Q LINE
  1.  ;
  1. DSCH(VISIT) ;EP; -- returns discharge date for visit
  1.  NEW X
  1.  S X=$$DSCHDATE^APCLV(VISIT,"S")
  1.  Q $S(X]"":X,1:"??")
  1.  ;
  1. CLINIC() ; -- returns clinic stop abbrev
  1.  Q $$GET1^DIQ(40.7,+TIUZZ(.08,"I"),999999901) ;abbrev
  1.  ;
  1. SRV() ; -- returns service
  1.  NEW HOS,ASRV,DSRV
  1.  S HOS=$O(^AUPNVINP("AD",VST,0)) I HOS="" Q ""
  1.  S ASRV=$$GET1^DIQ(45.7,+$$GET1^DIQ(9000010.02,HOS,.04,"I"),99)
  1.  S DSRV=$$GET1^DIQ(45.7,+$$GET1^DIQ(9000010.02,HOS,.05,"I"),99)
  1.  Q ASRV_$S(ASRV'=DSRV:"/"_DSRV,1:"")
  1.  ;
  1. POV(VISIT,SCREEN) ; -- returns a diagnosis
  1.  ; SCREEN=1 for ambulatory visits, =P for hospitalizations
  1.  NEW DX,IEN
  1.  I SCREEN=1 D  Q DX
  1.  . S IEN=$O(^AUPNVPOV("AD",VISIT,0)) I 'IEN S DX="" Q
  1.  . S DX=$$GET1^DIQ(9000010.07,IEN,.04)
  1.  ;
  1.  S IEN=0 F  S IEN=$O(^AUPNVPOV("AD",VISIT,IEN)) Q:'IEN!($D(DX))  D
  1.  . I $$GET1^DIQ(9000010.07,IEN,.12,"I")'="P" Q
  1.  . S DX=$$GET1^DIQ(9000010.07,IEN,.04)
  1.  Q $G(DX)
  1.  ;
  1. POVALL(VISIT) ; -- returns all diagnoses for a visit
  1.  NEW DX,IEN
  1.  S IEN=0,DX=""
  1.  F  S IEN=$O(^AUPNVPOV("AD",VISIT,IEN)) Q:'IEN  D
  1.  . S DX=DX_"; "_$$GET1^DIQ(9000010.07,IEN,.04)
  1.  Q "  POV:"_$P(DX,";",2,9999)
  1.  ;
  1. PRCALL(VISIT) ; -- returns all procedures for a visit
  1.  NEW PRC,IEN
  1.  S IEN=0,PRC=""
  1.  F  S IEN=$O(^AUPNVPRC("AD",VISIT,IEN)) Q:'IEN  D
  1.  . S PRC=PRC_"; "_$$GET1^DIQ(9000010.08,IEN,.04)
  1.  S PRC=$P(PRC,";",2,999)
  1.  Q $S(PRC="":"",1:"  Procedure(s):"_PRC)
  1.  ;
  1. PRVALL(VISIT) ; -- returns all providers for a visit
  1.  NEW PRV,IEN
  1.  S IEN=0,PRV=""
  1.  F  S IEN=$O(^AUPNVPRV("AD",VISIT,IEN)) Q:'IEN  D
  1.  . S PRV=PRV_"; "_$$GET1^DIQ(9000010.06,IEN,.01)
  1.  Q "  Provider(s):"_$P(PRV,";",2,999)
  1.  ;
  1. DISCH(VISIT) ;EP; -- returns discharge date for visit
  1.  NEW VH
  1.  S VH=$O(^AUPNVINP("AD",VISIT,0)) I VH="" Q ""
  1.  Q $$FMTE^XLFDT(+^AUPNVINP(VH,0),5)
  1.  ;
  1. PROV(NOTE) ; -- returns admitg prov for movement
  1.  NEW X,Y
  1.  S X=$$GET1^DIQ(8925,NOTE,1401,"I") I X="" Q ""       ;admit ien for note
  1.  S X=$$GET1^DIQ(405,X,.01,"I") I X="" Q ""            ;date/time of admit
  1.  S Y=$$GET1^DIQ(8925,NOTE,.02,"I") I Y="" Q ""        ;patient ien
  1.  S X=$O(^DGPM("AMV6",X,Y,0)) I X="" Q ""              ;1st service for admit
  1.  ;
  1.  I $L($T(^BDGF1)) Q $E($$GET1^DIQ(405,+X,9999999.02),1,15)  ;admitg provider PIMS v5.3
  1.  Q $E($$GET1^DIQ(405,+X,.08),1,15)                           ;admitg provider MAS v5.0
  1.  ;
  1. HRCN(PAT,FAC) ;EP; -- returns chart # for patient at facility sent
  1.  Q $P($G(^AUPNPAT(PAT,41,FAC,0)),U,2)
  1.  ;
  1. PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
  1.  Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
  1.  ;
  1. SP(NUM) ; -- SUBRTN to pad spaces
  1.  Q $$PAD(" ",NUM)