HMPDJ04 ;SLC/MKB,ASMR/RRB,ASF,PB - Appointments,Visits;May 24, 2016 15:21:17
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2,3**;Sep 01, 2011;Build 15
;Per VA Directive 6402, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^DGS(41.1 3796
; ^DIC(42 10039
; ^SC 10040
; ^VA(200 10060
; DIQ 2056
; ICPTCOD 1995
; ENCEVENT^PXKENC 1894 ;DE6363 - JD - 8/23/16
; SDAMA301 4433
; XLFDT 10103
; XUAF4 2171
; EDP(230 6275
; SC( 93
;
; All tags expect DFN, ID, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
Q
;
SDAM1 ; -- appointment ^TMP($J,"SDAMA301",DFN,HMPDT)
N NODE,HLOC,APPT,X,STS,CLS,FAC,SV,PRV
S NODE=$G(^TMP($J,"SDAMA301",DFN,HMPDT))
N $ES,$ET,ERRPAT,ERRMSG
S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
S ERRMSG="A problem occurred converting a record for the appointment domain"
;
S HLOC=$P(NODE,U,2),X="A;"_HMPDT_";"_+HLOC
I $L($G(ID)),$P(ID,";",1,3)'=X Q
S APPT("localId")=X,APPT("uid")=$$SETUID^HMPUTILS("appointment",DFN,X)
S X=$P(NODE,U,10),APPT("typeCode")=$P(X,";"),APPT("typeName")=$P(X,";",2)
S STS=$P(NODE,U,3),CLS=$S($E(STS)="I":"I",1:"O")
S STS=$P($P(NODE,U,22),";",1,2) ;DE4469 - PB - APR 26, 2016 changed from using the SDAMA308 API to using the SDAMA301 Supported API to get appointment status ICR 4433
S APPT("dateTime")=$$JSONDT^HMPUTILS(HMPDT)
S:$L($P(NODE,U,6)) APPT("comment")=$P(NODE,U,6)
S:$P(NODE,U,9) APPT("checkIn")=$$JSONDT^HMPUTILS($P(NODE,U,9))
S:$P(NODE,U,11) APPT("checkOut")=$$JSONDT^HMPUTILS($P(NODE,U,11))
I $L(ID,";")>3 S APPT("reasonName")=$P(ID,";",4),PRV=+$P(ID,";",5) ;from SDAM event
S FAC=$$FAC^HMPD(+HLOC) D FACILITY^HMPUTILS(FAC,"APPT") I HLOC D
. S APPT("locationName")=$P(HLOC,";",2)
. S APPT("locationUid")=$$SETUID^HMPUTILS("location",,+HLOC)
. S X=$$GET1^DIQ(44,(+HLOC)_",",1) S:X]"" APPT("shortLocationName")=X ;DE2818, (#1) ABBREVIATION
. S X=$$AMIS^HMPDVSIT(+$P(NODE,U,13))
. S:$L(X) APPT("stopCodeUid")="urn:va:stop-code:"_$P(X,U),APPT("stopCodeName")=$P(X,U,2)
. S SV=$$GET1^DIQ(44,+HLOC_",",9.5,"I")
. I SV S APPT("service")=$$SERV^HMPDSDAM(SV)
. ;find default provider
. S:'$G(PRV) PRV=+$$GET1^DIQ(44,+HLOC_",",16,"I") I 'PRV D
.. N HMPP,I,FIRST
.. D GETS^DIQ(44,+HLOC_",","2600*","I","HMPP")
.. S FIRST=$O(HMPP(44.1,"")),I=""
.. F S I=$O(HMPP(44.1,I)) Q:I="" I $G(HMPP(44.1,I,.02,"I")) S PRV=$G(HMPP(44.1,I,.01,"I")) Q
.. I 'PRV,FIRST S PRV=$G(HMPP(44.1,FIRST,.01,"I"))
I $G(PRV) S APPT("providers",1,"providerUid")=$$SETUID^HMPUTILS("user",,PRV),APPT("providers",1,"providerName")=$$GET1^DIQ(200,PRV_",",.01) ;DE2818
S APPT("patientClassCode")="urn:va:patient-class:"_$S(CLS="I":"IMP",1:"AMB")
S APPT("patientClassName")=$S(CLS="I":"Inpatient",1:"Ambulatory")
S APPT("categoryCode")="urn:va:encounter-category:OV",APPT("categoryName")="Outpatient Visit"
S APPT("appointmentStatus")=$P(STS,";",2)
S APPT("lastUpdateTime")=$$EN^HMPSTMP("appointment") ;RHL 20150102
S APPT("stampTime")=APPT("lastUpdateTime") ; RHL 20150102
;US6734 - pre-compile metastamp
I $G(HMPMETA) D ADD^HMPMETA("appointment",APPT("uid"),APPT("stampTime")) Q:HMPMETA=1 ;US6734,US11019
D ADD^HMPDJ("APPT","appointment")
Q
;
DGS ; scheduled admissions [from APPOINTM^HMPDJ0]
;DE2818, ^DGS(41.1) references ICR 3796
S HMPA=0 F S HMPA=$O(^DGS(41.1,"B",DFN,HMPA)) Q:HMPA<1 D Q:HMPI'<HMPMAX
. S HMPX=$G(^DGS(41.1,HMPA,0))
. I $L($G(ID)),+$P(ID,";",2)=+$P(HMPX,U,2) D DGS1(HMPA) Q
. Q:$P(HMPX,U,13) Q:$P(HMPX,U,17) ;cancelled or admitted
. S X=$P(HMPX,U,2) Q:X<HMPSTART!(X>HMPSTOP) ;out of date range
. D DGS1(HMPA)
Q
;
DGS1(IFN) ; -- scheduled admission
N ADM,X0,DATE,HLOC,FAC,SV,X
S X0=$G(^DGS(41.1,+$G(IFN),0)) Q:X0="" ;deleted (DE2818, ICR 3796)
;
S DATE=+$P(X0,U,2),HLOC=+$$GET1^DIQ(42,+$P(X0,U,8)_",",.01) ;DE2818, ICR 10039
S X="H;"_DATE,ADM("localId")=X,ADM("uid")=$$SETUID^HMPUTILS("appointment",DFN,X)
S ADM("dateTime")=$$JSONDT^HMPUTILS(DATE)
S FAC=$$FAC^HMPD(+HLOC) D FACILITY^HMPUTILS(FAC,"ADM") I HLOC D
. S HLOC=$$GET1^DIQ(44,(+HLOC)_",",.01) ;DE2818, (#.01) NAME
. S ADM("uid")=ADM("uid")_";"_+HLOC
. S ADM("locationName")=$P(HLOC,";",2)
. S X=$$GET1^DIQ(44,(+HLOC)_",",1) S:X]"" ADM("shortLocationName")=X ;DE2818, (#1) ABBREVIATION
. S ADM("locationUid")=$$SETUID^HMPUTILS("location",,+HLOC)
. S X=$$GET1^DIQ(44,+HLOC_",",8,"I"),X=$$AMIS^HMPDVSIT(X)
. S:$L(X) ADM("stopCodeUid")="urn:va:stop-code:"_$P(X,U),ADM("stopCodeName")=$P(X,U,2)
. S SV=$$GET1^DIQ(44,+HLOC_",",9.5,"I")
. I SV S ADM("service")=$$SERV^HMPDSDAM(SV)
S X=+$P(X0,U,5) I X D
. S ADM("providers",1,"providerUid")=$$SETUID^HMPUTILS("user",,X)
. S ADM("providers",1,"providerName")=$$GET1^DIQ(200,X_",",.01) ;DE2818
S ADM("patientClassCode")="urn:va:patient-class:IMP",ADM("patientClassName")="Inpatient"
S ADM("categoryCode")="urn:va:encounter-category:AD",ADM("categoryName")="Admission"
S ADM("appointmentStatus")=$S($P(X0,U,17):"ADMITTED",$P(X0,U,13):"CANCELLED",1:"SCHEDULED")
S ADM("lastUpdateTime")=$$EN^HMPSTMP("adm") ;RHL 20150102
S ADM("stampTime")=ADM("lastUpdateTime") ; RHL 20150102
;US6734 - pre-compile metastamp
I $G(HMPMETA) D ADD^HMPMETA("appointment",ADM("uid"),ADM("stampTime")) Q:HMPMETA=1 ;US6734,US11019
D ADD^HMPDJ("ADM","appointment")
Q
;
VSIT1(ID) ; -- visit
N VST,X0,X15,X,FAC,LOC,CATG,AMIS,INPT,DA,PS
I $G(ID)?1"H"1.N D ADM^HMPDJ04A(ID) Q
;DE2818, ICR 6275
I $D(^EDP(230,"V",ID)),$L($T(EDP1^HMPDJ04E)) D EDP1^HMPDJ04E(ID) Q
; ENCEVENT^PXAPI(ID)
;
; DE2818, ^AUPNVSIT - ICR 2028
S X0=$G(^AUPNVSIT(ID,0)),X15=$G(^(150)) Q:X0="" ;pjh - quit if visit already deleted
; X0=$G(^TMP("PXKENC",$J,ID,"VST",ID,0)),X15=$G(^(150))
;Q:$P(X15,U,3)'="P" Q:$P(X0,U,7)="E" Q:$P(X0,U,12) ;primary, not historical or child
I $P(X0,U,7)="H" D ADM^HMPDJ04A(ID,+X0) Q
S VST("localId")=ID,VST("uid")=$$SETUID^HMPUTILS("visit",DFN,ID)
S VST("dateTime")=$$JSONDT^HMPUTILS(+X0) ;(#.01) VISIT/ADMIT DATE&TIME
S:$P(X0,U,18) VST("checkOut")=$$JSONDT^HMPUTILS($P(X0,U,18)) ;(#.18) CHECK OUT DATE&TIME
S:$P(X0,U,12) VST("parentUid")=$$SETUID^HMPUTILS("visit",DFN,$P(X0,U,12)) ;(#.12) PARENT VISIT LINK
;(#.06) LOC. OF ENCOUNTER, (#.07) SERVICE CATEGORY, (#.22) HOSPITAL LOCATION
S FAC=+$P(X0,U,6),CATG=$P(X0,U,7),LOC=+$P(X0,U,22)
S:FAC X=$$STA^XUAF4(FAC)_U_$P($$NS^XUAF4(FAC),U)
S:'FAC X=$$FAC^HMPD(LOC) D FACILITY^HMPUTILS(X,"VST")
S X=$S(CATG="H":"AD",CATG="C":"CR",CATG="T":"TC",CATG="N":"U",CATG="R":"NH","D^X"[CATG:"O",1:"OV")
S VST("categoryCode")="urn:va:encounter-category:"_X
S VST("categoryName")=$S(X="AD":"Admission",X="CR":"Chart Review",X="TC":"Phone Contact",X="U":"Unknown",X="NH":"Nursing Home",X="O":"Other",1:"Outpatient Visit")
S INPT=$P(X15,U,2) S:INPT="" INPT=$S("H^I^R^D"[CATG:1,1:0) ;(#15002) PATIENT STATUS IN/OUT
S X=$P(X15,U,3) S:$L(X) VST("encounterType")=X ;(#15003) ENCOUNTER TYPE
S X=$$CPT(ID) S:X VST("typeName")=$P($$CPT^ICPTCOD(X),U,3)
I 'X S VST("typeName")=$S('INPT&LOC:$$GET1^DIQ(44,LOC_",",.01)_" VISIT",1:$$CATG^HMPDVSIT(CATG)) ;DE2818
S VST("patientClassCode")="urn:va:patient-class:"_$S(INPT:"IMP",1:"AMB")
S VST("patientClassName")=$S(INPT:"Inpatient",1:"Ambulatory")
; US12589 - add createdByName field to extract
S X=$$GET1^DIQ(200,$P(X0,U,23)_",",".01") S:$G(X)="" X="UNKNOWN"
S VST("createdByName")=X
;(#.08) DSS ID
S X=$P(X0,U,8) S:X AMIS=$$AMIS^HMPDVSIT(X) I LOC D
. I 'X N AMISARR D GETS^DIQ(44,LOC_",",8,"I","AMISARR","ERR") I $G(AMISARR(44,LOC_",",8,"I"))'="" S X=$G(AMISARR(44,LOC_",",8,"I")),AMIS=$$AMIS^HMPDVSIT(X) ;DE5300 - PB - Jun 30 2015 changed call to get stop code name and number
. S VST("locationUid")=$$SETUID^HMPUTILS("location",,+LOC)
. S X=$$GET1^DIQ(44,LOC_",",1) S:X]"" VST("shortLocationName")=X ;DE2818, (#1) ABBREVIATION
. S VST("locationName")=$$GET1^DIQ(44,LOC_",",.01) ;DE2818, (#.01) NAME
. S VST("locationOos")=$S($$GET1^DIQ(44,LOC_",",50.01,"I"):"true",1:"false") ;DE2818, (#50.01) OCCASION OF SERVICE CLINIC?
. S X=$$SERV^HMPDVSIT($$GET1^DIQ(44,LOC_",",9.5,"I")) S:$L(X) VST("service")=X ;DE2818, (#9.5) TREATING SPECIALTY
S:$D(AMIS) VST("stopCodeUid")="urn:va:stop-code:"_$P(AMIS,U),VST("stopCodeName")=$P(AMIS,U,2)
S X=$$POV(ID) S:$L(X) VST("reasonUid")=$$SETNCS^HMPUTILS("icd",$P(X,U)),VST("reasonName")=$P(X,U,2)
; provider(s), DE2818 - ^AUPNVPRV references - ICR 2316
S DA=0 F S DA=$O(^AUPNVPRV("AD",ID,DA)) Q:DA<1 D
. S X0=$G(^AUPNVPRV(DA,0))
. I $P(X0,U,4)="P" D PROV("VST",DA,+X0,"P",1) Q ;primary
. D:'$D(PS(+X0)) PROV("VST",DA,+X0,"S") ;secondary
. S PS(+X0)="" ; (no duplicates)
K ^TMP("PXKENC",$J,ID)
S VST("lastUpdateTime")=$$EN^HMPSTMP("visit") ;RHL 20150103
S VST("stampTime")=VST("lastUpdateTime") ; RHL 20150103
;US6734 - pre-compile metastamp
I $G(HMPMETA) D ADD^HMPMETA("visit",VST("uid"),VST("stampTime")) Q:HMPMETA=1 ;US6734,US11019
D ADD^HMPDJ("VST","visit")
Q
;
CPT(VISIT) ; -- Return CPT code of encounter type
;DE2818 - Change to use API and not directly access the global
N DA,Y S Y=""
;DE4198 - remove use of ^AUPNVCPT
D ENCEVENT^PXKENC(VISIT,1) ;ICR 1894
S DA=0 F S DA=$O(^TMP("PXKENC",$J,VISIT,"CPT",DA)) Q:DA<1 D Q:$L(Y)
. I +$G(^TMP("PXKENC",$J,VISIT,"CPT",DA,0))?1"992"2N S Y=+$G(^TMP("PXKENC",$J,VISIT,"CPT",DA,0))
Q Y
;
POV(VISIT) ; -- return the primary Purpose of Visit as ICD^ProviderNarrative
N DA,Y,X,X0,ICD S Y=""
;DE2818, ^AUPNVPOV( - ICR 3094
S DA=0 F S DA=$O(^AUPNVPOV("AD",VISIT,DA)) Q:DA<1 D Q:$L(Y)
. S X0=$G(^AUPNVPOV(DA,0)) Q:$P(X0,U,12)'="P"
. S X=+$P(X0,U,4),ICD=$$ICD^HMPDVSIT(+X0)
. S Y=ICD_U_$$EXTERNAL^DILFD(9000010.07,.04,,X)
Q Y
;
PROV(ARR,I,IEN,ROLE,PRIM) ; -- add providers
S @ARR@("providers",I,"providerUid")=$$SETUID^HMPUTILS("user",,+IEN)
S @ARR@("providers",I,"providerName")=$$GET1^DIQ(200,(+IEN)_",",.01) ;DE2818
S @ARR@("providers",I,"role")=ROLE
S:$G(PRIM) @ARR@("providers",I,"primary")="true"
Q
;
NAME(IEN) ; -- Return a string 'name' for the visit
N Y,X0,LOC,DATE
S X0=$G(^AUPNVSIT(+$G(IEN),0)),Y="" ;DE2818, ICR 2028
S DATE=+X0,LOC=+$P(X0,U,22) S:LOC LOC=$$GET1^DIQ(44,LOC_",",.01)_" " ;DE2818
S Y=LOC_$$FMTE^XLFDT(DATE,"1D") ;Mon DD, YYYY
Q Y
;
FAC(IEN) ; -- Return Facility for the visit
Q:'+$G(IEN) ""
N FAC S FAC=+$$GET1^DIQ(9000010,IEN_",",.06,"I")
Q:FAC $$STA^XUAF4(FAC)_U_$P($$NS^XUAF4(FAC),U)
S FAC=+$$GET1^DIQ(9000010,IEN_",",.22,"I")
Q $$FAC^HMPD(FAC)
;
STCODE(IEN) ; -- Return stop code information for the visit Q:'+$G(IEN) ""
Q:'+$G(IEN) ""
N STCODE,LIEN S STCODE=+$$GET1^DIQ(9000010,IEN_",",.08,"I")
Q:STCODE $$AMIS^HMPDVSIT(STCODE)
S LIEN=+$$GET1^DIQ(9000010,IEN_",",.22,"I")
I LIEN S STCODE=+$$GET1^DIQ(44,LIEN_",",8,"I")
Q:STCODE $$AMIS^HMPDVSIT(STCODE)
Q ""
;
STOPCODE(X,Y) ; -- Return stop code info for JSON
S @Y@("stopCodeUid")="urn:va:stop-code:"_$P(X,U)
S @Y@("stopCodeName")=$P(X,U,2)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPDJ04 11295 printed Dec 13, 2024@01:53:19 Page 2
HMPDJ04 ;SLC/MKB,ASMR/RRB,ASF,PB - Appointments,Visits;May 24, 2016 15:21:17
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2,3**;Sep 01, 2011;Build 15
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^DGS(41.1 3796
+7 ; ^DIC(42 10039
+8 ; ^SC 10040
+9 ; ^VA(200 10060
+10 ; DIQ 2056
+11 ; ICPTCOD 1995
+12 ; ENCEVENT^PXKENC 1894 ;DE6363 - JD - 8/23/16
+13 ; SDAMA301 4433
+14 ; XLFDT 10103
+15 ; XUAF4 2171
+16 ; EDP(230 6275
+17 ; SC( 93
+18 ;
+19 ; All tags expect DFN, ID, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
+20 QUIT
+21 ;
SDAM1 ; -- appointment ^TMP($J,"SDAMA301",DFN,HMPDT)
+1 NEW NODE,HLOC,APPT,X,STS,CLS,FAC,SV,PRV
+2 SET NODE=$GET(^TMP($JOB,"SDAMA301",DFN,HMPDT))
+3 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
+4 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+5 SET ERRMSG="A problem occurred converting a record for the appointment domain"
+6 ;
+7 SET HLOC=$PIECE(NODE,U,2)
SET X="A;"_HMPDT_";"_+HLOC
+8 IF $LENGTH($GET(ID))
IF $PIECE(ID,";",1,3)'=X
QUIT
+9 SET APPT("localId")=X
SET APPT("uid")=$$SETUID^HMPUTILS("appointment",DFN,X)
+10 SET X=$PIECE(NODE,U,10)
SET APPT("typeCode")=$PIECE(X,";")
SET APPT("typeName")=$PIECE(X,";",2)
+11 SET STS=$PIECE(NODE,U,3)
SET CLS=$SELECT($EXTRACT(STS)="I":"I",1:"O")
+12 ;DE4469 - PB - APR 26, 2016 changed from using the SDAMA308 API to using the SDAMA301 Supported API to get appointment status ICR 4433
SET STS=$PIECE($PIECE(NODE,U,22),";",1,2)
+13 SET APPT("dateTime")=$$JSONDT^HMPUTILS(HMPDT)
+14 if $LENGTH($PIECE(NODE,U,6))
SET APPT("comment")=$PIECE(NODE,U,6)
+15 if $PIECE(NODE,U,9)
SET APPT("checkIn")=$$JSONDT^HMPUTILS($PIECE(NODE,U,9))
+16 if $PIECE(NODE,U,11)
SET APPT("checkOut")=$$JSONDT^HMPUTILS($PIECE(NODE,U,11))
+17 ;from SDAM event
IF $LENGTH(ID,";")>3
SET APPT("reasonName")=$PIECE(ID,";",4)
SET PRV=+$PIECE(ID,";",5)
+18 SET FAC=$$FAC^HMPD(+HLOC)
DO FACILITY^HMPUTILS(FAC,"APPT")
IF HLOC
Begin DoDot:1
+19 SET APPT("locationName")=$PIECE(HLOC,";",2)
+20 SET APPT("locationUid")=$$SETUID^HMPUTILS("location",,+HLOC)
+21 ;DE2818, (#1) ABBREVIATION
SET X=$$GET1^DIQ(44,(+HLOC)_",",1)
if X]""
SET APPT("shortLocationName")=X
+22 SET X=$$AMIS^HMPDVSIT(+$PIECE(NODE,U,13))
+23 if $LENGTH(X)
SET APPT("stopCodeUid")="urn:va:stop-code:"_$PIECE(X,U)
SET APPT("stopCodeName")=$PIECE(X,U,2)
+24 SET SV=$$GET1^DIQ(44,+HLOC_",",9.5,"I")
+25 IF SV
SET APPT("service")=$$SERV^HMPDSDAM(SV)
+26 ;find default provider
+27 if '$GET(PRV)
SET PRV=+$$GET1^DIQ(44,+HLOC_",",16,"I")
IF 'PRV
Begin DoDot:2
+28 NEW HMPP,I,FIRST
+29 DO GETS^DIQ(44,+HLOC_",","2600*","I","HMPP")
+30 SET FIRST=$ORDER(HMPP(44.1,""))
SET I=""
+31 FOR
SET I=$ORDER(HMPP(44.1,I))
if I=""
QUIT
IF $GET(HMPP(44.1,I,.02,"I"))
SET PRV=$GET(HMPP(44.1,I,.01,"I"))
QUIT
+32 IF 'PRV
IF FIRST
SET PRV=$GET(HMPP(44.1,FIRST,.01,"I"))
End DoDot:2
End DoDot:1
+33 ;DE2818
IF $GET(PRV)
SET APPT("providers",1,"providerUid")=$$SETUID^HMPUTILS("user",,PRV)
SET APPT("providers",1,"providerName")=$$GET1^DIQ(200,PRV_",",.01)
+34 SET APPT("patientClassCode")="urn:va:patient-class:"_$SELECT(CLS="I":"IMP",1:"AMB")
+35 SET APPT("patientClassName")=$SELECT(CLS="I":"Inpatient",1:"Ambulatory")
+36 SET APPT("categoryCode")="urn:va:encounter-category:OV"
SET APPT("categoryName")="Outpatient Visit"
+37 SET APPT("appointmentStatus")=$PIECE(STS,";",2)
+38 ;RHL 20150102
SET APPT("lastUpdateTime")=$$EN^HMPSTMP("appointment")
+39 ; RHL 20150102
SET APPT("stampTime")=APPT("lastUpdateTime")
+40 ;US6734 - pre-compile metastamp
+41 ;US6734,US11019
IF $GET(HMPMETA)
DO ADD^HMPMETA("appointment",APPT("uid"),APPT("stampTime"))
if HMPMETA=1
QUIT
+42 DO ADD^HMPDJ("APPT","appointment")
+43 QUIT
+44 ;
DGS ; scheduled admissions [from APPOINTM^HMPDJ0]
+1 ;DE2818, ^DGS(41.1) references ICR 3796
+2 SET HMPA=0
FOR
SET HMPA=$ORDER(^DGS(41.1,"B",DFN,HMPA))
if HMPA<1
QUIT
Begin DoDot:1
+3 SET HMPX=$GET(^DGS(41.1,HMPA,0))
+4 IF $LENGTH($GET(ID))
IF +$PIECE(ID,";",2)=+$PIECE(HMPX,U,2)
DO DGS1(HMPA)
QUIT
+5 ;cancelled or admitted
if $PIECE(HMPX,U,13)
QUIT
if $PIECE(HMPX,U,17)
QUIT
+6 ;out of date range
SET X=$PIECE(HMPX,U,2)
if X<HMPSTART!(X>HMPSTOP)
QUIT
+7 DO DGS1(HMPA)
End DoDot:1
if HMPI'<HMPMAX
QUIT
+8 QUIT
+9 ;
DGS1(IFN) ; -- scheduled admission
+1 NEW ADM,X0,DATE,HLOC,FAC,SV,X
+2 ;deleted (DE2818, ICR 3796)
SET X0=$GET(^DGS(41.1,+$GET(IFN),0))
if X0=""
QUIT
+3 ;
+4 ;DE2818, ICR 10039
SET DATE=+$PIECE(X0,U,2)
SET HLOC=+$$GET1^DIQ(42,+$PIECE(X0,U,8)_",",.01)
+5 SET X="H;"_DATE
SET ADM("localId")=X
SET ADM("uid")=$$SETUID^HMPUTILS("appointment",DFN,X)
+6 SET ADM("dateTime")=$$JSONDT^HMPUTILS(DATE)
+7 SET FAC=$$FAC^HMPD(+HLOC)
DO FACILITY^HMPUTILS(FAC,"ADM")
IF HLOC
Begin DoDot:1
+8 ;DE2818, (#.01) NAME
SET HLOC=$$GET1^DIQ(44,(+HLOC)_",",.01)
+9 SET ADM("uid")=ADM("uid")_";"_+HLOC
+10 SET ADM("locationName")=$PIECE(HLOC,";",2)
+11 ;DE2818, (#1) ABBREVIATION
SET X=$$GET1^DIQ(44,(+HLOC)_",",1)
if X]""
SET ADM("shortLocationName")=X
+12 SET ADM("locationUid")=$$SETUID^HMPUTILS("location",,+HLOC)
+13 SET X=$$GET1^DIQ(44,+HLOC_",",8,"I")
SET X=$$AMIS^HMPDVSIT(X)
+14 if $LENGTH(X)
SET ADM("stopCodeUid")="urn:va:stop-code:"_$PIECE(X,U)
SET ADM("stopCodeName")=$PIECE(X,U,2)
+15 SET SV=$$GET1^DIQ(44,+HLOC_",",9.5,"I")
+16 IF SV
SET ADM("service")=$$SERV^HMPDSDAM(SV)
End DoDot:1
+17 SET X=+$PIECE(X0,U,5)
IF X
Begin DoDot:1
+18 SET ADM("providers",1,"providerUid")=$$SETUID^HMPUTILS("user",,X)
+19 ;DE2818
SET ADM("providers",1,"providerName")=$$GET1^DIQ(200,X_",",.01)
End DoDot:1
+20 SET ADM("patientClassCode")="urn:va:patient-class:IMP"
SET ADM("patientClassName")="Inpatient"
+21 SET ADM("categoryCode")="urn:va:encounter-category:AD"
SET ADM("categoryName")="Admission"
+22 SET ADM("appointmentStatus")=$SELECT($PIECE(X0,U,17):"ADMITTED",$PIECE(X0,U,13):"CANCELLED",1:"SCHEDULED")
+23 ;RHL 20150102
SET ADM("lastUpdateTime")=$$EN^HMPSTMP("adm")
+24 ; RHL 20150102
SET ADM("stampTime")=ADM("lastUpdateTime")
+25 ;US6734 - pre-compile metastamp
+26 ;US6734,US11019
IF $GET(HMPMETA)
DO ADD^HMPMETA("appointment",ADM("uid"),ADM("stampTime"))
if HMPMETA=1
QUIT
+27 DO ADD^HMPDJ("ADM","appointment")
+28 QUIT
+29 ;
VSIT1(ID) ; -- visit
+1 NEW VST,X0,X15,X,FAC,LOC,CATG,AMIS,INPT,DA,PS
+2 IF $GET(ID)?1"H"1.N
DO ADM^HMPDJ04A(ID)
QUIT
+3 ;DE2818, ICR 6275
+4 IF $DATA(^EDP(230,"V",ID))
IF $LENGTH($TEXT(EDP1^HMPDJ04E))
DO EDP1^HMPDJ04E(ID)
QUIT
+5 ; ENCEVENT^PXAPI(ID)
+6 ;
+7 ; DE2818, ^AUPNVSIT - ICR 2028
+8 ;pjh - quit if visit already deleted
SET X0=$GET(^AUPNVSIT(ID,0))
SET X15=$GET(^(150))
if X0=""
QUIT
+9 ; X0=$G(^TMP("PXKENC",$J,ID,"VST",ID,0)),X15=$G(^(150))
+10 ;Q:$P(X15,U,3)'="P" Q:$P(X0,U,7)="E" Q:$P(X0,U,12) ;primary, not historical or child
+11 IF $PIECE(X0,U,7)="H"
DO ADM^HMPDJ04A(ID,+X0)
QUIT
+12 SET VST("localId")=ID
SET VST("uid")=$$SETUID^HMPUTILS("visit",DFN,ID)
+13 ;(#.01) VISIT/ADMIT DATE&TIME
SET VST("dateTime")=$$JSONDT^HMPUTILS(+X0)
+14 ;(#.18) CHECK OUT DATE&TIME
if $PIECE(X0,U,18)
SET VST("checkOut")=$$JSONDT^HMPUTILS($PIECE(X0,U,18))
+15 ;(#.12) PARENT VISIT LINK
if $PIECE(X0,U,12)
SET VST("parentUid")=$$SETUID^HMPUTILS("visit",DFN,$PIECE(X0,U,12))
+16 ;(#.06) LOC. OF ENCOUNTER, (#.07) SERVICE CATEGORY, (#.22) HOSPITAL LOCATION
+17 SET FAC=+$PIECE(X0,U,6)
SET CATG=$PIECE(X0,U,7)
SET LOC=+$PIECE(X0,U,22)
+18 if FAC
SET X=$$STA^XUAF4(FAC)_U_$PIECE($$NS^XUAF4(FAC),U)
+19 if 'FAC
SET X=$$FAC^HMPD(LOC)
DO FACILITY^HMPUTILS(X,"VST")
+20 SET X=$SELECT(CATG="H":"AD",CATG="C":"CR",CATG="T":"TC",CATG="N":"U",CATG="R":"NH","D^X"[CATG:"O",1:"OV")
+21 SET VST("categoryCode")="urn:va:encounter-category:"_X
+22 SET VST("categoryName")=$SELECT(X="AD":"Admission",X="CR":"Chart Review",X="TC":"Phone Contact",X="U":"Unknown",X="NH":"Nursing Home",X="O":"Other",1:"Outpatient Visit")
+23 ;(#15002) PATIENT STATUS IN/OUT
SET INPT=$PIECE(X15,U,2)
if INPT=""
SET INPT=$SELECT("H^I^R^D"[CATG:1,1:0)
+24 ;(#15003) ENCOUNTER TYPE
SET X=$PIECE(X15,U,3)
if $LENGTH(X)
SET VST("encounterType")=X
+25 SET X=$$CPT(ID)
if X
SET VST("typeName")=$PIECE($$CPT^ICPTCOD(X),U,3)
+26 ;DE2818
IF 'X
SET VST("typeName")=$SELECT('INPT&LOC:$$GET1^DIQ(44,LOC_",",.01)_" VISIT",1:$$CATG^HMPDVSIT(CATG))
+27 SET VST("patientClassCode")="urn:va:patient-class:"_$SELECT(INPT:"IMP",1:"AMB")
+28 SET VST("patientClassName")=$SELECT(INPT:"Inpatient",1:"Ambulatory")
+29 ; US12589 - add createdByName field to extract
+30 SET X=$$GET1^DIQ(200,$PIECE(X0,U,23)_",",".01")
if $GET(X)=""
SET X="UNKNOWN"
+31 SET VST("createdByName")=X
+32 ;(#.08) DSS ID
+33 SET X=$PIECE(X0,U,8)
if X
SET AMIS=$$AMIS^HMPDVSIT(X)
IF LOC
Begin DoDot:1
+34 ;DE5300 - PB - Jun 30 2015 changed call to get stop code name and number
IF 'X
NEW AMISARR
DO GETS^DIQ(44,LOC_",",8,"I","AMISARR","ERR")
IF $GET(AMISARR(44,LOC_",",8,"I"))'=""
SET X=$GET(AMISARR(44,LOC_",",8,"I"))
SET AMIS=$$AMIS^HMPDVSIT(X)
+35 SET VST("locationUid")=$$SETUID^HMPUTILS("location",,+LOC)
+36 ;DE2818, (#1) ABBREVIATION
SET X=$$GET1^DIQ(44,LOC_",",1)
if X]""
SET VST("shortLocationName")=X
+37 ;DE2818, (#.01) NAME
SET VST("locationName")=$$GET1^DIQ(44,LOC_",",.01)
+38 ;DE2818, (#50.01) OCCASION OF SERVICE CLINIC?
SET VST("locationOos")=$SELECT($$GET1^DIQ(44,LOC_",",50.01,"I"):"true",1:"false")
+39 ;DE2818, (#9.5) TREATING SPECIALTY
SET X=$$SERV^HMPDVSIT($$GET1^DIQ(44,LOC_",",9.5,"I"))
if $LENGTH(X)
SET VST("service")=X
End DoDot:1
+40 if $DATA(AMIS)
SET VST("stopCodeUid")="urn:va:stop-code:"_$PIECE(AMIS,U)
SET VST("stopCodeName")=$PIECE(AMIS,U,2)
+41 SET X=$$POV(ID)
if $LENGTH(X)
SET VST("reasonUid")=$$SETNCS^HMPUTILS("icd",$PIECE(X,U))
SET VST("reasonName")=$PIECE(X,U,2)
+42 ; provider(s), DE2818 - ^AUPNVPRV references - ICR 2316
+43 SET DA=0
FOR
SET DA=$ORDER(^AUPNVPRV("AD",ID,DA))
if DA<1
QUIT
Begin DoDot:1
+44 SET X0=$GET(^AUPNVPRV(DA,0))
+45 ;primary
IF $PIECE(X0,U,4)="P"
DO PROV("VST",DA,+X0,"P",1)
QUIT
+46 ;secondary
if '$DATA(PS(+X0))
DO PROV("VST",DA,+X0,"S")
+47 ; (no duplicates)
SET PS(+X0)=""
End DoDot:1
+48 KILL ^TMP("PXKENC",$JOB,ID)
+49 ;RHL 20150103
SET VST("lastUpdateTime")=$$EN^HMPSTMP("visit")
+50 ; RHL 20150103
SET VST("stampTime")=VST("lastUpdateTime")
+51 ;US6734 - pre-compile metastamp
+52 ;US6734,US11019
IF $GET(HMPMETA)
DO ADD^HMPMETA("visit",VST("uid"),VST("stampTime"))
if HMPMETA=1
QUIT
+53 DO ADD^HMPDJ("VST","visit")
+54 QUIT
+55 ;
CPT(VISIT) ; -- Return CPT code of encounter type
+1 ;DE2818 - Change to use API and not directly access the global
+2 NEW DA,Y
SET Y=""
+3 ;DE4198 - remove use of ^AUPNVCPT
+4 ;ICR 1894
DO ENCEVENT^PXKENC(VISIT,1)
+5 SET DA=0
FOR
SET DA=$ORDER(^TMP("PXKENC",$JOB,VISIT,"CPT",DA))
if DA<1
QUIT
Begin DoDot:1
+6 IF +$GET(^TMP("PXKENC",$JOB,VISIT,"CPT",DA,0))?1"992"2N
SET Y=+$GET(^TMP("PXKENC",$JOB,VISIT,"CPT",DA,0))
End DoDot:1
if $LENGTH(Y)
QUIT
+7 QUIT Y
+8 ;
POV(VISIT) ; -- return the primary Purpose of Visit as ICD^ProviderNarrative
+1 NEW DA,Y,X,X0,ICD
SET Y=""
+2 ;DE2818, ^AUPNVPOV( - ICR 3094
+3 SET DA=0
FOR
SET DA=$ORDER(^AUPNVPOV("AD",VISIT,DA))
if DA<1
QUIT
Begin DoDot:1
+4 SET X0=$GET(^AUPNVPOV(DA,0))
if $PIECE(X0,U,12)'="P"
QUIT
+5 SET X=+$PIECE(X0,U,4)
SET ICD=$$ICD^HMPDVSIT(+X0)
+6 SET Y=ICD_U_$$EXTERNAL^DILFD(9000010.07,.04,,X)
End DoDot:1
if $LENGTH(Y)
QUIT
+7 QUIT Y
+8 ;
PROV(ARR,I,IEN,ROLE,PRIM) ; -- add providers
+1 SET @ARR@("providers",I,"providerUid")=$$SETUID^HMPUTILS("user",,+IEN)
+2 ;DE2818
SET @ARR@("providers",I,"providerName")=$$GET1^DIQ(200,(+IEN)_",",.01)
+3 SET @ARR@("providers",I,"role")=ROLE
+4 if $GET(PRIM)
SET @ARR@("providers",I,"primary")="true"
+5 QUIT
+6 ;
NAME(IEN) ; -- Return a string 'name' for the visit
+1 NEW Y,X0,LOC,DATE
+2 ;DE2818, ICR 2028
SET X0=$GET(^AUPNVSIT(+$GET(IEN),0))
SET Y=""
+3 ;DE2818
SET DATE=+X0
SET LOC=+$PIECE(X0,U,22)
if LOC
SET LOC=$$GET1^DIQ(44,LOC_",",.01)_" "
+4 ;Mon DD, YYYY
SET Y=LOC_$$FMTE^XLFDT(DATE,"1D")
+5 QUIT Y
+6 ;
FAC(IEN) ; -- Return Facility for the visit
+1 if '+$GET(IEN)
QUIT ""
+2 NEW FAC
SET FAC=+$$GET1^DIQ(9000010,IEN_",",.06,"I")
+3 if FAC
QUIT $$STA^XUAF4(FAC)_U_$PIECE($$NS^XUAF4(FAC),U)
+4 SET FAC=+$$GET1^DIQ(9000010,IEN_",",.22,"I")
+5 QUIT $$FAC^HMPD(FAC)
+6 ;
STCODE(IEN) ; -- Return stop code information for the visit Q:'+$G(IEN) ""
+1 if '+$GET(IEN)
QUIT ""
+2 NEW STCODE,LIEN
SET STCODE=+$$GET1^DIQ(9000010,IEN_",",.08,"I")
+3 if STCODE
QUIT $$AMIS^HMPDVSIT(STCODE)
+4 SET LIEN=+$$GET1^DIQ(9000010,IEN_",",.22,"I")
+5 IF LIEN
SET STCODE=+$$GET1^DIQ(44,LIEN_",",8,"I")
+6 if STCODE
QUIT $$AMIS^HMPDVSIT(STCODE)
+7 QUIT ""
+8 ;
STOPCODE(X,Y) ; -- Return stop code info for JSON
+1 SET @Y@("stopCodeUid")="urn:va:stop-code:"_$PIECE(X,U)
+2 SET @Y@("stopCodeName")=$PIECE(X,U,2)
+3 QUIT
+4 ;
