- NHINVSIT ;SLC/MKB -- Visit/Encounter extract
- ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
- ;
- ; External References DBIA#
- ; ------------------- -----
- ; ^AUPNVSIT 2028
- ; ^DIC(40.7 557
- ; ^DIC(42 10039
- ; ^SC 10040
- ; ^SCE 2065
- ; ^VA(200 10060
- ; DIC 2051
- ; DIQ 2056
- ; ICDCODE 3990
- ; ICPTCOD 1995
- ; PXAPI,^TMP("PXKENC",$J 1894,1895
- ; VADPT 10061
- ; XUAF4 2171
- ;
- ; ------------ Get encounter(s) from VistA ------------
- ;
- EN(DFN,BEG,END,MAX,ID) ; -- find patient's visits and appointments
- N NHICNT,NHITM,NHDT,NHLOC,NHDA
- S DFN=+$G(DFN) Q:DFN<1
- S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
- ;
- ; get one visit
- I $G(ID) D EN1(ID,.NHITM),XML(.NHITM) Q
- ;
- ; -- get all visits
- I END,END'["." S END=END_".24" ;assume end of day
- S NHICNT=0
- ;F S IDX=$Q(@IDX,-1) Q:DFN'=$P(IDX,",",2) Q:$P(IDX,",",3)<BEG I $P(IDX,",",5)["P" D
- S NHDT=END F S NHDT=$O(^AUPNVSIT("AET",DFN,NHDT),-1) Q:NHDT<BEG D Q:NHICNT'<MAX
- . S NHLOC=0 F S NHLOC=$O(^AUPNVSIT("AET",DFN,NHDT,NHLOC)) Q:NHLOC<1 D
- .. S NHDA=0 F S NHDA=$O(^AUPNVSIT("AET",DFN,NHDT,NHLOC,"P",NHDA)) Q:NHDA<1 D
- ... K NHITM D EN1(NHDA,.NHITM) Q:'$D(NHITM)
- ... D XML(.NHITM) S NHICNT=NHICNT+1
- Q
- ;
- ENAA(DFN,BEG,END,MAX,ID) ; -- find patient's visits and appointments [AA]
- N IDT,DA,NHICNT,NHITM
- S DFN=+$G(DFN) Q:DFN<1
- S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
- I $G(ID) D EN1(ID,.NHITM),XML(.NHITM) Q ;one visit
- D IDT S NHICNT=0
- S IDT=BEG F S IDT=$O(^AUPNVSIT("AA",DFN,IDT)) Q:IDT<1!(IDT>END) D Q:NHICNT'<MAX
- . S DA=0 F S DA=$O(^AUPNVSIT("AA",DFN,IDT,DA)) Q:DA<1 D
- .. K NHITM D EN1(DA,.NHITM) Q:'$D(NHITM)
- .. D XML(.NHITM) S NHICNT=NHICNT+1
- Q
- IDT ; -- invert BEG and END dates for visit 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,FAC,LOC,CATG,INPT,DA
- S IEN=+$G(IEN) Q:IEN<1 ;invalid ien
- 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
- 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 VST("serviceCategory")=CATG_U_$$CATG(CATG)
- S VST("visitString")=LOC_";"_+X0_";"_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 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:'FAC VST("facility")=$$FAC^NHINV(LOC)
- S VST("reason")=$$POV(IEN)
- ; provider(s)
- 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^")
- ; note(s)
- D TIU(IEN)
- K ^TMP("PXKENC",$J,IEN)
- Q
- ;
- TIU(VISIT) ; -- add notes to VST("document")
- N X,Y,I,NHIN,LT,NT,DA,CNT
- D FIND^DIC(8925,,.01,"QX",+$G(VISIT),,"V",,,"NHIN")
- S Y="",(I,CNT)=0
- F S I=$O(NHIN("DILIST",1,I)) Q:I<1 D
- . S LT=$G(NHIN("DILIST","ID",I,.01)) Q:$P(LT," ")="Addendum"
- . S DA=$G(NHIN("DILIST",2,I))
- . S NT=$$GET1^DIQ(8925,+DA_",",".01:1501")
- . S CNT=CNT+1,VST("document",CNT)=DA_U_LT_U_NT
- Q
- ;
- POV(VISIT) ; -- 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)
- . S Y=ICD_U_$$GET1^DIQ(9999999.27,X_",",.01)
- Q Y
- ;
- ICD(IEN) ; -- return code^description for ICD code, or "^" if error
- N X0,NHX,N,I,X,Y S IEN=+$G(IEN)
- S X0=$$ICDDX^ICDCODE(IEN) I X0<0 Q "^"
- S Y=$P(X0,U,2)_U_$P(X0,U,4) ;ICD Code^Dx name
- S N=$$ICDD^ICDCODE($P(Y,U),"NHX") ;ICD Description
- I N>0,$L($G(NHX(1))) S $P(Y,U,2)=NHX(1)
- 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 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
- ;
- ADM(IEN,DATE,ADM) ; -- return an admission in ADM("attribute")=value
- N VAIP,VAERR,HLOC,ICD,I K ADM
- S IEN=+$G(IEN),DATE=+$G(DATE) Q:IEN<1 Q:DATE<1 ;invalid
- S VAIP("D")=DATE D IN5^VADPT Q:'$G(VAIP(1)) ;deleted
- S ADM("id")=IEN,ADM("patientClass")="IMP"
- ; ADM("admitType")=$P($G(VAIP(4)),U,2)
- S DATE=+$G(VAIP(3)),(ADM("dateTime"),ADM("arrivalDateTime"))=DATE,I=0
- S:$G(VAIP(7)) I=I+1,ADM("provider",I)=VAIP(7)_"^P^1" ;primary
- S:$G(VAIP(18)) I=I+1,ADM("provider",I)=VAIP(18)_"^A" ;attending
- S ADM("specialty")=$P($G(VAIP(8)),U,2)
- S X=$$SERV(+$G(VAIP(8))),ADM("service")=X
- S X=$$POV(IEN) S:X ADM("reason")=X_U_$G(VAIP(9)) I 'X D
- . S X=$$GET1^DIQ(405,+VAIP(1)_",",".16:79","I") ;Mvt>PTF>ICD ien
- . I 'X S ADM("reason")=U_U_$G(VAIP(9)) Q ;Dx text
- . S ICD=$$ICD(X),ADM("reason")=ICD_U_$G(VAIP(9))
- S HLOC=+$G(^DIC(42,+$G(VAIP(5)),44))
- S:HLOC ADM("location")=$P($G(^SC(HLOC,0)),U)
- S ADM("facility")=$$FAC^NHINV(+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"
- Q
- ;
- 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=$G(^SCE(IEN,0))
- 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^NHINV(+HLOC)
- S STS=$$GET1^DIQ(409.68,IEN_",",.12,"E")
- 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
- D ADD("<visit>") S NHINTOTL=$G(NHINTOTL)+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^Z"
- ... I ATT="provider" S NAMES="code^name^role^primary^Z"
- ... S Y="<"_ATT_" "_$$LOOP_"/>" D ADD(Y)
- .. D ADD("</"_ATT_"s>")
- . S X=$G(VISIT(ATT)),Y="" Q:'$L(X)
- . S NAMES="code^name^"_$S(ATT="reason":"narrative^",1:"")_"Z"
- . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(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^NHINV($P(X,U,P))_"' "
- Q STR
- ;
- ADD(X) ; -- Add a line @NHIN@(n)=X
- S NHINI=$G(NHINI)+1
- S @NHIN@(NHINI)=X
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNHINVSIT 8610 printed Mar 13, 2025@21:22:29 Page 2
- NHINVSIT ;SLC/MKB -- Visit/Encounter extract
- +1 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
- +2 ;
- +3 ; External References DBIA#
- +4 ; ------------------- -----
- +5 ; ^AUPNVSIT 2028
- +6 ; ^DIC(40.7 557
- +7 ; ^DIC(42 10039
- +8 ; ^SC 10040
- +9 ; ^SCE 2065
- +10 ; ^VA(200 10060
- +11 ; DIC 2051
- +12 ; DIQ 2056
- +13 ; ICDCODE 3990
- +14 ; ICPTCOD 1995
- +15 ; PXAPI,^TMP("PXKENC",$J 1894,1895
- +16 ; VADPT 10061
- +17 ; XUAF4 2171
- +18 ;
- +19 ; ------------ Get encounter(s) from VistA ------------
- +20 ;
- EN(DFN,BEG,END,MAX,ID) ; -- find patient's visits and appointments
- +1 NEW NHICNT,NHITM,NHDT,NHLOC,NHDA
- +2 SET DFN=+$GET(DFN)
- if DFN<1
- QUIT
- +3 SET BEG=$GET(BEG,1410101)
- SET END=$GET(END,9999998)
- SET MAX=$GET(MAX,999999)
- +4 ;
- +5 ; get one visit
- +6 IF $GET(ID)
- DO EN1(ID,.NHITM)
- DO XML(.NHITM)
- QUIT
- +7 ;
- +8 ; -- get all visits
- +9 ;assume end of day
- IF END
- IF END'["."
- SET END=END_".24"
- +10 SET NHICNT=0
- +11 ;F S IDX=$Q(@IDX,-1) Q:DFN'=$P(IDX,",",2) Q:$P(IDX,",",3)<BEG I $P(IDX,",",5)["P" D
- +12 SET NHDT=END
- FOR
- SET NHDT=$ORDER(^AUPNVSIT("AET",DFN,NHDT),-1)
- if NHDT<BEG
- QUIT
- Begin DoDot:1
- +13 SET NHLOC=0
- FOR
- SET NHLOC=$ORDER(^AUPNVSIT("AET",DFN,NHDT,NHLOC))
- if NHLOC<1
- QUIT
- Begin DoDot:2
- +14 SET NHDA=0
- FOR
- SET NHDA=$ORDER(^AUPNVSIT("AET",DFN,NHDT,NHLOC,"P",NHDA))
- if NHDA<1
- QUIT
- Begin DoDot:3
- +15 KILL NHITM
- DO EN1(NHDA,.NHITM)
- if '$DATA(NHITM)
- QUIT
- +16 DO XML(.NHITM)
- SET NHICNT=NHICNT+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- if NHICNT'<MAX
- QUIT
- +17 QUIT
- +18 ;
- ENAA(DFN,BEG,END,MAX,ID) ; -- find patient's visits and appointments [AA]
- +1 NEW IDT,DA,NHICNT,NHITM
- +2 SET DFN=+$GET(DFN)
- if DFN<1
- QUIT
- +3 SET BEG=$GET(BEG,1410101)
- SET END=$GET(END,9999998)
- SET MAX=$GET(MAX,999999)
- +4 ;one visit
- IF $GET(ID)
- DO EN1(ID,.NHITM)
- DO XML(.NHITM)
- QUIT
- +5 DO IDT
- SET NHICNT=0
- +6 SET IDT=BEG
- FOR
- SET IDT=$ORDER(^AUPNVSIT("AA",DFN,IDT))
- if IDT<1!(IDT>END)
- QUIT
- Begin DoDot:1
- +7 SET DA=0
- FOR
- SET DA=$ORDER(^AUPNVSIT("AA",DFN,IDT,DA))
- if DA<1
- QUIT
- Begin DoDot:2
- +8 KILL NHITM
- DO EN1(DA,.NHITM)
- if '$DATA(NHITM)
- QUIT
- +9 DO XML(.NHITM)
- SET NHICNT=NHICNT+1
- End DoDot:2
- End DoDot:1
- if NHICNT'<MAX
- QUIT
- +10 QUIT
- IDT ; -- invert BEG and END dates for visit 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,FAC,LOC,CATG,INPT,DA
- +2 ;invalid ien
- SET IEN=+$GET(IEN)
- if IEN<1
- QUIT
- +3 DO ENCEVENT^PXAPI(IEN)
- +4 SET X0=$GET(^TMP("PXKENC",$JOB,IEN,"VST",IEN,0))
- SET X15=$GET(^(150))
- +5 ;want primary, not historical
- if $PIECE(X15,U,3)'="P"
- QUIT
- if $PIECE(X0,U,7)="E"
- QUIT
- +6 IF $PIECE(X0,U,7)="H"
- DO ADM(IEN,+X0,.VST)
- QUIT
- +7 SET VST("id")=IEN
- SET VST("dateTime")=+X0
- +8 SET FAC=+$PIECE(X0,U,6)
- SET CATG=$PIECE(X0,U,7)
- SET LOC=+$PIECE(X0,U,22)
- +9 if FAC
- SET VST("facility")=$$STA^XUAF4(FAC)_U_$PIECE($$NS^XUAF4(FAC),U)
- +10 SET VST("serviceCategory")=CATG_U_$$CATG(CATG)
- +11 SET VST("visitString")=LOC_";"_+X0_";"_CATG
- +12 SET INPT=$PIECE(X15,U,2)
- if INPT=""
- SET INPT=$SELECT("H^I^R^D"[CATG:1,1:0)
- +13 SET X=$$CPT(IEN)
- if X
- SET VST("type")=$PIECE($$CPT^ICPTCOD(X),U,2,3)
- +14 IF 'X
- SET VST("type")=U_$SELECT('INPT&LOC:$PIECE($GET(^SC(LOC,0)),U)_" VISIT",1:$$CATG(CATG))
- +15 SET VST("patientClass")=$SELECT(INPT:"IMP",1:"AMB")
- +16 SET X=$PIECE(X0,U,8)
- if X
- SET VST("stopCode")=$$AMIS(X)
- IF LOC
- Begin DoDot:1
- +17 NEW L0
- SET L0=$GET(^SC(LOC,0))
- +18 IF 'X
- SET VST("stopCode")=$$AMIS($PIECE(L0,U,7))
- +19 SET VST("location")=$PIECE(L0,U)
- SET VST("service")=$$SERV($PIECE(L0,U,20))
- +20 SET X=$PIECE(L0,U,18)
- if X
- SET VST("creditStopCode")=$$AMIS(X)
- +21 if 'FAC
- SET VST("facility")=$$FAC^NHINV(LOC)
- End DoDot:1
- +22 SET VST("reason")=$$POV(IEN)
- +23 ; provider(s)
- +24 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
- +25 SET VST("provider",DA)=+X0_U_$PIECE($GET(^VA(200,+X0,0)),U)_$SELECT($PIECE(X0,U,4)="P":"^P^1",1:"^S^")
- End DoDot:1
- +26 ; note(s)
- +27 DO TIU(IEN)
- +28 KILL ^TMP("PXKENC",$JOB,IEN)
- +29 QUIT
- +30 ;
- TIU(VISIT) ; -- add notes to VST("document")
- +1 NEW X,Y,I,NHIN,LT,NT,DA,CNT
- +2 DO FIND^DIC(8925,,.01,"QX",+$GET(VISIT),,"V",,,"NHIN")
- +3 SET Y=""
- SET (I,CNT)=0
- +4 FOR
- SET I=$ORDER(NHIN("DILIST",1,I))
- if I<1
- QUIT
- Begin DoDot:1
- +5 SET LT=$GET(NHIN("DILIST","ID",I,.01))
- if $PIECE(LT," ")="Addendum"
- QUIT
- +6 SET DA=$GET(NHIN("DILIST",2,I))
- +7 SET NT=$$GET1^DIQ(8925,+DA_",",".01:1501")
- +8 SET CNT=CNT+1
- SET VST("document",CNT)=DA_U_LT_U_NT
- End DoDot:1
- +9 QUIT
- +10 ;
- POV(VISIT) ; -- 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)
- +4 SET Y=ICD_U_$$GET1^DIQ(9999999.27,X_",",.01)
- End DoDot:1
- if $LENGTH(Y)
- QUIT
- +5 QUIT Y
- +6 ;
- ICD(IEN) ; -- return code^description for ICD code, or "^" if error
- +1 NEW X0,NHX,N,I,X,Y
- SET IEN=+$GET(IEN)
- +2 SET X0=$$ICDDX^ICDCODE(IEN)
- IF X0<0
- QUIT "^"
- +3 ;ICD Code^Dx name
- SET Y=$PIECE(X0,U,2)_U_$PIECE(X0,U,4)
- +4 ;ICD Description
- SET N=$$ICDD^ICDCODE($PIECE(Y,U),"NHX")
- +5 IF N>0
- IF $LENGTH($GET(NHX(1)))
- SET $PIECE(Y,U,2)=NHX(1)
- +6 QUIT Y
- +7 ;
- 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
- 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 ;
- ADM(IEN,DATE,ADM) ; -- return an admission in ADM("attribute")=value
- +1 NEW VAIP,VAERR,HLOC,ICD,I
- KILL ADM
- +2 ;invalid
- SET IEN=+$GET(IEN)
- SET DATE=+$GET(DATE)
- if IEN<1
- QUIT
- if DATE<1
- QUIT
- +3 ;deleted
- SET VAIP("D")=DATE
- DO IN5^VADPT
- if '$GET(VAIP(1))
- QUIT
- +4 SET ADM("id")=IEN
- SET ADM("patientClass")="IMP"
- +5 ; ADM("admitType")=$P($G(VAIP(4)),U,2)
- +6 SET DATE=+$GET(VAIP(3))
- SET (ADM("dateTime"),ADM("arrivalDateTime"))=DATE
- SET I=0
- +7 ;primary
- if $GET(VAIP(7))
- SET I=I+1
- SET ADM("provider",I)=VAIP(7)_"^P^1"
- +8 ;attending
- if $GET(VAIP(18))
- SET I=I+1
- SET ADM("provider",I)=VAIP(18)_"^A"
- +9 SET ADM("specialty")=$PIECE($GET(VAIP(8)),U,2)
- +10 SET X=$$SERV(+$GET(VAIP(8)))
- SET ADM("service")=X
- +11 SET X=$$POV(IEN)
- if X
- SET ADM("reason")=X_U_$GET(VAIP(9))
- IF 'X
- Begin DoDot:1
- +12 ;Mvt>PTF>ICD ien
- SET X=$$GET1^DIQ(405,+VAIP(1)_",",".16:79","I")
- +13 ;Dx text
- IF 'X
- SET ADM("reason")=U_U_$GET(VAIP(9))
- QUIT
- +14 SET ICD=$$ICD(X)
- SET ADM("reason")=ICD_U_$GET(VAIP(9))
- End DoDot:1
- +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^NHINV(+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 QUIT
- +25 ;
- 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 SET ENC("id")="E"_IEN
- SET X0=$GET(^SCE(IEN,0))
- +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^NHINV(+HLOC)
- +11 SET STS=$$GET1^DIQ(409.68,IEN_",",.12,"E")
- +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
- +2 DO ADD("<visit>")
- SET NHINTOTL=$GET(NHINTOTL)+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^Z"
- +9 IF ATT="provider"
- SET NAMES="code^name^role^primary^Z"
- +10 SET Y="<"_ATT_" "_$$LOOP_"/>"
- DO ADD(Y)
- End DoDot:3
- +11 DO ADD("</"_ATT_"s>")
- End DoDot:2
- SET Y=""
- QUIT
- +12 SET X=$GET(VISIT(ATT))
- SET Y=""
- if '$LENGTH(X)
- QUIT
- +13 SET NAMES="code^name^"_$SELECT(ATT="reason":"narrative^",1:"")_"Z"
- +14 IF X'["^"
- SET Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />"
- QUIT
- +15 IF $LENGTH(X)>1
- SET Y="<"_ATT_" "_$$LOOP_"/>"
- End DoDot:1
- if $LENGTH(Y)
- DO ADD(Y)
- +16 DO ADD("</visit>")
- +17 QUIT
- +18 ;
- 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^NHINV($PIECE(X,U,P))_"' "
- +3 QUIT STR
- +4 ;
- ADD(X) ; -- Add a line @NHIN@(n)=X
- +1 SET NHINI=$GET(NHINI)+1
- +2 SET @NHIN@(NHINI)=X
- +3 QUIT