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

HMPDVSIT.m

Go to the documentation of this file. 
  1. HMPDVSIT ;SLC/MKB,ASMR/RRB,BL - Visit/Encounter extract;Aug 29, 2016 20:06:27
  1.  ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**3**;Sep 01, 2011;Build 15
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; External References          DBIA#
  1.  ; -------------------          -----
  1.  ; ^AUPNVSIT                     2028
  1.  ; ^DIC(40.7                      557
  1.  ; ^DIC(42                      10039
  1.  ; ^DIC(45.7                     1154
  1.  ; ^DPT(                        10035
  1.  ; ^SC                          10040
  1.  ; ^VA(200                      10060
  1.  ; DGPTFAPI                      3157
  1.  ; DIC                           2051
  1.  ; DILFD                         2055
  1.  ; DIQ                           2056
  1.  ; ICDEX                         5747
  1.  ; ICPTCOD                       1995
  1.  ; PXAPI,^TMP("PXKENC",$J        1894
  1.  ; SDOE                          2546
  1.  ; VADPT                        10061
  1.  ; VADPT2                         325
  1.  ; XUAF4                         2171
  1.  Q
  1.  ; ------------ Get encounter(s) from VistA ------------
  1.  ;
  1. EN(DFN,BEG,END,MAX,ID) ; -- find patient's visits and appointments
  1.  N HMPCNT,HMPITM,HMPDT,HMPLOC,HMPDA
  1.  S DFN=+$G(DFN) I '(DFN>0) D LOGDPT^HMPLOG(DFN) Q  ;DE4496 19 August 2016
  1.  S BEG=$G(BEG,1410101),END=$G(END,4141015),MAX=$G(MAX,9999)
  1.  ;
  1.  ; get one visit
  1.  I $G(ID) D EN1(ID,.HMPITM),XML(.HMPITM) G ENQ
  1.  ;
  1.  ; -- get all visits
  1.  I END,END'["." S END=END_".24" ;assume end of day
  1.  S HMPCNT=0
  1.  ;F  S IDX=$Q(@IDX,-1) Q:DFN'=$P(IDX,",",2)  Q:$P(IDX,",",3)<BEG  I $P(IDX,",",5)["P" D
  1.  S HMPDT=END F  S HMPDT=$O(^AUPNVSIT("AET",DFN,HMPDT),-1)  Q:HMPDT<BEG  D  Q:HMPCNT'<MAX  ;ICR 2028 DE2818 ASF 11/21/15
  1.  . S HMPLOC=0 F  S HMPLOC=$O(^AUPNVSIT("AET",DFN,HMPDT,HMPLOC)) Q:HMPLOC<1  D
  1.  .. S HMPDA=0 F  S HMPDA=$O(^AUPNVSIT("AET",DFN,HMPDT,HMPLOC,"P",HMPDA)) Q:HMPDA<1  D
  1.  ... K HMPITM D EN1(HMPDA,.HMPITM) Q:'$D(HMPITM)
  1.  ... D XML(.HMPITM) S HMPCNT=HMPCNT+1
  1. ENQ ; end
  1.  K ^TMP("HMPTEXT",$J)
  1.  Q
  1.  ;
  1. ENAA(DFN,BEG,END,MAX,ID) ; -- find patient's visits and appointments [AA]
  1.  N IDT,DA,HMPCNT,HMPITM
  1.  S DFN=+$G(DFN) I '(DFN>0) D LOGDPT^HMPLOG(DFN) Q  ;DE4496 19 August 2016
  1.  S BEG=$G(BEG,1410101),END=$G(END,4141015),MAX=$G(MAX,9999)
  1.  I $G(ID) D EN1(ID,.HMPITM),XML(.HMPITM) Q  ;one visit
  1.  D IDT S HMPCNT=0
  1.  S IDT=BEG F  S IDT=$O(^AUPNVSIT("AA",DFN,IDT)) Q:IDT<1!(IDT>END)  D  Q:HMPCNT'<MAX  ;ICR 2028 DE2818 ASF 11/21/15
  1.  . S DA=0 F  S DA=$O(^AUPNVSIT("AA",DFN,IDT,DA)) Q:DA<1  D
  1.  .. K HMPITM D EN1(DA,.HMPITM) Q:'$D(HMPITM)
  1.  .. D XML(.HMPITM) S HMPCNT=HMPCNT+1
  1.  Q
  1. IDT ; -- invert BEG and END dates for visit format:
  1.  ;  IDT=(9999999-$P(VDT,"."))_"."_$P(VDT,".",2)
  1.  N X S X=BEG
  1.  S BEG=(9999999-$P(END,"."))
  1.  S END=(9999999-$P(X,"."))_".2359"
  1.  Q
  1.  ;
  1. EN1(IEN,VST) ; -- return a visit in VST("attribute")=value
  1.  N X0,X15,X,FAC,LOC,CATG,INPT,DA
  1.  K VST,^TMP("HMPTEXT",$J)
  1.  S IEN=+$G(IEN) Q:IEN<1  ;invalid
  1.  D ENCEVENT^PXAPI(IEN)
  1.  S X0=$G(^TMP("PXKENC",$J,IEN,"VST",IEN,0)),X15=$G(^(150))
  1.  Q:$P(X15,U,3)'="P"  Q:$P(X0,U,7)="E"  ;want primary, not historical
  1.  I $P(X0,U,7)="H" D ADM(IEN,+X0,.VST) Q
  1.  S VST("id")=IEN,VST("dateTime")=+X0
  1.  S FAC=+$P(X0,U,6),CATG=$P(X0,U,7),LOC=+$P(X0,U,22)
  1.  S:FAC VST("facility")=$$STA^XUAF4(FAC)_U_$P($$NS^XUAF4(FAC),U)
  1.  S:'FAC VST("facility")=$$FAC^HMPD(LOC)
  1.  S VST("serviceCategory")=CATG_U_$$CATG(CATG)
  1.  S VST("visitString")=LOC_";"_+X0_";"_CATG
  1.  S INPT=$P(X15,U,2) S:INPT="" INPT=$S("H^I^R^D"[CATG:1,1:0)
  1.  S X=$$CPT(IEN) S:X VST("type")=$P($$CPT^ICPTCOD(X),U,2,3)
  1.  I 'X S VST("type")=U_$S('INPT&LOC:$P($G(^SC(LOC,0)),U)_" VISIT",1:$$CATG(CATG)) ;ICR 10040 DE2818 ASF 11/21/15
  1.  S VST("patientClass")=$S(INPT:"IMP",1:"AMB")
  1.  S X=$P(X0,U,8) S:X VST("stopCode")=$$AMIS(X) I LOC D
  1.  . N L0 S L0=$G(^SC(LOC,0)) ;ICR 10040 DE2818 ASF 11/21/15
  1.  . I 'X S VST("stopCode")=$$AMIS($P(L0,U,7))
  1.  . S VST("location")=$P(L0,U),VST("service")=$$SERV($P(L0,U,20))
  1.  . S X=$P(L0,U,18) S:X VST("creditStopCode")=$$AMIS(X)
  1.  S VST("reason")=$$POV(IEN)
  1.  ; provider(s)
  1.  S DA=0 F  S DA=$O(^TMP("PXKENC",$J,IEN,"PRV",DA)) Q:DA<1  S X0=$G(^(DA,0)) D
  1.  . S VST("provider",DA)=+X0_U_$P($G(^VA(200,+X0,0)),U)_$S($P(X0,U,4)="P":"^P^1",1:"^S^") ;ICR 10060 DE2818 ASF 11/21/15
  1.  ; note(s)
  1.  D TIU(IEN)
  1.  K ^TMP("PXKENC",$J,IEN)
  1.  Q
  1.  ;
  1. TIU(VISIT) ; -- add notes to VST("document")
  1.  N X,Y,I,HMPX,LT,NT,DA,CNT,HMPY
  1.  D FIND^DIC(8925,,.01,"QX",+$G(VISIT),,"V",,,"HMPX")
  1.  S Y="",(I,CNT)=0
  1.  F  S I=$O(HMPX("DILIST",1,I)) Q:I<1  D
  1.  . S LT=$G(HMPX("DILIST","ID",I,.01)) Q:$P(LT," ")="Addendum"
  1.  . S DA=$G(HMPX("DILIST",2,I))
  1.  . S NT=$$GET1^DIQ(8925,+DA_",",".01:1501")
  1.  . S CNT=CNT+1,VST("document",CNT)=DA_U_LT_U_NT
  1.  . S:$G(HMPTEXT) VST("document",CNT,"content")=$$TEXT^HMPDTIU(DA)
  1.  Q
  1.  ;
  1. POV(VISIT) ; -- return the primary Purpose of Visit as ICD^ProviderNarrative
  1.  N DA,Y,X,X0,ICD S Y=""
  1.  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)
  1.  . S X=+$P(X0,U,4),ICD=$$ICD(+X0)
  1.  . S Y=ICD_U_$$EXTERNAL^DILFD(9000010.07,.04,,X)
  1.  Q Y
  1.  ;
  1. ICD(IEN) ; -- return code^description for ICD code, or "^" if error
  1.  N X0,HMPX,N,I,X,Y S IEN=+$G(IEN)
  1.  S X0=$$ICDDX^ICDEX(IEN) I X0<0 Q "^"  ;Sep 1, 2016 - PB - DE5033 changed to use new API to get ICD code
  1.  S Y=$P(X0,U,2)_U_$P(X0,U,4)       ;ICD Code^Dx name
  1.  S N=$$ICDD^ICDEX($P(Y,U),"HMPX") ;ICD Description  Sep 1, 2016 - PB - DE5033 changed to use new API to get ICD code
  1.  I N>0,$L($G(HMPX(1))) S $P(Y,U,2)=HMPX(1)
  1.  Q Y
  1.  ;
  1. CPT(VISIT) ; -- Return CPT code of encounter type
  1.  N DA,Y,X,X0 S Y=""
  1.  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)
  1.  . S X=$P(X0,U) I X?1"992"2N S Y=X Q
  1.  Q Y
  1.  ;
  1. AMIS(X) ; -- return the AMIS code^name of Credit Stop X
  1.  N Y,X0 S Y=""
  1.  S X0=$G(^DIC(40.7,+$G(X),0)) S:$L(X0) Y=$P(X0,U,2)_U_$P(X0,U) ;ICR 557 DE2818 ASF 11/21/15
  1.  Q Y
  1.  ;
  1. CATG(X) ; -- Return name of visit Service Category code X
  1.  N Y S Y=""
  1.  I X="A" S Y="AMBULATORY"
  1.  I X="H" S Y="HOSPITALIZATION"
  1.  I X="I" S Y="IN HOSPITAL"
  1.  I X="C" S Y="CHART REVIEW"
  1.  I X="T" S Y="TELECOMMUNICATIONS"
  1.  I X="N" S Y="NOT FOUND"
  1.  I X="S" S Y="DAY SURGERY"
  1.  I X="O" S Y="OBSERVATION"
  1.  I X="E" S Y="EVENT (HISTORICAL)"
  1.  I X="R" S Y="NURSING HOME"
  1.  I X="D" S Y="DAILY HOSPITALIZATION DATA"
  1.  I X="X" S Y="ANCILLARY PACKAGE DAILY DATA"
  1.  Q Y
  1.  ;
  1. SERV(FTS) ; -- Return #42.4 Service for a Facility Treating Specialty
  1.  N Y S Y="",FTS=+$G(FTS)
  1.  S Y=$$GET1^DIQ(45.7,FTS_",","1:3","E")
  1.  Q Y
  1.  ;
  1. ADM(IEN,DATE,ADM) ; -- return an admission in ADM("attribute")=value
  1.  N VAINDT,VADMVT,VAIP,VAIN,VAERR,HLOC,ICD,I K ADM
  1.  S IEN=+$G(IEN),DATE=+$G(DATE) Q:IEN<1  Q:DATE<1
  1.  S VAINDT=DATE D ADM^VADPT2 Q:VADMVT<1
  1.  I VADMVT=$G(^DPT(DFN,.105)) D INPT Q  ;current inpatient ICR 10035 DE2818 ASF 11/21/15
  1.  S VAIP("E")=VADMVT D IN5^VADPT Q:'$G(VAIP(1))  ;deleted
  1.  S ADM("id")=IEN,ADM("patientClass")="IMP"
  1.  ; ADM("admitType")=$P($G(VAIP(4)),U,2)
  1.  S DATE=+$G(VAIP(13,1)),(ADM("dateTime"),ADM("arrivalDateTime"))=DATE,I=0
  1.  S:$G(VAIP(7)) I=I+1,ADM("provider",I)=VAIP(7)_"^P^1" ;primary
  1.  S:$G(VAIP(18)) I=I+1,ADM("provider",I)=VAIP(18)_"^A" ;attending
  1.  S ADM("specialty")=$P($G(VAIP(8)),U,2)
  1.  S X=$$SERV(+$G(VAIP(8))),ADM("service")=X
  1.  S ICD=$$POV(IEN) S:'ICD ICD=$$PTF(DFN,VAIP(12)) ;PTF>ICD
  1.  S ADM("reason")=ICD_U_$G(VAIP(9)) ;ICD code^description^Dx text
  1.  S HLOC=+$G(^DIC(42,+$G(VAIP(5)),44)) ;ICR 10039 DE2818 ASF 11/21/15
  1.  S:HLOC ADM("location")=$P($G(^SC(HLOC,0)),U) ;ICR 10040 DE2818 ASF 11/21/15
  1.  S ADM("facility")=$$FAC^HMPD(+HLOC),ADM("roomBed")=$P(VAIP(6),U,2)
  1.  S ADM("serviceCategory")="H^HOSPITALIZATION"
  1.  S X=$$CPT(IEN),ADM("type")=$S(X:$P($$CPT^ICPTCOD(X),U,2,3),1:U_$$CATG("H"))
  1.  I $G(VAIP(17)) D
  1.  . S ADM("departureDateTime")=+$G(VAIP(17,1))
  1.  . ; ADM("disposition")=$G(VAIP(17,3)) ;Discharge Mvt Type
  1.  S ADM("visitString")=HLOC_";"_DATE_";H"
  1.  D TIU(IEN) ;notes/summary
  1.  Q
  1.  ;
  1. INPT ; -- return current admission in ADM("attribute")=value [from ADM]
  1.  K VAINDT D INP^VADPT Q:VAIN(1)<1
  1.  S ADM("id")=IEN,ADM("patientClass")="IMP"
  1.  ; ADM("admitType")=$P($G(VAIN(8)),U,2)
  1.  S DATE=+$G(VAIN(7)),(ADM("dateTime"),ADM("arrivalDateTime"))=DATE,I=0
  1.  S:$G(VAIN(2)) I=I+1,ADM("provider",I)=VAIN(2)_"^P^1" ;primary
  1.  S:$G(VAIN(11)) I=I+1,ADM("provider",I)=VAIN(11)_"^A" ;attending
  1.  S ADM("specialty")=$P($G(VAIN(3)),U,2)
  1.  S X=$$SERV(+$G(VAIN(3))),ADM("service")=X
  1.  S ICD=$$POV(IEN) S:'ICD ICD=$$PTF(DFN,VAIN(10)) ;PTF>ICD
  1.  S ADM("reason")=ICD_U_$G(VAIN(9)) ;ICD code^description^Dx text
  1.  S HLOC=+$G(^DIC(42,+$G(VAIN(4)),44)) ;ICR 10039 DE2818 ASF 11/21/15
  1.  S:HLOC ADM("location")=$P($G(^SC(HLOC,0)),U) ;ICR 10040 DE2818 ASF 11/21/15
  1.  S ADM("facility")=$$FAC^HMPD(+HLOC),ADM("roomBed")=$P(VAIN(5),U,2)
  1.  S ADM("serviceCategory")="H^HOSPITALIZATION"
  1.  S X=$$CPT(IEN),ADM("type")=$S(X:$P($$CPT^ICPTCOD(X),U,2,3),1:U_$$CATG("H"))
  1.  ; ADM("visitString")=HLOC_";"_DATE_";H"
  1.  D TIU(IEN) ;notes/summary
  1.  Q
  1.  ;
  1. PTF(DFN,PTF) ; -- return ICD code^description for a PTF record
  1.  N HMPPTF,N,HMPX
  1.  D:$G(PTF) RPC^DGPTFAPI(.HMPPTF,+PTF) I $G(HMPPTF(0))<1 Q "^"
  1.  S Y=$P($G(HMPPTF(1)),U,3)_U
  1.  S N=$$ICDD^ICDEX(Y,"HMPX") ;ICD Description Sep 1, 2016 - PB - DE5033 changed to use new API to get ICD code
  1.  I N>0,$L($G(HMPX(1))) S Y=Y_HMPX(1)
  1.  Q Y
  1.  ;
  1. ENC(IEN,ENC) ; -- return an encounter in ENC("attribute")=value
  1.  N X0,DATE,HLOC,TYPE,STS,X,Y K ENC
  1.  S IEN=+$G(IEN) Q:IEN<1  ;invalid ien
  1.  S ENC("id")="E"_IEN,X0=$$GETOE^SDOE(IEN) ;^SCE(IEN,0) node ICR 10040 DE2818 ASF 11/21/15
  1.  S DATE=+X0,ENC("dateTime")=DATE
  1.  S HLOC=+$P(X0,U,4) I HLOC D
  1.  . S HLOC=HLOC_U_$P($G(^SC(HLOC,0)),U) ;ICR 10040 DE2818 ASF 11/21/15
  1.  . S ENC("location")=$P(HLOC,U,2)
  1.  . S X=$$GET1^DIQ(44,+HLOC_",",9.5,"I")
  1.  . I X S ENC("service")=$$SERV(X)
  1.  S ENC("facility")=$$FAC^HMPD(+HLOC)
  1.  S STS=$$EXTERNAL^DILFD(409.68,.12,,$P(X0,U,12))
  1.  S X=$S(STS?1"INP".E:"IMP",1:"AMB"),ENC("patientClass")=X,TYPE=$E(X)
  1.  S ENC("type")=U_$S(HLOC:$P(HLOC,U,2)_" VISIT",1:$$CATG(TYPE))
  1.  S ENC("serviceCategory")=TYPE_U_$$CATG(TYPE)
  1.  S ENC("visitString")=+HLOC_";"_DATE_";"_TYPE
  1.  Q
  1.  ;
  1.  ; ------------ Return data to middle tier ------------
  1.  ;
  1. XML(VISIT) ; -- Return patient visit as XML
  1.  N ATT,X,Y,NAMES,I,J
  1.  D ADD("<visit>") S HMPTOTL=$G(HMPTOTL)+1
  1.  S ATT="" F  S ATT=$O(VISIT(ATT)) Q:ATT=""  D  D:$L(Y) ADD(Y)
  1.  . I $O(VISIT(ATT,0)) D  S Y="" Q  ;multiples
  1.  .. D ADD("<"_ATT_"s>")
  1.  .. S I=0 F  S I=$O(VISIT(ATT,I)) Q:I<1  D
  1.  ... S X=$G(VISIT(ATT,I)),NAMES=""
  1.  ... I ATT="document" S NAMES="id^localTitle^nationalTitle^Z"
  1.  ... I ATT="provider" S NAMES="code^name^role^primary^Z"
  1.  ... S Y="<"_ATT_" "_$$LOOP ;_"/>" D ADD(Y)
  1.  ... S X=$G(VISIT(ATT,I,"content")) I '$L(X) S Y=Y_"/>" D ADD(Y) Q
  1.  ... S Y=Y_">" D ADD(Y)
  1.  ... S Y="<content xml:space='preserve'>" D ADD(Y)
  1.  ... S J=0 F  S J=$O(@X@(J)) Q:J<1  S Y=$$ESC^HMPD(@X@(J)) D ADD(Y)
  1.  ... D ADD("</content>"),ADD("</"_ATT_">")
  1.  .. D ADD("</"_ATT_"s>")
  1.  . S X=$G(VISIT(ATT)),Y="" Q:'$L(X)
  1.  . S NAMES="code^name^"_$S(ATT="reason":"narrative^",1:"")_"Z"
  1.  . I X'["^" S Y="<"_ATT_" value='"_$$ESC^HMPD(X)_"' />" Q
  1.  . I $L(X)>1 S Y="<"_ATT_" "_$$LOOP_"/>"
  1.  D ADD("</visit>")
  1.  Q
  1.  ;
  1. LOOP() ; -- build sub-items string from NAMES and X
  1.  N STR,P,TAG S STR=""
  1.  F P=1:1 S TAG=$P(NAMES,U,P) Q:TAG="Z"  I $L($P(X,U,P)) S STR=STR_TAG_"='"_$$ESC^HMPD($P(X,U,P))_"' "
  1.  Q STR
  1.  ;
  1. ADD(X) ; -- Add a line @HMP@(n)=X
  1.  S HMPI=$G(HMPI)+1
  1.  S @HMP@(HMPI)=X
  1.  Q