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

HMPDJ04.m

Go to the documentation of this file. 
  1. 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
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; External References          DBIA#
  1.  ; -------------------          -----
  1.  ; ^DGS(41.1                     3796
  1.  ; ^DIC(42                      10039
  1.  ; ^SC                          10040
  1.  ; ^VA(200                      10060
  1.  ; DIQ                           2056
  1.  ; ICPTCOD                       1995
  1.  ; ENCEVENT^PXKENC               1894  ;DE6363 - JD - 8/23/16
  1.  ; SDAMA301                      4433
  1.  ; XLFDT                        10103
  1.  ; XUAF4                         2171
  1.  ; EDP(230                       6275
  1.  ; SC(                             93
  1.  ;
  1.  ; All tags expect DFN, ID, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
  1.  Q
  1.  ;
  1. SDAM1 ; -- appointment ^TMP($J,"SDAMA301",DFN,HMPDT)
  1.  N NODE,HLOC,APPT,X,STS,CLS,FAC,SV,PRV
  1.  S NODE=$G(^TMP($J,"SDAMA301",DFN,HMPDT))
  1.  N $ES,$ET,ERRPAT,ERRMSG
  1.  S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
  1.  S ERRMSG="A problem occurred converting a record for the appointment domain"
  1.  ;
  1.  S HLOC=$P(NODE,U,2),X="A;"_HMPDT_";"_+HLOC
  1.  I $L($G(ID)),$P(ID,";",1,3)'=X Q
  1.  S APPT("localId")=X,APPT("uid")=$$SETUID^HMPUTILS("appointment",DFN,X)
  1.  S X=$P(NODE,U,10),APPT("typeCode")=$P(X,";"),APPT("typeName")=$P(X,";",2)
  1.  S STS=$P(NODE,U,3),CLS=$S($E(STS)="I":"I",1:"O")
  1.  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
  1.  S APPT("dateTime")=$$JSONDT^HMPUTILS(HMPDT)
  1.  S:$L($P(NODE,U,6)) APPT("comment")=$P(NODE,U,6)
  1.  S:$P(NODE,U,9) APPT("checkIn")=$$JSONDT^HMPUTILS($P(NODE,U,9))
  1.  S:$P(NODE,U,11) APPT("checkOut")=$$JSONDT^HMPUTILS($P(NODE,U,11))
  1.  I $L(ID,";")>3 S APPT("reasonName")=$P(ID,";",4),PRV=+$P(ID,";",5) ;from SDAM event
  1.  S FAC=$$FAC^HMPD(+HLOC) D FACILITY^HMPUTILS(FAC,"APPT") I HLOC D
  1.  . S APPT("locationName")=$P(HLOC,";",2)
  1.  . S APPT("locationUid")=$$SETUID^HMPUTILS("location",,+HLOC)
  1.  . S X=$$GET1^DIQ(44,(+HLOC)_",",1) S:X]"" APPT("shortLocationName")=X  ;DE2818, (#1) ABBREVIATION
  1.  . S X=$$AMIS^HMPDVSIT(+$P(NODE,U,13))
  1.  . S:$L(X) APPT("stopCodeUid")="urn:va:stop-code:"_$P(X,U),APPT("stopCodeName")=$P(X,U,2)
  1.  . S SV=$$GET1^DIQ(44,+HLOC_",",9.5,"I")
  1.  . I SV S APPT("service")=$$SERV^HMPDSDAM(SV)
  1.  . ;find default provider
  1.  . S:'$G(PRV) PRV=+$$GET1^DIQ(44,+HLOC_",",16,"I") I 'PRV D
  1.  .. N HMPP,I,FIRST
  1.  .. D GETS^DIQ(44,+HLOC_",","2600*","I","HMPP")
  1.  .. S FIRST=$O(HMPP(44.1,"")),I=""
  1.  .. 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
  1.  .. I 'PRV,FIRST S PRV=$G(HMPP(44.1,FIRST,.01,"I"))
  1.  I $G(PRV) S APPT("providers",1,"providerUid")=$$SETUID^HMPUTILS("user",,PRV),APPT("providers",1,"providerName")=$$GET1^DIQ(200,PRV_",",.01)  ;DE2818
  1.  S APPT("patientClassCode")="urn:va:patient-class:"_$S(CLS="I":"IMP",1:"AMB")
  1.  S APPT("patientClassName")=$S(CLS="I":"Inpatient",1:"Ambulatory")
  1.  S APPT("categoryCode")="urn:va:encounter-category:OV",APPT("categoryName")="Outpatient Visit"
  1.  S APPT("appointmentStatus")=$P(STS,";",2)
  1.  S APPT("lastUpdateTime")=$$EN^HMPSTMP("appointment") ;RHL 20150102
  1.  S APPT("stampTime")=APPT("lastUpdateTime") ; RHL 20150102
  1.  ;US6734 - pre-compile metastamp
  1.  I $G(HMPMETA) D ADD^HMPMETA("appointment",APPT("uid"),APPT("stampTime")) Q:HMPMETA=1  ;US6734,US11019
  1.  D ADD^HMPDJ("APPT","appointment")
  1.  Q
  1.  ;
  1. DGS ; scheduled admissions [from APPOINTM^HMPDJ0]
  1.  ;DE2818, ^DGS(41.1) references ICR 3796
  1.  S HMPA=0 F  S HMPA=$O(^DGS(41.1,"B",DFN,HMPA)) Q:HMPA<1  D  Q:HMPI'<HMPMAX
  1.  . S HMPX=$G(^DGS(41.1,HMPA,0))
  1.  . I $L($G(ID)),+$P(ID,";",2)=+$P(HMPX,U,2) D DGS1(HMPA) Q
  1.  . Q:$P(HMPX,U,13)  Q:$P(HMPX,U,17)  ;cancelled or admitted
  1.  . S X=$P(HMPX,U,2) Q:X<HMPSTART!(X>HMPSTOP)  ;out of date range
  1.  . D DGS1(HMPA)
  1.  Q
  1.  ;
  1. DGS1(IFN) ; -- scheduled admission
  1.  N ADM,X0,DATE,HLOC,FAC,SV,X
  1.  S X0=$G(^DGS(41.1,+$G(IFN),0)) Q:X0=""  ;deleted (DE2818, ICR 3796)
  1.  ;
  1.  S DATE=+$P(X0,U,2),HLOC=+$$GET1^DIQ(42,+$P(X0,U,8)_",",.01)  ;DE2818, ICR 10039
  1.  S X="H;"_DATE,ADM("localId")=X,ADM("uid")=$$SETUID^HMPUTILS("appointment",DFN,X)
  1.  S ADM("dateTime")=$$JSONDT^HMPUTILS(DATE)
  1.  S FAC=$$FAC^HMPD(+HLOC) D FACILITY^HMPUTILS(FAC,"ADM") I HLOC D
  1.  . S HLOC=$$GET1^DIQ(44,(+HLOC)_",",.01)  ;DE2818, (#.01) NAME
  1.  . S ADM("uid")=ADM("uid")_";"_+HLOC
  1.  . S ADM("locationName")=$P(HLOC,";",2)
  1.  . S X=$$GET1^DIQ(44,(+HLOC)_",",1)  S:X]"" ADM("shortLocationName")=X  ;DE2818, (#1) ABBREVIATION
  1.  . S ADM("locationUid")=$$SETUID^HMPUTILS("location",,+HLOC)
  1.  . S X=$$GET1^DIQ(44,+HLOC_",",8,"I"),X=$$AMIS^HMPDVSIT(X)
  1.  . S:$L(X) ADM("stopCodeUid")="urn:va:stop-code:"_$P(X,U),ADM("stopCodeName")=$P(X,U,2)
  1.  . S SV=$$GET1^DIQ(44,+HLOC_",",9.5,"I")
  1.  . I SV S ADM("service")=$$SERV^HMPDSDAM(SV)
  1.  S X=+$P(X0,U,5) I X D
  1.  . S ADM("providers",1,"providerUid")=$$SETUID^HMPUTILS("user",,X)
  1.  . S ADM("providers",1,"providerName")=$$GET1^DIQ(200,X_",",.01)  ;DE2818
  1.  S ADM("patientClassCode")="urn:va:patient-class:IMP",ADM("patientClassName")="Inpatient"
  1.  S ADM("categoryCode")="urn:va:encounter-category:AD",ADM("categoryName")="Admission"
  1.  S ADM("appointmentStatus")=$S($P(X0,U,17):"ADMITTED",$P(X0,U,13):"CANCELLED",1:"SCHEDULED")
  1.  S ADM("lastUpdateTime")=$$EN^HMPSTMP("adm") ;RHL 20150102
  1.  S ADM("stampTime")=ADM("lastUpdateTime") ; RHL 20150102
  1.  ;US6734 - pre-compile metastamp
  1.  I $G(HMPMETA) D ADD^HMPMETA("appointment",ADM("uid"),ADM("stampTime")) Q:HMPMETA=1  ;US6734,US11019
  1.  D ADD^HMPDJ("ADM","appointment")
  1.  Q
  1.  ;
  1. VSIT1(ID) ; -- visit
  1.  N VST,X0,X15,X,FAC,LOC,CATG,AMIS,INPT,DA,PS
  1.  I $G(ID)?1"H"1.N D ADM^HMPDJ04A(ID) Q
  1.  ;DE2818, ICR 6275
  1.  I $D(^EDP(230,"V",ID)),$L($T(EDP1^HMPDJ04E)) D EDP1^HMPDJ04E(ID) Q
  1.  ; ENCEVENT^PXAPI(ID)
  1.  ;
  1.  ; DE2818, ^AUPNVSIT - ICR 2028
  1.  S X0=$G(^AUPNVSIT(ID,0)),X15=$G(^(150)) Q:X0=""  ;pjh - quit if visit already deleted
  1.  ; X0=$G(^TMP("PXKENC",$J,ID,"VST",ID,0)),X15=$G(^(150))
  1.  ;Q:$P(X15,U,3)'="P"  Q:$P(X0,U,7)="E"  Q:$P(X0,U,12)  ;primary, not historical or child
  1.  I $P(X0,U,7)="H" D ADM^HMPDJ04A(ID,+X0) Q
  1.  S VST("localId")=ID,VST("uid")=$$SETUID^HMPUTILS("visit",DFN,ID)
  1.  S VST("dateTime")=$$JSONDT^HMPUTILS(+X0)  ;(#.01) VISIT/ADMIT DATE&TIME
  1.  S:$P(X0,U,18) VST("checkOut")=$$JSONDT^HMPUTILS($P(X0,U,18))  ;(#.18) CHECK OUT DATE&TIME
  1.  S:$P(X0,U,12) VST("parentUid")=$$SETUID^HMPUTILS("visit",DFN,$P(X0,U,12))  ;(#.12) PARENT VISIT LINK
  1.  ;(#.06) LOC. OF ENCOUNTER, (#.07) SERVICE CATEGORY, (#.22) HOSPITAL LOCATION
  1.  S FAC=+$P(X0,U,6),CATG=$P(X0,U,7),LOC=+$P(X0,U,22)
  1.  S:FAC X=$$STA^XUAF4(FAC)_U_$P($$NS^XUAF4(FAC),U)
  1.  S:'FAC X=$$FAC^HMPD(LOC) D FACILITY^HMPUTILS(X,"VST")
  1.  S X=$S(CATG="H":"AD",CATG="C":"CR",CATG="T":"TC",CATG="N":"U",CATG="R":"NH","D^X"[CATG:"O",1:"OV")
  1.  S VST("categoryCode")="urn:va:encounter-category:"_X
  1.  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")
  1.  S INPT=$P(X15,U,2) S:INPT="" INPT=$S("H^I^R^D"[CATG:1,1:0)  ;(#15002) PATIENT STATUS IN/OUT
  1.  S X=$P(X15,U,3) S:$L(X) VST("encounterType")=X  ;(#15003) ENCOUNTER TYPE
  1.  S X=$$CPT(ID) S:X VST("typeName")=$P($$CPT^ICPTCOD(X),U,3)
  1.  I 'X S VST("typeName")=$S('INPT&LOC:$$GET1^DIQ(44,LOC_",",.01)_" VISIT",1:$$CATG^HMPDVSIT(CATG))  ;DE2818
  1.  S VST("patientClassCode")="urn:va:patient-class:"_$S(INPT:"IMP",1:"AMB")
  1.  S VST("patientClassName")=$S(INPT:"Inpatient",1:"Ambulatory")
  1.  ; US12589 - add createdByName field to extract
  1.  S X=$$GET1^DIQ(200,$P(X0,U,23)_",",".01") S:$G(X)="" X="UNKNOWN"
  1.  S VST("createdByName")=X
  1.  ;(#.08) DSS ID
  1.  S X=$P(X0,U,8) S:X AMIS=$$AMIS^HMPDVSIT(X) I LOC D
  1.  . 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
  1.  . S VST("locationUid")=$$SETUID^HMPUTILS("location",,+LOC)
  1.  . S X=$$GET1^DIQ(44,LOC_",",1) S:X]"" VST("shortLocationName")=X  ;DE2818, (#1) ABBREVIATION
  1.  . S VST("locationName")=$$GET1^DIQ(44,LOC_",",.01)  ;DE2818, (#.01) NAME
  1.  . S VST("locationOos")=$S($$GET1^DIQ(44,LOC_",",50.01,"I"):"true",1:"false")  ;DE2818, (#50.01) OCCASION OF SERVICE CLINIC?
  1.  . S X=$$SERV^HMPDVSIT($$GET1^DIQ(44,LOC_",",9.5,"I")) S:$L(X) VST("service")=X  ;DE2818, (#9.5) TREATING SPECIALTY
  1.  S:$D(AMIS) VST("stopCodeUid")="urn:va:stop-code:"_$P(AMIS,U),VST("stopCodeName")=$P(AMIS,U,2)
  1.  S X=$$POV(ID) S:$L(X) VST("reasonUid")=$$SETNCS^HMPUTILS("icd",$P(X,U)),VST("reasonName")=$P(X,U,2)
  1.  ; provider(s), DE2818 - ^AUPNVPRV references - ICR 2316
  1.  S DA=0 F  S DA=$O(^AUPNVPRV("AD",ID,DA)) Q:DA<1  D
  1.  . S X0=$G(^AUPNVPRV(DA,0))
  1.  . I $P(X0,U,4)="P" D PROV("VST",DA,+X0,"P",1) Q  ;primary
  1.  . D:'$D(PS(+X0)) PROV("VST",DA,+X0,"S")          ;secondary
  1.  . S PS(+X0)=""                                   ; (no duplicates)
  1.  K ^TMP("PXKENC",$J,ID)
  1.  S VST("lastUpdateTime")=$$EN^HMPSTMP("visit") ;RHL 20150103
  1.  S VST("stampTime")=VST("lastUpdateTime") ; RHL 20150103
  1.  ;US6734 - pre-compile metastamp
  1.  I $G(HMPMETA) D ADD^HMPMETA("visit",VST("uid"),VST("stampTime")) Q:HMPMETA=1  ;US6734,US11019
  1.  D ADD^HMPDJ("VST","visit")
  1.  Q
  1.  ;
  1. CPT(VISIT) ; -- Return CPT code of encounter type
  1.  ;DE2818 - Change to use API and not directly access the global
  1.  N DA,Y S Y=""
  1.  ;DE4198 - remove use of ^AUPNVCPT
  1.  D ENCEVENT^PXKENC(VISIT,1)  ;ICR 1894
  1.  S DA=0 F  S DA=$O(^TMP("PXKENC",$J,VISIT,"CPT",DA)) Q:DA<1  D  Q:$L(Y)
  1.  . I +$G(^TMP("PXKENC",$J,VISIT,"CPT",DA,0))?1"992"2N S Y=+$G(^TMP("PXKENC",$J,VISIT,"CPT",DA,0))
  1.  Q Y
  1.  ;
  1. POV(VISIT) ; -- return the primary Purpose of Visit as ICD^ProviderNarrative
  1.  N DA,Y,X,X0,ICD S Y=""
  1.  ;DE2818, ^AUPNVPOV( - ICR 3094
  1.  S DA=0 F  S DA=$O(^AUPNVPOV("AD",VISIT,DA)) Q:DA<1  D  Q:$L(Y)
  1.  . S X0=$G(^AUPNVPOV(DA,0)) Q:$P(X0,U,12)'="P"
  1.  . S X=+$P(X0,U,4),ICD=$$ICD^HMPDVSIT(+X0)
  1.  . S Y=ICD_U_$$EXTERNAL^DILFD(9000010.07,.04,,X)
  1.  Q Y
  1.  ;
  1. PROV(ARR,I,IEN,ROLE,PRIM) ; -- add providers
  1.  S @ARR@("providers",I,"providerUid")=$$SETUID^HMPUTILS("user",,+IEN)
  1.  S @ARR@("providers",I,"providerName")=$$GET1^DIQ(200,(+IEN)_",",.01)  ;DE2818
  1.  S @ARR@("providers",I,"role")=ROLE
  1.  S:$G(PRIM) @ARR@("providers",I,"primary")="true"
  1.  Q
  1.  ;
  1. NAME(IEN) ; -- Return a string 'name' for the visit
  1.  N Y,X0,LOC,DATE
  1.  S X0=$G(^AUPNVSIT(+$G(IEN),0)),Y=""  ;DE2818, ICR 2028
  1.  S DATE=+X0,LOC=+$P(X0,U,22) S:LOC LOC=$$GET1^DIQ(44,LOC_",",.01)_" "  ;DE2818
  1.  S Y=LOC_$$FMTE^XLFDT(DATE,"1D") ;Mon DD, YYYY
  1.  Q Y
  1.  ;
  1. FAC(IEN)  ; -- Return Facility for the visit
  1.  Q:'+$G(IEN) ""
  1.  N FAC S FAC=+$$GET1^DIQ(9000010,IEN_",",.06,"I")
  1.  Q:FAC $$STA^XUAF4(FAC)_U_$P($$NS^XUAF4(FAC),U)
  1.  S FAC=+$$GET1^DIQ(9000010,IEN_",",.22,"I")
  1.  Q $$FAC^HMPD(FAC)
  1.  ;
  1. STCODE(IEN)  ;  -- Return stop code information for the visit Q:'+$G(IEN) ""
  1.  Q:'+$G(IEN) ""
  1.  N STCODE,LIEN S STCODE=+$$GET1^DIQ(9000010,IEN_",",.08,"I")
  1.  Q:STCODE $$AMIS^HMPDVSIT(STCODE)
  1.  S LIEN=+$$GET1^DIQ(9000010,IEN_",",.22,"I")
  1.  I LIEN S STCODE=+$$GET1^DIQ(44,LIEN_",",8,"I")
  1.  Q:STCODE $$AMIS^HMPDVSIT(STCODE)
  1.  Q ""
  1.  ;
  1. STOPCODE(X,Y)  ;  -- Return stop code info for JSON
  1.  S @Y@("stopCodeUid")="urn:va:stop-code:"_$P(X,U)
  1.  S @Y@("stopCodeName")=$P(X,U,2)
  1.  Q
  1.  ;