VPRDVSIT ;SLC/MKB -- Visit/Encounter extract ;8/2/11 15:29
;;1.0;VIRTUAL PATIENT RECORD;**1,2,4,5,7,35**;Sep 01, 2011;Build 16
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^AUPNVSIT 2028
; ^DIC(40.7 557
; ^DIC(42 10039
; ^DIC(45.7 1154
; ^DPT( 10035
; ^SC 10040
; ^VA(200 10060
; DGPTFAPI 3157
; DIC 2051
; DILFD 2055
; DIQ 2056
; ICDEX 5747
; ICPTCOD 1995
; PXAPI,^TMP("PXKENC",$J 1894
; SDOE 2546
; VADPT 10061
; VADPT2 325
; XUAF4 2171
;
; ------------ Get encounter(s) from VistA ------------
;
EN(DFN,BEG,END,MAX,ID) ; -- find patient's visits and appointments
N VPRCNT,VPRITM,VPRDT,VPRLOC,VPRDA,IDT,VPRCATG
S DFN=+$G(DFN) Q:DFN<1
S BEG=$G(BEG,1410101),END=$G(END,4141015),MAX=$G(MAX,9999)
;
; get one visit
I $G(ID) D EN1(ID,.VPRITM),XML(.VPRITM) G ENQ
;
; -- get all visits
I $L($G(FILTER("category"))) G ENAA
I END,END'["." S END=END_".24" ;assume end of day
S VPRCNT=0,VPRDT=END
F S VPRDT=$O(^AUPNVSIT("AET",DFN,VPRDT),-1) Q:VPRDT<BEG D Q:VPRCNT'<MAX
. S VPRLOC=0 F S VPRLOC=$O(^AUPNVSIT("AET",DFN,VPRDT,VPRLOC)) Q:VPRLOC<1 D
.. S VPRDA=0 F S VPRDA=$O(^AUPNVSIT("AET",DFN,VPRDT,VPRLOC,"P",VPRDA)) Q:VPRDA<1 D
... K VPRITM D EN1(VPRDA,.VPRITM) Q:'$D(VPRITM)
... D XML(.VPRITM) S VPRCNT=VPRCNT+1
ENQ ; end
K ^TMP("VPRTEXT",$J)
Q
;
ENAA ; -- allow search w/filter
D IDT S VPRCATG=$G(FILTER("category"))
S VPRCNT=0,IDT=BEG
F S IDT=$O(^AUPNVSIT("AA",DFN,IDT)) Q:IDT<1!(IDT>END) D Q:VPRCNT'<MAX
. S VPRDA=0 F S VPRDA=$O(^AUPNVSIT("AA",DFN,IDT,VPRDA)) Q:VPRDA<1 D
.. I $L(VPRCATG),VPRCATG'[$P($G(^AUPNVSIT(VPRDA,0)),U,7) Q
.. K VPRITM D EN1(VPRDA,.VPRITM) Q:'$D(VPRITM)
.. D XML(.VPRITM) S VPRCNT=VPRCNT+1
K ^TMP("VPRTEXT",$J)
Q
IDT ; -- invert BEG and END dates for PCE format:
; IDT=(9999999-$P(VDT,"."))_"."_$P(VDT,".",2)
N X S X=BEG
S BEG=(9999999-$P(END,"."))
S END=(9999999-$P(X,"."))_".2359"
Q
;
EN1(IEN,VST) ; -- return a visit in VST("attribute")=value
N X0,X15,X,DATE,FAC,LOC,CATG,INPT,DA
K VST,^TMP("VPRTEXT",$J)
S IEN=+$G(IEN) Q:IEN<1 ;invalid
D ENCEVENT^PXAPI(IEN)
S X0=$G(^TMP("PXKENC",$J,IEN,"VST",IEN,0)),X15=$G(^(150))
;Q:$P(X15,U,3)'="P" Q:$P(X0,U,7)="E" ;want primary, not historical
I $P(X0,U,7)="H" D ADM(IEN,+X0,.VST) Q
S VST("id")=IEN,VST("dateTime")=+X0,DATE=+X0
S FAC=+$P(X0,U,6),CATG=$P(X0,U,7),LOC=+$P(X0,U,22)
S:FAC VST("facility")=$$STA^XUAF4(FAC)_U_$P($$NS^XUAF4(FAC),U)
S:'FAC VST("facility")=$$FAC^VPRD(LOC)
S VST("serviceCategory")=CATG_U_$$CATG(CATG)
S VST("visitString")=LOC_";"_DATE_";"_CATG
S INPT=$P(X15,U,2) S:INPT="" INPT=$S("H^I^R^D"[CATG:1,1:0)
S X=$$CPT(IEN) S:X VST("type")=$P($$CPT^ICPTCOD(X),U,2,3)
I 'X S VST("type")=U_$S('INPT&LOC:$P($G(^SC(LOC,0)),U)_" VISIT",1:$$CATG(CATG))
S VST("patientClass")=$S(INPT:"IMP",1:"AMB")
S:INPT VST("admission")=$$ADMVT(DATE) ;get related mvt# if inpt visit/data
S X=$P(X0,U,8) S:X VST("stopCode")=$$AMIS(X) I LOC D
. N L0 S L0=$G(^SC(LOC,0))
. I 'X S VST("stopCode")=$$AMIS($P(L0,U,7))
. S VST("location")=$P(L0,U),VST("service")=$$SERV($P(L0,U,20))
. S X=$P(L0,U,18) S:X VST("creditStopCode")=$$AMIS(X)
S VST("reason")=$$POV(IEN,DATE)
; provider(s), including taxonomy/specialty info
S DA=0 F S DA=$O(^TMP("PXKENC",$J,IEN,"PRV",DA)) Q:DA<1 S X0=$G(^(DA,0)) D
. S VST("provider",DA)=+X0_U_$P($G(^VA(200,+X0,0)),U)_$S($P(X0,U,4)="P":"^P^1",1:"^S^")_U_$$PROVSPC^VPRD(+X0)
; cpt(s)
S DA=0 F S DA=$O(^TMP("PXKENC",$J,IEN,"CPT",DA)) Q:DA<1 S X0=$G(^(DA,0)) D
. S VST("cpt",DA)=$P($$CPT^ICPTCOD(+X0),U,2,3)
; icd(s)
S DA=0 F S DA=$O(^TMP("PXKENC",$J,IEN,"POV",DA)) Q:DA<1 S X0=$G(^(DA,0)) D
. S VST("icd",DA)=$$ICD(+X0,DATE)_U_$$EXTERNAL^DILFD(9000010.07,.04,,$P(X0,U,4))_U_$S($L($P(X0,U,12)):$P(X0,U,12),1:"U")
; note(s)
D TIU(IEN)
K ^TMP("PXKENC",$J,IEN)
Q
;
TIU(VISIT) ; -- add notes to VST("document")
N X,Y,I,VPRX,LT,NT,DA,CNT,VPRY
D FIND^DIC(8925,,.01,"QX",+$G(VISIT),,"V",,,"VPRX")
S Y="",(I,CNT)=0
F S I=$O(VPRX("DILIST",1,I)) Q:I<1 D
. S DA=$G(VPRX("DILIST",2,I))
. S Y=$$INFO^VPRDTIU(+DA) Q:Y<1 ;draft or retracted
. S CNT=CNT+1,VST("document",CNT)=Y
. S:$G(VPRTEXT) VST("document",CNT,"content")=$$TEXT^VPRDTIU(DA)
Q
;
POV(VISIT,VDT) ; -- return the primary Purpose of Visit as ICD^ProviderNarrative
N DA,Y,X,X0,ICD S Y=""
S DA=0 F S DA=$O(^TMP("PXKENC",$J,VISIT,"POV",DA)) Q:DA<1 S X0=$G(^(DA,0)) I $P(X0,U,12)="P" D Q:$L(Y)
. S X=+$P(X0,U,4),ICD=$$ICD(+X0,$G(VDT))
. S Y=ICD_U_$$EXTERNAL^DILFD(9000010.07,.04,,X)
Q Y
;
ICD(IEN,DATE) ; -- return code^description^system for ICD code, or "^^" if error
N X0,VPRX,N,I,X,Y
S IEN=+$G(IEN),DATE=+$G(DATE,DT)
S Y=$$CODEC^ICDEX(80,IEN),X=$$VLTD^ICDEX(IEN,DATE)
I $L(X) S Y=Y_U_X
E S Y=Y_U_$$VSTD^ICDEX(IEN,DATE)
S X=$$CSI^ICDEX(80,IEN),$P(Y,U,3)=$$SAB^ICDEX(X)
Q Y
;
CPT(VISIT) ; -- Return CPT code of encounter type
N DA,Y,X,X0 S Y=""
S DA=0 F S DA=$O(^TMP("PXKENC",$J,VISIT,"CPT",DA)) Q:DA<1 S X0=$G(^(DA,0)) D Q:$L(Y)
. S X=$P(X0,U) I X?1"992"2N S Y=X Q
Q Y
;
AMIS(X) ; -- return the AMIS code^name of Credit Stop X
N Y,X0 S Y=""
S X0=$G(^DIC(40.7,+$G(X),0)) S:$L(X0) Y=$P(X0,U,2)_U_$P(X0,U)
Q Y
;
CATG(X) ; -- Return name of visit Service Category code X
N Y S Y=""
I X="A" S Y="AMBULATORY"
I X="H" S Y="HOSPITALIZATION"
I X="I" S Y="IN HOSPITAL"
I X="C" S Y="CHART REVIEW"
I X="T" S Y="TELECOMMUNICATIONS"
I X="N" S Y="NOT FOUND"
I X="S" S Y="DAY SURGERY"
I X="O" S Y="OBSERVATION"
I X="E" S Y="EVENT (HISTORICAL)"
I X="R" S Y="NURSING HOME"
I X="D" S Y="DAILY HOSPITALIZATION DATA"
I X="X" S Y="ANCILLARY PACKAGE DAILY DATA"
Q Y
;
SERV(FTS) ; -- Return #42.4 Service for a Facility Treating Specialty
N Y S Y="",FTS=+$G(FTS)
S Y=$$GET1^DIQ(45.7,FTS_",","1:3","E")
Q Y
;
ADMVT(VAINDT) ; -- return movement# for related admission
N VADMVT,VAERR
D ADM^VADPT2
Q VADMVT
;
ADM(IEN,DATE,ADM) ; -- return an admission in ADM("attribute")=value
N VAINDT,VADMVT,VAIP,VAIN,VAERR,HLOC,ICD,I K ADM
S IEN=+$G(IEN),DATE=+$G(DATE) Q:IEN<1 Q:DATE<1
S VAINDT=DATE D ADM^VADPT2 Q:VADMVT<1
I VADMVT=$G(^DPT(DFN,.105)) D INPT Q ;current inpatient
S VAIP("E")=VADMVT D IN5^VADPT Q:'$G(VAIP(1)) ;deleted
S ADM("id")=IEN,ADM("patientClass")="IMP",ADM("admission")=$G(VAIP(13))
; ADM("admitType")=$P($G(VAIP(4)),U,2)
S DATE=+$G(VAIP(13,1)),(ADM("dateTime"),ADM("arrivalDateTime"))=DATE,I=0
S X=$G(VAIP(7)) S:X I=I+1,ADM("provider",I)=X_"^P^1"_U_$$PROVSPC^VPRD(+X) ;primary
S X=$G(VAIP(18)) S:X I=I+1,ADM("provider",I)=X_"^A^"_U_$$PROVSPC^VPRD(+X) ;attending
S ADM("specialty")=$P($G(VAIP(8)),U,2)
S X=$$SERV(+$G(VAIP(8))),ADM("service")=X,ADM("ptf")=VAIP(12)
S ICD=$$POV(IEN,DATE) S:'ICD ICD=$$PTF(DFN,VAIP(12),DATE) ;PTF>ICD
S ADM("reason")=ICD_U_$G(VAIP(9)) ;ICD code^description^system^Dx text
S HLOC=+$G(^DIC(42,+$G(VAIP(5)),44))
S:HLOC ADM("location")=$P($G(^SC(HLOC,0)),U)
S ADM("facility")=$$FAC^VPRD(+HLOC),ADM("roomBed")=$P(VAIP(6),U,2)
S ADM("serviceCategory")="H^HOSPITALIZATION"
S X=$$CPT(IEN),ADM("type")=$S(X:$P($$CPT^ICPTCOD(X),U,2,3),1:U_$$CATG("H"))
I $G(VAIP(17)) D
. S ADM("departureDateTime")=+$G(VAIP(17,1))
. ; ADM("disposition")=$G(VAIP(17,3)) ;Discharge Mvt Type
S ADM("visitString")=HLOC_";"_DATE_";H"
D TIU(IEN) ;notes/summary
Q
;
INPT ; -- return current admission in ADM("attribute")=value [from ADM]
K VAINDT D INP^VADPT Q:$G(VAIN(1))<1
S ADM("id")=IEN,ADM("patientClass")="IMP",ADM("admission")=VAIN(1)
; ADM("admitType")=$P($G(VAIN(8)),U,2)
S DATE=+$G(VAIN(7)),(ADM("dateTime"),ADM("arrivalDateTime"))=DATE,I=0
S X=$G(VAIN(2)) S:X I=I+1,ADM("provider",I)=X_"^P^1"_U_$$PROVSPC^VPRD(+X) ;primary
S X=$G(VAIN(11)) S:X I=I+1,ADM("provider",I)=X_"^A^"_U_$$PROVSPC^VPRD(+X) ;attending
S ADM("specialty")=$P($G(VAIN(3)),U,2)
S X=$$SERV(+$G(VAIN(3))),ADM("service")=X,ADM("ptf")=VAIN(10)
S ICD=$$POV(IEN,DATE) S:'ICD ICD=$$PTF(DFN,VAIN(10),DATE) ;PTF>ICD
S ADM("reason")=ICD_U_$G(VAIN(9)) ;ICD code^description^system^Dx text
S HLOC=+$G(^DIC(42,+$G(VAIN(4)),44))
S:HLOC ADM("location")=$P($G(^SC(HLOC,0)),U)
S ADM("facility")=$$FAC^VPRD(+HLOC),ADM("roomBed")=VAIN(5)
S ADM("serviceCategory")="H^HOSPITALIZATION"
S X=$$CPT(IEN),ADM("type")=$S(X:$P($$CPT^ICPTCOD(X),U,2,3),1:U_$$CATG("H"))
; ADM("visitString")=HLOC_";"_DATE_";H"
D TIU(IEN) ;notes/summary
Q
;
PTF(DFN,PTF,DATE) ; -- return ICD code^description^system for a PTF record
N VPRPTF,X0,Y
D:$G(PTF) RPC^DGPTFAPI(.VPRPTF,+PTF) I $G(VPRPTF(0))<0 Q "^^"
S Y=$P($G(VPRPTF(1)),U,3),DATE=+$G(DATE,DT)
S X0=$$ICDDX^ICDEX(Y,DATE,,"E") I X0<0 Q "^^"
S Y=$P(X0,U,2)_U_$P(X0,U,4) ;ICD Code^Dx name
S $P(Y,U,3)=$$SAB^ICDEX($P(X0,U,20)) ;coding system
Q Y
;
ENC(IEN,ENC) ; -- return an encounter in ENC("attribute")=value
N X0,DATE,HLOC,TYPE,STS,X,Y K ENC
S IEN=+$G(IEN) Q:IEN<1 ;invalid ien
S ENC("id")="E"_IEN,X0=$$GETOE^SDOE(IEN) ;^SCE(IEN,0) node
S DATE=+X0,ENC("dateTime")=DATE
S HLOC=+$P(X0,U,4) I HLOC D
. S HLOC=HLOC_U_$P($G(^SC(HLOC,0)),U)
. S ENC("location")=$P(HLOC,U,2)
. S X=$$GET1^DIQ(44,+HLOC_",",9.5,"I")
. I X S ENC("service")=$$SERV(X)
S ENC("facility")=$$FAC^VPRD(+HLOC)
S STS=$$EXTERNAL^DILFD(409.68,.12,,$P(X0,U,12))
S X=$S(STS?1"INP".E:"IMP",1:"AMB"),ENC("patientClass")=X,TYPE=$E(X)
S ENC("type")=U_$S(HLOC:$P(HLOC,U,2)_" VISIT",1:$$CATG(TYPE))
S ENC("serviceCategory")=TYPE_U_$$CATG(TYPE)
S ENC("visitString")=+HLOC_";"_DATE_";"_TYPE
Q
;
; ------------ Return data to middle tier ------------
;
XML(VISIT) ; -- Return patient visit as XML
N ATT,X,Y,NAMES,I,J
D ADD("<visit>") S VPRTOTL=$G(VPRTOTL)+1
S ATT="" F S ATT=$O(VISIT(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
. I $O(VISIT(ATT,0)) D S Y="" Q ;multiples
.. D ADD("<"_ATT_"s>")
.. S I=0 F S I=$O(VISIT(ATT,I)) Q:I<1 D
... S X=$G(VISIT(ATT,I)),NAMES=""
... I ATT="document" S NAMES="id^localTitle^nationalTitle^vuid^Z"
... I ATT="provider" S NAMES="code^name^role^primary^"_$$PROVTAGS^VPRD_"^Z"
... I ATT="cpt" S NAMES="code^name^Z"
... I ATT="icd" S NAMES="code^name^system^narrative^ranking^Z"
... S Y="<"_ATT_" "_$$LOOP ;_"/>" D ADD(Y)
... S X=$G(VISIT(ATT,I,"content")) I '$L(X) S Y=Y_"/>" D ADD(Y) Q
... S Y=Y_">" D ADD(Y)
... S Y="<content xml:space='preserve'>" D ADD(Y)
... S J=0 F S J=$O(@X@(J)) Q:J<1 S Y=$$ESC^VPRD(@X@(J)) D ADD(Y)
... D ADD("</content>"),ADD("</"_ATT_">")
.. D ADD("</"_ATT_"s>")
. S X=$G(VISIT(ATT)),Y="" Q:'$L(X)
. S NAMES="code^name^"_$S(ATT="reason":"system^narrative^",1:"")_"Z"
. I X'["^" S Y="<"_ATT_" value='"_$$ESC^VPRD(X)_"' />" Q
. I $L(X)>1 S Y="<"_ATT_" "_$$LOOP_"/>"
D ADD("</visit>")
Q
;
LOOP() ; -- build sub-items string from NAMES and X
N STR,P,TAG S STR=""
F P=1:1 S TAG=$P(NAMES,U,P) Q:TAG="Z" I $L($P(X,U,P)) S STR=STR_TAG_"='"_$$ESC^VPRD($P(X,U,P))_"' "
Q STR
;
ADD(X) ; -- Add a line @VPR@(n)=X
S VPRI=$G(VPRI)+1
S @VPR@(VPRI)=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRDVSIT 11525 printed Nov 22, 2024@17:55:01 Page 2
VPRDVSIT ;SLC/MKB -- Visit/Encounter extract ;8/2/11 15:29
+1 ;;1.0;VIRTUAL PATIENT RECORD;**1,2,4,5,7,35**;Sep 01, 2011;Build 16
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^AUPNVSIT 2028
+7 ; ^DIC(40.7 557
+8 ; ^DIC(42 10039
+9 ; ^DIC(45.7 1154
+10 ; ^DPT( 10035
+11 ; ^SC 10040
+12 ; ^VA(200 10060
+13 ; DGPTFAPI 3157
+14 ; DIC 2051
+15 ; DILFD 2055
+16 ; DIQ 2056
+17 ; ICDEX 5747
+18 ; ICPTCOD 1995
+19 ; PXAPI,^TMP("PXKENC",$J 1894
+20 ; SDOE 2546
+21 ; VADPT 10061
+22 ; VADPT2 325
+23 ; XUAF4 2171
+24 ;
+25 ; ------------ Get encounter(s) from VistA ------------
+26 ;
EN(DFN,BEG,END,MAX,ID) ; -- find patient's visits and appointments
+1 NEW VPRCNT,VPRITM,VPRDT,VPRLOC,VPRDA,IDT,VPRCATG
+2 SET DFN=+$GET(DFN)
if DFN<1
QUIT
+3 SET BEG=$GET(BEG,1410101)
SET END=$GET(END,4141015)
SET MAX=$GET(MAX,9999)
+4 ;
+5 ; get one visit
+6 IF $GET(ID)
DO EN1(ID,.VPRITM)
DO XML(.VPRITM)
GOTO ENQ
+7 ;
+8 ; -- get all visits
+9 IF $LENGTH($GET(FILTER("category")))
GOTO ENAA
+10 ;assume end of day
IF END
IF END'["."
SET END=END_".24"
+11 SET VPRCNT=0
SET VPRDT=END
+12 FOR
SET VPRDT=$ORDER(^AUPNVSIT("AET",DFN,VPRDT),-1)
if VPRDT<BEG
QUIT
Begin DoDot:1
+13 SET VPRLOC=0
FOR
SET VPRLOC=$ORDER(^AUPNVSIT("AET",DFN,VPRDT,VPRLOC))
if VPRLOC<1
QUIT
Begin DoDot:2
+14 SET VPRDA=0
FOR
SET VPRDA=$ORDER(^AUPNVSIT("AET",DFN,VPRDT,VPRLOC,"P",VPRDA))
if VPRDA<1
QUIT
Begin DoDot:3
+15 KILL VPRITM
DO EN1(VPRDA,.VPRITM)
if '$DATA(VPRITM)
QUIT
+16 DO XML(.VPRITM)
SET VPRCNT=VPRCNT+1
End DoDot:3
End DoDot:2
End DoDot:1
if VPRCNT'<MAX
QUIT
ENQ ; end
+1 KILL ^TMP("VPRTEXT",$JOB)
+2 QUIT
+3 ;
ENAA ; -- allow search w/filter
+1 DO IDT
SET VPRCATG=$GET(FILTER("category"))
+2 SET VPRCNT=0
SET IDT=BEG
+3 FOR
SET IDT=$ORDER(^AUPNVSIT("AA",DFN,IDT))
if IDT<1!(IDT>END)
QUIT
Begin DoDot:1
+4 SET VPRDA=0
FOR
SET VPRDA=$ORDER(^AUPNVSIT("AA",DFN,IDT,VPRDA))
if VPRDA<1
QUIT
Begin DoDot:2
+5 IF $LENGTH(VPRCATG)
IF VPRCATG'[$PIECE($GET(^AUPNVSIT(VPRDA,0)),U,7)
QUIT
+6 KILL VPRITM
DO EN1(VPRDA,.VPRITM)
if '$DATA(VPRITM)
QUIT
+7 DO XML(.VPRITM)
SET VPRCNT=VPRCNT+1
End DoDot:2
End DoDot:1
if VPRCNT'<MAX
QUIT
+8 KILL ^TMP("VPRTEXT",$JOB)
+9 QUIT
IDT ; -- invert BEG and END dates for PCE format:
+1 ; IDT=(9999999-$P(VDT,"."))_"."_$P(VDT,".",2)
+2 NEW X
SET X=BEG
+3 SET BEG=(9999999-$PIECE(END,"."))
+4 SET END=(9999999-$PIECE(X,"."))_".2359"
+5 QUIT
+6 ;
EN1(IEN,VST) ; -- return a visit in VST("attribute")=value
+1 NEW X0,X15,X,DATE,FAC,LOC,CATG,INPT,DA
+2 KILL VST,^TMP("VPRTEXT",$JOB)
+3 ;invalid
SET IEN=+$GET(IEN)
if IEN<1
QUIT
+4 DO ENCEVENT^PXAPI(IEN)
+5 SET X0=$GET(^TMP("PXKENC",$JOB,IEN,"VST",IEN,0))
SET X15=$GET(^(150))
+6 ;Q:$P(X15,U,3)'="P" Q:$P(X0,U,7)="E" ;want primary, not historical
+7 IF $PIECE(X0,U,7)="H"
DO ADM(IEN,+X0,.VST)
QUIT
+8 SET VST("id")=IEN
SET VST("dateTime")=+X0
SET DATE=+X0
+9 SET FAC=+$PIECE(X0,U,6)
SET CATG=$PIECE(X0,U,7)
SET LOC=+$PIECE(X0,U,22)
+10 if FAC
SET VST("facility")=$$STA^XUAF4(FAC)_U_$PIECE($$NS^XUAF4(FAC),U)
+11 if 'FAC
SET VST("facility")=$$FAC^VPRD(LOC)
+12 SET VST("serviceCategory")=CATG_U_$$CATG(CATG)
+13 SET VST("visitString")=LOC_";"_DATE_";"_CATG
+14 SET INPT=$PIECE(X15,U,2)
if INPT=""
SET INPT=$SELECT("H^I^R^D"[CATG:1,1:0)
+15 SET X=$$CPT(IEN)
if X
SET VST("type")=$PIECE($$CPT^ICPTCOD(X),U,2,3)
+16 IF 'X
SET VST("type")=U_$SELECT('INPT&LOC:$PIECE($GET(^SC(LOC,0)),U)_" VISIT",1:$$CATG(CATG))
+17 SET VST("patientClass")=$SELECT(INPT:"IMP",1:"AMB")
+18 ;get related mvt# if inpt visit/data
if INPT
SET VST("admission")=$$ADMVT(DATE)
+19 SET X=$PIECE(X0,U,8)
if X
SET VST("stopCode")=$$AMIS(X)
IF LOC
Begin DoDot:1
+20 NEW L0
SET L0=$GET(^SC(LOC,0))
+21 IF 'X
SET VST("stopCode")=$$AMIS($PIECE(L0,U,7))
+22 SET VST("location")=$PIECE(L0,U)
SET VST("service")=$$SERV($PIECE(L0,U,20))
+23 SET X=$PIECE(L0,U,18)
if X
SET VST("creditStopCode")=$$AMIS(X)
End DoDot:1
+24 SET VST("reason")=$$POV(IEN,DATE)
+25 ; provider(s), including taxonomy/specialty info
+26 SET DA=0
FOR
SET DA=$ORDER(^TMP("PXKENC",$JOB,IEN,"PRV",DA))
if DA<1
QUIT
SET X0=$GET(^(DA,0))
Begin DoDot:1
+27 SET VST("provider",DA)=+X0_U_$PIECE($GET(^VA(200,+X0,0)),U)_$SELECT($PIECE(X0,U,4)="P":"^P^1",1:"^S^")_U_$$PROVSPC^VPRD(+X0)
End DoDot:1
+28 ; cpt(s)
+29 SET DA=0
FOR
SET DA=$ORDER(^TMP("PXKENC",$JOB,IEN,"CPT",DA))
if DA<1
QUIT
SET X0=$GET(^(DA,0))
Begin DoDot:1
+30 SET VST("cpt",DA)=$PIECE($$CPT^ICPTCOD(+X0),U,2,3)
End DoDot:1
+31 ; icd(s)
+32 SET DA=0
FOR
SET DA=$ORDER(^TMP("PXKENC",$JOB,IEN,"POV",DA))
if DA<1
QUIT
SET X0=$GET(^(DA,0))
Begin DoDot:1
+33 SET VST("icd",DA)=$$ICD(+X0,DATE)_U_$$EXTERNAL^DILFD(9000010.07,.04,,$PIECE(X0,U,4))_U_$SELECT($LENGTH($PIECE(X0,U,12)):$PIECE(X0,U,12),1:"U")
End DoDot:1
+34 ; note(s)
+35 DO TIU(IEN)
+36 KILL ^TMP("PXKENC",$JOB,IEN)
+37 QUIT
+38 ;
TIU(VISIT) ; -- add notes to VST("document")
+1 NEW X,Y,I,VPRX,LT,NT,DA,CNT,VPRY
+2 DO FIND^DIC(8925,,.01,"QX",+$GET(VISIT),,"V",,,"VPRX")
+3 SET Y=""
SET (I,CNT)=0
+4 FOR
SET I=$ORDER(VPRX("DILIST",1,I))
if I<1
QUIT
Begin DoDot:1
+5 SET DA=$GET(VPRX("DILIST",2,I))
+6 ;draft or retracted
SET Y=$$INFO^VPRDTIU(+DA)
if Y<1
QUIT
+7 SET CNT=CNT+1
SET VST("document",CNT)=Y
+8 if $GET(VPRTEXT)
SET VST("document",CNT,"content")=$$TEXT^VPRDTIU(DA)
End DoDot:1
+9 QUIT
+10 ;
POV(VISIT,VDT) ; -- return the primary Purpose of Visit as ICD^ProviderNarrative
+1 NEW DA,Y,X,X0,ICD
SET Y=""
+2 SET DA=0
FOR
SET DA=$ORDER(^TMP("PXKENC",$JOB,VISIT,"POV",DA))
if DA<1
QUIT
SET X0=$GET(^(DA,0))
IF $PIECE(X0,U,12)="P"
Begin DoDot:1
+3 SET X=+$PIECE(X0,U,4)
SET ICD=$$ICD(+X0,$GET(VDT))
+4 SET Y=ICD_U_$$EXTERNAL^DILFD(9000010.07,.04,,X)
End DoDot:1
if $LENGTH(Y)
QUIT
+5 QUIT Y
+6 ;
ICD(IEN,DATE) ; -- return code^description^system for ICD code, or "^^" if error
+1 NEW X0,VPRX,N,I,X,Y
+2 SET IEN=+$GET(IEN)
SET DATE=+$GET(DATE,DT)
+3 SET Y=$$CODEC^ICDEX(80,IEN)
SET X=$$VLTD^ICDEX(IEN,DATE)
+4 IF $LENGTH(X)
SET Y=Y_U_X
+5 IF '$TEST
SET Y=Y_U_$$VSTD^ICDEX(IEN,DATE)
+6 SET X=$$CSI^ICDEX(80,IEN)
SET $PIECE(Y,U,3)=$$SAB^ICDEX(X)
+7 QUIT Y
+8 ;
CPT(VISIT) ; -- Return CPT code of encounter type
+1 NEW DA,Y,X,X0
SET Y=""
+2 SET DA=0
FOR
SET DA=$ORDER(^TMP("PXKENC",$JOB,VISIT,"CPT",DA))
if DA<1
QUIT
SET X0=$GET(^(DA,0))
Begin DoDot:1
+3 SET X=$PIECE(X0,U)
IF X?1"992"2N
SET Y=X
QUIT
End DoDot:1
if $LENGTH(Y)
QUIT
+4 QUIT Y
+5 ;
AMIS(X) ; -- return the AMIS code^name of Credit Stop X
+1 NEW Y,X0
SET Y=""
+2 SET X0=$GET(^DIC(40.7,+$GET(X),0))
if $LENGTH(X0)
SET Y=$PIECE(X0,U,2)_U_$PIECE(X0,U)
+3 QUIT Y
+4 ;
CATG(X) ; -- Return name of visit Service Category code X
+1 NEW Y
SET Y=""
+2 IF X="A"
SET Y="AMBULATORY"
+3 IF X="H"
SET Y="HOSPITALIZATION"
+4 IF X="I"
SET Y="IN HOSPITAL"
+5 IF X="C"
SET Y="CHART REVIEW"
+6 IF X="T"
SET Y="TELECOMMUNICATIONS"
+7 IF X="N"
SET Y="NOT FOUND"
+8 IF X="S"
SET Y="DAY SURGERY"
+9 IF X="O"
SET Y="OBSERVATION"
+10 IF X="E"
SET Y="EVENT (HISTORICAL)"
+11 IF X="R"
SET Y="NURSING HOME"
+12 IF X="D"
SET Y="DAILY HOSPITALIZATION DATA"
+13 IF X="X"
SET Y="ANCILLARY PACKAGE DAILY DATA"
+14 QUIT Y
+15 ;
SERV(FTS) ; -- Return #42.4 Service for a Facility Treating Specialty
+1 NEW Y
SET Y=""
SET FTS=+$GET(FTS)
+2 SET Y=$$GET1^DIQ(45.7,FTS_",","1:3","E")
+3 QUIT Y
+4 ;
ADMVT(VAINDT) ; -- return movement# for related admission
+1 NEW VADMVT,VAERR
+2 DO ADM^VADPT2
+3 QUIT VADMVT
+4 ;
ADM(IEN,DATE,ADM) ; -- return an admission in ADM("attribute")=value
+1 NEW VAINDT,VADMVT,VAIP,VAIN,VAERR,HLOC,ICD,I
KILL ADM
+2 SET IEN=+$GET(IEN)
SET DATE=+$GET(DATE)
if IEN<1
QUIT
if DATE<1
QUIT
+3 SET VAINDT=DATE
DO ADM^VADPT2
if VADMVT<1
QUIT
+4 ;current inpatient
IF VADMVT=$GET(^DPT(DFN,.105))
DO INPT
QUIT
+5 ;deleted
SET VAIP("E")=VADMVT
DO IN5^VADPT
if '$GET(VAIP(1))
QUIT
+6 SET ADM("id")=IEN
SET ADM("patientClass")="IMP"
SET ADM("admission")=$GET(VAIP(13))
+7 ; ADM("admitType")=$P($G(VAIP(4)),U,2)
+8 SET DATE=+$GET(VAIP(13,1))
SET (ADM("dateTime"),ADM("arrivalDateTime"))=DATE
SET I=0
+9 ;primary
SET X=$GET(VAIP(7))
if X
SET I=I+1
SET ADM("provider",I)=X_"^P^1"_U_$$PROVSPC^VPRD(+X)
+10 ;attending
SET X=$GET(VAIP(18))
if X
SET I=I+1
SET ADM("provider",I)=X_"^A^"_U_$$PROVSPC^VPRD(+X)
+11 SET ADM("specialty")=$PIECE($GET(VAIP(8)),U,2)
+12 SET X=$$SERV(+$GET(VAIP(8)))
SET ADM("service")=X
SET ADM("ptf")=VAIP(12)
+13 ;PTF>ICD
SET ICD=$$POV(IEN,DATE)
if 'ICD
SET ICD=$$PTF(DFN,VAIP(12),DATE)
+14 ;ICD code^description^system^Dx text
SET ADM("reason")=ICD_U_$GET(VAIP(9))
+15 SET HLOC=+$GET(^DIC(42,+$GET(VAIP(5)),44))
+16 if HLOC
SET ADM("location")=$PIECE($GET(^SC(HLOC,0)),U)
+17 SET ADM("facility")=$$FAC^VPRD(+HLOC)
SET ADM("roomBed")=$PIECE(VAIP(6),U,2)
+18 SET ADM("serviceCategory")="H^HOSPITALIZATION"
+19 SET X=$$CPT(IEN)
SET ADM("type")=$SELECT(X:$PIECE($$CPT^ICPTCOD(X),U,2,3),1:U_$$CATG("H"))
+20 IF $GET(VAIP(17))
Begin DoDot:1
+21 SET ADM("departureDateTime")=+$GET(VAIP(17,1))
+22 ; ADM("disposition")=$G(VAIP(17,3)) ;Discharge Mvt Type
End DoDot:1
+23 SET ADM("visitString")=HLOC_";"_DATE_";H"
+24 ;notes/summary
DO TIU(IEN)
+25 QUIT
+26 ;
INPT ; -- return current admission in ADM("attribute")=value [from ADM]
+1 KILL VAINDT
DO INP^VADPT
if $GET(VAIN(1))<1
QUIT
+2 SET ADM("id")=IEN
SET ADM("patientClass")="IMP"
SET ADM("admission")=VAIN(1)
+3 ; ADM("admitType")=$P($G(VAIN(8)),U,2)
+4 SET DATE=+$GET(VAIN(7))
SET (ADM("dateTime"),ADM("arrivalDateTime"))=DATE
SET I=0
+5 ;primary
SET X=$GET(VAIN(2))
if X
SET I=I+1
SET ADM("provider",I)=X_"^P^1"_U_$$PROVSPC^VPRD(+X)
+6 ;attending
SET X=$GET(VAIN(11))
if X
SET I=I+1
SET ADM("provider",I)=X_"^A^"_U_$$PROVSPC^VPRD(+X)
+7 SET ADM("specialty")=$PIECE($GET(VAIN(3)),U,2)
+8 SET X=$$SERV(+$GET(VAIN(3)))
SET ADM("service")=X
SET ADM("ptf")=VAIN(10)
+9 ;PTF>ICD
SET ICD=$$POV(IEN,DATE)
if 'ICD
SET ICD=$$PTF(DFN,VAIN(10),DATE)
+10 ;ICD code^description^system^Dx text
SET ADM("reason")=ICD_U_$GET(VAIN(9))
+11 SET HLOC=+$GET(^DIC(42,+$GET(VAIN(4)),44))
+12 if HLOC
SET ADM("location")=$PIECE($GET(^SC(HLOC,0)),U)
+13 SET ADM("facility")=$$FAC^VPRD(+HLOC)
SET ADM("roomBed")=VAIN(5)
+14 SET ADM("serviceCategory")="H^HOSPITALIZATION"
+15 SET X=$$CPT(IEN)
SET ADM("type")=$SELECT(X:$PIECE($$CPT^ICPTCOD(X),U,2,3),1:U_$$CATG("H"))
+16 ; ADM("visitString")=HLOC_";"_DATE_";H"
+17 ;notes/summary
DO TIU(IEN)
+18 QUIT
+19 ;
PTF(DFN,PTF,DATE) ; -- return ICD code^description^system for a PTF record
+1 NEW VPRPTF,X0,Y
+2 if $GET(PTF)
DO RPC^DGPTFAPI(.VPRPTF,+PTF)
IF $GET(VPRPTF(0))<0
QUIT "^^"
+3 SET Y=$PIECE($GET(VPRPTF(1)),U,3)
SET DATE=+$GET(DATE,DT)
+4 SET X0=$$ICDDX^ICDEX(Y,DATE,,"E")
IF X0<0
QUIT "^^"
+5 ;ICD Code^Dx name
SET Y=$PIECE(X0,U,2)_U_$PIECE(X0,U,4)
+6 ;coding system
SET $PIECE(Y,U,3)=$$SAB^ICDEX($PIECE(X0,U,20))
+7 QUIT Y
+8 ;
ENC(IEN,ENC) ; -- return an encounter in ENC("attribute")=value
+1 NEW X0,DATE,HLOC,TYPE,STS,X,Y
KILL ENC
+2 ;invalid ien
SET IEN=+$GET(IEN)
if IEN<1
QUIT
+3 ;^SCE(IEN,0) node
SET ENC("id")="E"_IEN
SET X0=$$GETOE^SDOE(IEN)
+4 SET DATE=+X0
SET ENC("dateTime")=DATE
+5 SET HLOC=+$PIECE(X0,U,4)
IF HLOC
Begin DoDot:1
+6 SET HLOC=HLOC_U_$PIECE($GET(^SC(HLOC,0)),U)
+7 SET ENC("location")=$PIECE(HLOC,U,2)
+8 SET X=$$GET1^DIQ(44,+HLOC_",",9.5,"I")
+9 IF X
SET ENC("service")=$$SERV(X)
End DoDot:1
+10 SET ENC("facility")=$$FAC^VPRD(+HLOC)
+11 SET STS=$$EXTERNAL^DILFD(409.68,.12,,$PIECE(X0,U,12))
+12 SET X=$SELECT(STS?1"INP".E:"IMP",1:"AMB")
SET ENC("patientClass")=X
SET TYPE=$EXTRACT(X)
+13 SET ENC("type")=U_$SELECT(HLOC:$PIECE(HLOC,U,2)_" VISIT",1:$$CATG(TYPE))
+14 SET ENC("serviceCategory")=TYPE_U_$$CATG(TYPE)
+15 SET ENC("visitString")=+HLOC_";"_DATE_";"_TYPE
+16 QUIT
+17 ;
+18 ; ------------ Return data to middle tier ------------
+19 ;
XML(VISIT) ; -- Return patient visit as XML
+1 NEW ATT,X,Y,NAMES,I,J
+2 DO ADD("<visit>")
SET VPRTOTL=$GET(VPRTOTL)+1
+3 SET ATT=""
FOR
SET ATT=$ORDER(VISIT(ATT))
if ATT=""
QUIT
Begin DoDot:1
+4 ;multiples
IF $ORDER(VISIT(ATT,0))
Begin DoDot:2
+5 DO ADD("<"_ATT_"s>")
+6 SET I=0
FOR
SET I=$ORDER(VISIT(ATT,I))
if I<1
QUIT
Begin DoDot:3
+7 SET X=$GET(VISIT(ATT,I))
SET NAMES=""
+8 IF ATT="document"
SET NAMES="id^localTitle^nationalTitle^vuid^Z"
+9 IF ATT="provider"
SET NAMES="code^name^role^primary^"_$$PROVTAGS^VPRD_"^Z"
+10 IF ATT="cpt"
SET NAMES="code^name^Z"
+11 IF ATT="icd"
SET NAMES="code^name^system^narrative^ranking^Z"
+12 ;_"/>" D ADD(Y)
SET Y="<"_ATT_" "_$$LOOP
+13 SET X=$GET(VISIT(ATT,I,"content"))
IF '$LENGTH(X)
SET Y=Y_"/>"
DO ADD(Y)
QUIT
+14 SET Y=Y_">"
DO ADD(Y)
+15 SET Y="<content xml:space='preserve'>"
DO ADD(Y)
+16 SET J=0
FOR
SET J=$ORDER(@X@(J))
if J<1
QUIT
SET Y=$$ESC^VPRD(@X@(J))
DO ADD(Y)
+17 DO ADD("</content>")
DO ADD("</"_ATT_">")
End DoDot:3
+18 DO ADD("</"_ATT_"s>")
End DoDot:2
SET Y=""
QUIT
+19 SET X=$GET(VISIT(ATT))
SET Y=""
if '$LENGTH(X)
QUIT
+20 SET NAMES="code^name^"_$SELECT(ATT="reason":"system^narrative^",1:"")_"Z"
+21 IF X'["^"
SET Y="<"_ATT_" value='"_$$ESC^VPRD(X)_"' />"
QUIT
+22 IF $LENGTH(X)>1
SET Y="<"_ATT_" "_$$LOOP_"/>"
End DoDot:1
if $LENGTH(Y)
DO ADD(Y)
+23 DO ADD("</visit>")
+24 QUIT
+25 ;
LOOP() ; -- build sub-items string from NAMES and X
+1 NEW STR,P,TAG
SET STR=""
+2 FOR P=1:1
SET TAG=$PIECE(NAMES,U,P)
if TAG="Z"
QUIT
IF $LENGTH($PIECE(X,U,P))
SET STR=STR_TAG_"='"_$$ESC^VPRD($PIECE(X,U,P))_"' "
+3 QUIT STR
+4 ;
ADD(X) ; -- Add a line @VPR@(n)=X
+1 SET VPRI=$GET(VPRI)+1
+2 SET @VPR@(VPRI)=X
+3 QUIT
