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