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

VPRDJ04.m

Go to the documentation of this file.
  1. VPRDJ04 ;SLC/MKB -- Appointments,Visits ;6/25/12 16:11
  1. ;;1.0;VIRTUAL PATIENT RECORD;**2,5,7**;Sep 01, 2011;Build 3
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; External References DBIA#
  1. ; ------------------- -----
  1. ; ^AUPNVSIT 2028
  1. ; ^DGS(41.1 3796
  1. ; ^DIC(42 10039
  1. ; ^SC 10040
  1. ; ^VA(200 10060
  1. ; DIQ 2056
  1. ; ICPTCOD 1995
  1. ; PXAPI,^TMP("PXKENC",$J 1894
  1. ; SDAMA301 4433
  1. ; XLFDT 10103
  1. ; XLFSTR 10104
  1. ; XUAF4 2171
  1. ;
  1. ; All tags expect DFN, ID, [VPRSTART, VPRSTOP, VPRMAX, VPRTEXT]
  1. ;
  1. SDAM1 ; -- appointment ^TMP($J,"SDAMA301",DFN,VPRDT)
  1. N NODE,HLOC,APPT,X,STS,CLS,FAC,SV,PRV
  1. S NODE=$G(^TMP($J,"SDAMA301",DFN,VPRDT))
  1. ;
  1. S HLOC=$P(NODE,U,2),X="A;"_VPRDT_";"_+HLOC
  1. I $L($G(ID)),$P(ID,";",1,3)'=X Q
  1. S APPT("localId")=X,APPT("uid")=$$SETUID^VPRUTILS("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 APPT("dateTime")=$$JSONDT^VPRUTILS(VPRDT)
  1. S:$L($P(NODE,U,6)) APPT("comment")=$P(NODE,U,6)
  1. S:$P(NODE,U,9) APPT("checkIn")=$$JSONDT^VPRUTILS($P(NODE,U,9))
  1. S:$P(NODE,U,11) APPT("checkOut")=$$JSONDT^VPRUTILS($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^VPRD(+HLOC) D FACILITY^VPRUTILS(FAC,"APPT") I HLOC D
  1. . S APPT("locationName")=$P(HLOC,";",2)
  1. . S APPT("locationUid")=$$SETUID^VPRUTILS("location",,+HLOC)
  1. . S X=$$AMIS^VPRDVSIT(+$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^VPRDSDAM(SV)
  1. . ;find default provider
  1. . S:'$G(PRV) PRV=+$$GET1^DIQ(44,+HLOC_",",16,"I") I 'PRV D
  1. .. N VPRP,I,FIRST
  1. .. D GETS^DIQ(44,+HLOC_",","2600*","I","VPRP")
  1. .. S FIRST=$O(VPRP(44.1,"")),I=""
  1. .. F S I=$O(VPRP(44.1,I)) Q:I="" I $G(VPRP(44.1,I,.02,"I")) S PRV=$G(VPRP(44.1,I,.01,"I")) Q
  1. .. I 'PRV,FIRST S PRV=$G(VPRP(44.1,FIRST,.01,"I"))
  1. I $G(PRV) S APPT("providers",1,"providerUid")=$$SETUID^VPRUTILS("user",,PRV),APPT("providers",1,"providerName")=$P($G(^VA(200,PRV,0)),U)
  1. I $G(SV) S APPT("summary")="${"_APPT("service")_"}:"_$P(HLOC,";",2)
  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. D ADD^VPRDJ("APPT","appointment")
  1. Q
  1. ;
  1. DGS ; scheduled admissions [from APPOINTM^VPRDJ0]
  1. S VPRA=0 F S VPRA=$O(^DGS(41.1,"B",DFN,VPRA)) Q:VPRA<1 D Q:VPRI'<VPRMAX
  1. . S VPRX=$G(^DGS(41.1,VPRA,0))
  1. . I $L($G(ID)),+$P(ID,";",2)=+$P(VPRX,U,2) D DGS1(VPRA) Q
  1. . Q:$P(VPRX,U,13) Q:$P(VPRX,U,17) ;cancelled or admitted
  1. . S X=$P(VPRX,U,2) Q:X<VPRSTART!(X>VPRSTOP) ;out of date range
  1. . D DGS1(VPRA)
  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
  1. ;
  1. S DATE=+$P(X0,U,2),HLOC=+$G(^DIC(42,+$P(X0,U,8),44))
  1. S X="H;"_DATE,ADM("localId")=X,ADM("uid")=$$SETUID^VPRUTILS("appointment",DFN,X)
  1. S ADM("dateTime")=$$JSONDT^VPRUTILS(DATE)
  1. S FAC=$$FAC^VPRD(+HLOC) D FACILITY^VPRUTILS(FAC,"ADM") I HLOC D
  1. . S HLOC=+HLOC_";"_$P($G(^SC(+HLOC,0)),U)
  1. . S ADM("uid")=ADM("uid")_";"_+HLOC
  1. . S ADM("locationName")=$P(HLOC,";",2)
  1. . S ADM("locationUid")=$$SETUID^VPRUTILS("location",,+HLOC)
  1. . S X=$$GET1^DIQ(44,+HLOC_",",8,"I"),X=$$AMIS^VPRDVSIT(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^VPRDSDAM(SV)
  1. I $G(SV) S ADM("summary")="${"_ADM("service")_"}:"_$P(HLOC,";",2)
  1. S X=+$P(X0,U,5) I X D
  1. . S ADM("providers",1,"providerUid")=$$SETUID^VPRUTILS("user",,X)
  1. . S ADM("providers",1,"providerName")=$P($G(^VA(200,X,0)),U)
  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. D ADD^VPRDJ("ADM","appointment")
  1. Q
  1. ;
  1. VSIT1(ID) ; -- visit
  1. N VST,X0,X15,X,FAC,LOC,CATG,AMIS,INPT,DA
  1. I $G(ID)?1"H"1.N D ADM^VPRDJ04A(ID) Q
  1. D ENCEVENT^PXAPI(ID)
  1. ;
  1. S X0=$G(^TMP("PXKENC",$J,ID,"VST",ID,0)),X15=$G(^(150))
  1. Q:$P(X15,U,3)'="P" Q:$P(X0,U,12) ;Q:$P(X0,U,7)="E" ;primary, not historical or child
  1. I $P(X0,U,7)="H" D ADM^VPRDJ04A(ID,+X0) Q
  1. S VST("localId")=ID,VST("uid")=$$SETUID^VPRUTILS("visit",DFN,ID)
  1. S VST("dateTime")=$$JSONDT^VPRUTILS(+X0)
  1. S:$P(X0,U,18) VST("checkOut")=$$JSONDT^VPRUTILS($P(X0,U,18))
  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^VPRD(LOC) D FACILITY^VPRUTILS(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)
  1. S X=$$CPT^VPRDVSIT(ID) S:X VST("typeName")=$P($$CPT^ICPTCOD(X),U,3)
  1. I 'X S VST("typeName")=$S('INPT&LOC:$P($G(^SC(LOC,0)),U)_" VISIT",1:$$CATG^VPRDVSIT(CATG))
  1. S VST("patientClassCode")="urn:va:patient-class:"_$S(INPT:"IMP",1:"AMB")
  1. S VST("patientClassName")=$S(INPT:"Inpatient",1:"Ambulatory")
  1. S X=$P(X0,U,8) S:X AMIS=$$AMIS^VPRDVSIT(X) I LOC D
  1. . N L0 S L0=$G(^SC(LOC,0))
  1. . I 'X S AMIS=$$AMIS^VPRDVSIT($P(L0,U,7))
  1. . S VST("locationUid")=$$SETUID^VPRUTILS("location",,+LOC)
  1. . S VST("locationName")=$P(L0,U)
  1. . S X=$$SERV^VPRDVSIT($P(L0,U,20)) Q:X=""
  1. . S:$L(X) VST("service")=X,VST("summary")="${"_VST("service")_"}:"_$P(L0,U)
  1. S:$D(AMIS) VST("stopCodeUid")="urn:va:stop-code:"_$P(AMIS,U),VST("stopCodeName")=$P(AMIS,U,2)
  1. S X=$$POV^VPRDVSIT(ID) I $L(X) D
  1. . N SYS S SYS=$P(X,U,3),SYS=$$LOW^XLFSTR(SYS)
  1. . S VST("reasonUid")=$$SETNCS^VPRUTILS(SYS,$P(X,U)),VST("reasonName")=$P(X,U,2)
  1. ; provider(s)
  1. S DA=0 F S DA=$O(^TMP("PXKENC",$J,ID,"PRV",DA)) Q:DA<1 S X0=$G(^(DA,0)) D
  1. . I $P(X0,U,4)="P" D PROV("VST",DA,+X0,"P",1) Q ;primary
  1. . D PROV("VST",DA,+X0,"S") ;secondary
  1. K ^TMP("PXKENC",$J,ID)
  1. ; note(s)
  1. D TIU^VPRDJ04A(ID,.VST)
  1. D ADD^VPRDJ("VST","visit")
  1. Q
  1. ;
  1. PROV(ARR,I,IEN,ROLE,PRIM) ; -- add providers
  1. S @ARR@("providers",I,"providerUid")=$$SETUID^VPRUTILS("user",,+IEN)
  1. S @ARR@("providers",I,"providerName")=$P($G(^VA(200,+IEN,0)),U)
  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=""
  1. S DATE=+X0,LOC=+$P(X0,U,22) S:LOC LOC=$P($G(^SC(LOC,0)),U)_" "
  1. S Y=LOC_$$FMTE^XLFDT(DATE,"1D") ;Mon DD, YYYY
  1. Q Y