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

VPRDJ04A.m

Go to the documentation of this file.
  1. VPRDJ04A ;SLC/MKB -- Admissions,PTF ;7/25/13
  1. ;;1.0;VIRTUAL PATIENT RECORD;**2,5**;Sep 01, 2011;Build 21
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; External References DBIA#
  1. ; ------------------- -----
  1. ; ^AUPNVSIT 2028
  1. ; ^DGPM 1865
  1. ; ^DIC(42 10039
  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. ; VADPT 10061
  1. ; XUAF4 2171
  1. ;
  1. ; All tags expect DFN, ID, [VPRSTART, VPRSTOP, VPRMAX, VPRTEXT]
  1. ;
  1. ADM(ID,DATE) ; -- admission [from VSIT1]
  1. N ADM,VADMVT,VAIP,VAERR,MVT,SPEC,HLOC,FAC,ICD,I
  1. S ID=$G(ID),DATE=+$G(DATE) Q:ID="" ;Q:DATE<1
  1. I ID S VAIP("D")=DATE,VST=+ID
  1. I ID?1"H"1.N S VAIP("E")=+$E(ID,2,99),VST=0
  1. D IN5^VADPT Q:'$G(VAIP(1)) ;deleted
  1. S VADMVT=+$G(VAIP(13)),ID="H"_VADMVT
  1. S ADM("localId")=ID,ADM("uid")=$$SETUID^VPRUTILS("visit",DFN,ID)
  1. S:'DATE DATE=+$G(VAIP(13,1)) S:'VST VST=$$VISIT(DFN,DATE)
  1. S (ADM("dateTime"),ADM("stay","arrivalDateTime"))=$$JSONDT^VPRUTILS(DATE)
  1. S:$L($P(VAIP(6),U,2)) ADM("roomBed")=$P(VAIP(6),U,2)
  1. S MVT=13,I=0 I VADMVT=$G(^DPT(DFN,.105)) D ;if current admission,
  1. . S ADM("current")="true",MVT=14 ; use last movement info
  1. . S X=$G(^DPT(DFN,.101)) S:$L(X) ADM("roomBed")=X
  1. . K VPRADMIT ;kill flag from VPRDJ0
  1. S SPEC=$G(VAIP(MVT,6)),ADM("specialty")=$P(SPEC,U,2)
  1. S X=$$SERV^VPRDVSIT(+SPEC),ADM("service")=X
  1. S HLOC=+$G(^DIC(42,+$G(VAIP(MVT,4)),44)),FAC=$$FAC^VPRD(+HLOC) I HLOC D
  1. . S ADM("locationUid")=$$SETUID^VPRUTILS("location",,+HLOC)
  1. . S ADM("locationName")=$P($G(^SC(HLOC,0)),U)
  1. . S X=$$AMIS^VPRDVSIT($P($G(^SC(HLOC,0)),U,7))
  1. . S:$L($G(X)) ADM("stopCodeUid")="urn:va:stop-code:"_$P(X,U),ADM("stopCodeName")=$P(X,U,2)
  1. . S ADM("summary")="${"_ADM("service")_"}:"_ADM("locationName")
  1. D FACILITY^VPRUTILS(FAC,"ADM")
  1. S ADM("categoryCode")="urn:va:encounter-category:AD",ADM("categoryName")="Admission"
  1. S ADM("patientClassCode")="urn:va:patient-class:IMP",ADM("patientClassName")="Inpatient"
  1. I $G(VAIP(17)) S ADM("stay","dischargeDateTime")=$$JSONDT^VPRUTILS(+$G(VAIP(17,1)))
  1. I $G(VAIP(18)) S I=I+1 D PROV("ADM",I,+VAIP(18),"A") ;attending
  1. I $G(VAIP(MVT,5)) S I=I+1 D PROV("ADM",I,+VAIP(MVT,5),"P",1) ;primary
  1. S ICD=$$POV^VPRDVSIT(VST,DATE) S:'ICD ICD=$$PTF^VPRDVSIT(DFN,VAIP(12),DATE) ;PTF>ICD
  1. I $L(ICD)<3 S ADM("reasonName")=$G(VAIP(MVT,7))
  1. E D
  1. . N SYS S SYS=$P(ICD,U,3),SYS=$$LOW^XLFSTR(SYS)
  1. . S ADM("reasonUid")=$$SETNCS^VPRUTILS(SYS,ICD),ADM("reasonName")=$P(ICD,U,2)
  1. S X=$$CPT^VPRDVSIT(VST),ADM("typeName")=$S(X:$P($$CPT^ICPTCOD(X),U,3),1:$$CATG^VPRDVSIT("H"))
  1. D MVT(VADMVT) ;sub-movements
  1. D TIU(VST,.ADM) ;notes/summary
  1. D ADD^VPRDJ("ADM","visit")
  1. Q
  1. ;
  1. TIU(VISIT,ARR) ; -- add notes to ARR("document")
  1. N X,Y,I,SCR,VPRX,LT,NT,DA,CNT,VPRY
  1. S SCR="I $P(^(0),U,5)>6,$P(^(0),U,5)<14"
  1. D FIND^DIC(8925,,.01,"QX",+$G(VISIT),,"V",SCR,,"VPRX")
  1. S Y="",(I,CNT)=0
  1. F S I=$O(VPRX("DILIST",1,I)) Q:I<1 D
  1. . S LT=$G(VPRX("DILIST","ID",I,.01)) Q:$P(LT," ")="Addendum"
  1. . S DA=$G(VPRX("DILIST",2,I))
  1. . S NT=$$GET1^DIQ(8925,+DA_",",".01:1501")
  1. . S CNT=CNT+1,ARR("documents",CNT,"uid")=$$SETUID^VPRUTILS("document",DFN,+DA)
  1. . S ARR("documents",CNT,"localTitle")=LT
  1. . S:$L(NT) ARR("documents",CNT,"nationalTitle")=NT
  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. MVT(CA) ; -- add movements to ADM("movement",i,"attribute")
  1. N DATE,DA,CNT,X S (DATE,CNT)=0
  1. F S DATE=$O(^DGPM("APCA",DFN,CA,DATE)) Q:DATE<1 S DA=+$O(^(DATE,0)) I DA'=CA D
  1. . S X0=$G(^DGPM(DA,0)),CNT=CNT+1
  1. . S ADM("movements",CNT,"localId")=DA
  1. . S ADM("movements",CNT,"dateTime")=$$JSONDT^VPRUTILS(DATE)
  1. . S ADM("movements",CNT,"movementType")=$$EXTERNAL^DILFD(405,.02,,$P(X0,U,2))
  1. . S X=+$P(X0,U,19) I X D
  1. .. S ADM("movements",CNT,"providerUid")=$$SETUID^VPRUTILS("user",,X)
  1. .. S ADM("movements",CNT,"providerName")=$P($G(^VA(200,X,0)),U)
  1. . S X=+$P(X0,U,9)
  1. . S:X ADM("movements",CNT,"specialty")=$$EXTERNAL^DILFD(405,.09,,X)
  1. . S HLOC=+$G(^DIC(42,+$P(X0,U,6),44)),FAC=$$FAC^VPRD(HLOC) I HLOC D
  1. .. S ADM("movements",CNT,"locationUid")=$$SETUID^VPRUTILS("location",,HLOC)
  1. .. S ADM("movements",CNT,"locationName")=$P($G(^SC(HLOC,0)),U)
  1. Q
  1. ;
  1. PTFA(ID) ; -- find ID in ^TMP("VPRPX",$J), fall thru to PX1 if successful
  1. N IDT S (IDT,VPRIDT)=0
  1. F S IDT=$O(^TMP("VPRPX",$J,IDT)) Q:IDT<1 I $D(^(IDT,ID)) S VPRIDT=IDT Q
  1. Q:VPRIDT<1 ;not found
  1. PTF1 ; -- PTF where ID=iens;TYPE
  1. ; Expects ^TMP("VPRPX",$J,VPRIDT,ID)=ITM^[DISCHARGE]DATE^SYS
  1. N TMP,PTF,ADM,DIS,VAIN,VAINDT,HLOC,FAC,X,Y,VISIT,X0
  1. ; PTF^DGPTPXRM(+ID,.VPRF)
  1. S TMP=$G(^TMP("VPRPX",$J,VPRIDT,ID))
  1. ;
  1. S PTF("localId")=ID,PTF("uid")=$$SETUID^VPRUTILS("ptf",DFN,ID)
  1. S P=$L(ID,";"),TYPE=$P(ID,";",P) S:TYPE="DXLS" PTF("principalDx")="true"
  1. S X=$$ICDDX^ICDEX($P(TMP,U),$P(TMP,U,2),,"E")
  1. S Y=$$LOW^XLFSTR($$SAB^ICDEX($P(X,U,20))) ;coding system
  1. S PTF("icdCode")=$$SETNCS^VPRUTILS(Y,$P(X,U,2)),PTF("icdName")=$P(X,U,4)
  1. S DIS=$P(TMP,U,2) S:DIS VAINDT=DIS-.0001 D INP^VADPT
  1. S ADM=+$G(VAIN(7)),HLOC=+$G(^DIC(42,+$G(VAIN(4)),44))
  1. S:ADM PTF("arrivalDateTime")=$$JSONDT^VPRUTILS(ADM)
  1. S:DIS PTF("dischargeDateTime")=$$JSONDT^VPRUTILS(DIS)
  1. S FAC=$$FAC^VPRD(HLOC)
  1. S VISIT=+$$VISIT(DFN,ADM) I VISIT D
  1. . S PTF("encounterUid")=$$SETUID^VPRUTILS("visit",DFN,VISIT)
  1. . S PTF("encounterName")=$$NAME^VPRDJ04(VISIT) Q:FAC
  1. . S X0=$G(^AUPNVSIT(+VISIT,0)),FAC=+$P(X0,U,6)
  1. . S:FAC X=$$STA^XUAF4(FAC)_U_$P($$NS^XUAF4(FAC),U)
  1. . S:'FAC X=$$FAC^VPRD(+$P(X0,U,22)) ;location
  1. D:FAC FACILITY^VPRUTILS(FAC,"PTF")
  1. D ADD^VPRDJ("PTF","ptf")
  1. Q
  1. ;
  1. VISIT(DFN,DATE) ; -- Return visit# for admission
  1. N X,Y
  1. S X=9999999-$P(DATE,".")_"."_$P(DATE,".",2)
  1. S Y=+$O(^AUPNVSIT("AAH",DFN,X,0))
  1. Q Y