- HMPDJ04A ;ASMR/MKB - Admissions,PTF;Nov 12, 2015 16:42:22
- ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
- ;Per VA Directive 6402, this routine should not be modified.
- ;
- ; External References DBIA#
- ; ------------------- -----
- ; ^AUPNVSIT 2028
- ; ^DGPM 1865
- ; ^DIC(42 10039
- ; ^DPT 10035
- ; ^SC 10040
- ; ^VA(200 10060
- ; DGPTFAPI 3157
- ; DIC 2051
- ; DILFD 2055
- ; DIQ 2056
- ; ICDCODE 3990
- ; ICPTCOD 1995
- ; VADPT 10061
- ; XUAF4 2171
- ;
- ; All tags expect DFN, ID, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
- Q
- ;
- ADM(ID,DATE) ; -- admission [from VSIT1]
- N ADM,VADMVT,VAIP,VAERR,MVT,SPEC,HLOC,FAC,ICD,I
- S ID=$G(ID),DATE=+$G(DATE) Q:ID="" ;Q:DATE<1
- I ID S VAIP("D")=DATE,VST=+ID
- I ID?1"H"1.N S VAIP("E")=+$E(ID,2,99),VST=0
- D IN5^VADPT Q:'$G(VAIP(1)) ;deleted
- S VADMVT=+$G(VAIP(13)),ID="H"_VADMVT
- S ADM("localId")=ID,ADM("uid")=$$SETUID^HMPUTILS("visit",DFN,ID)
- S:'DATE DATE=+$G(VAIP(13,1)) S:'VST VST=$$VISIT(DFN,DATE)
- S (ADM("dateTime"),ADM("stay","arrivalDateTime"))=$$JSONDT^HMPUTILS(DATE)
- S:$L($P(VAIP(6),U,2)) ADM("roomBed")=$P(VAIP(6),U,2)
- ;DE2818, (#.105) CURRENT ADMISSION, changed ^DPT to FileMan, ICR 10035
- S MVT=13,I=0 I VADMVT=$$GET1^DIQ(2,DFN_",",.105,"I") D ;if current admission,
- . S ADM("current")="true",MVT=14 ; use last movement info
- . S X=$$GET1^DIQ(2,DFN_",",.101,"I") S:$L(X) ADM("roomBed")=X ;(#.101) ROOM-BED, DE2818
- . K HMPADMIT ;kill flag from HMPDJ0
- S SPEC=$G(VAIP(MVT,6)),ADM("specialty")=$P(SPEC,U,2)
- S X=$$SERV^HMPDVSIT(+SPEC),ADM("service")=X
- ;DE2818, changed from ^DIC(42) to FileMan, ICR 10039
- S HLOC=+$$GET1^DIQ(42,+$G(VAIP(MVT,4))_",",44,"I"),FAC=$$FAC^HMPD(+HLOC) I HLOC D
- . S ADM("locationUid")=$$SETUID^HMPUTILS("location",,+HLOC)
- . ;DE2818 begin, changed ^SC to FileMan, ICR 10040
- . S X=$$GET1^DIQ(44,HLOC_",",1) S:X]"" ADM("shortLocationName")=X ;(#1) ABBREVIATION
- . S ADM("locationName")=$$GET1^DIQ(44,HLOC_",",.01) ;(#.01) NAME
- . S X=$$AMIS^HMPDVSIT($$GET1^DIQ(44,HLOC_",",8,"I")) ;(#8) STOP CODE NUMBER
- . ;DE2818, end
- . S:$L($G(X)) ADM("stopCodeUid")="urn:va:stop-code:"_$P(X,U),ADM("stopCodeName")=$P(X,U,2)
- . S ADM("summary")="${"_ADM("service")_"}:"_ADM("locationName")
- D FACILITY^HMPUTILS(FAC,"ADM")
- S ADM("categoryCode")="urn:va:encounter-category:AD",ADM("categoryName")="Admission"
- S ADM("patientClassCode")="urn:va:patient-class:IMP",ADM("patientClassName")="Inpatient"
- I $G(VAIP(17)) S ADM("stay","dischargeDateTime")=$$JSONDT^HMPUTILS(+$G(VAIP(17,1)))
- I $G(VAIP(18)) S I=I+1 D PROV("ADM",I,+VAIP(18),"A") ;attending
- I $G(VAIP(MVT,5)) S I=I+1 D PROV("ADM",I,+VAIP(MVT,5),"P",1) ;primary
- S ICD=$$POV^HMPDJ04(VST) S:'ICD ICD=$$PTF^HMPDVSIT(DFN,VAIP(12)) ;PTF>ICD
- I $L(ICD)<2 S ADM("reasonName")=$G(VAIP(MVT,7))
- E S ADM("reasonUid")=$$SETNCS^HMPUTILS("icd",ICD),ADM("reasonName")=$P(ICD,U,2)
- S X=$$CPT^HMPDJ04(VST),ADM("typeName")=$S(X:$P($$CPT^ICPTCOD(X),U,3),1:$$CATG^HMPDVSIT("H"))
- D MVT(VADMVT) ;sub-movements
- ; TIU(VST,.ADM) ;notes/summary
- ; Next 2 lines added for visits whose IDs start with an "H". JD - 1/26/15
- 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("visit",ADM("uid"),ADM("stampTime")) Q:HMPMETA=1 ;US6734,US11019
- D ADD^HMPDJ("ADM","visit")
- Q
- ;
- TIU(VISIT,ARR) ; -- add notes to ARR("document")
- N X,Y,I,HMPX,LT,NT,DA,CNT,HMPY
- D FIND^DIC(8925,,.01,"QX",+$G(VISIT),,"V",,,"HMPX")
- S Y="",(I,CNT)=0
- F S I=$O(HMPX("DILIST",1,I)) Q:I<1 D
- . S LT=$G(HMPX("DILIST","ID",I,.01)) Q:$P(LT," ")="Addendum"
- . S DA=$G(HMPX("DILIST",2,I))
- . S NT=$$GET1^DIQ(8925,+DA_",",".01:1501")
- . S CNT=CNT+1,ARR("documents",CNT,"uid")=$$SETUID^HMPUTILS("document",DFN,+DA)
- . S ARR("documents",CNT,"localTitle")=LT
- . S:$L(NT) ARR("documents",CNT,"nationalTitle")=NT
- Q
- ;
- 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, changed ^VA(200) to FileMan ICR 10060
- S @ARR@("providers",I,"role")=ROLE
- S:$G(PRIM) @ARR@("providers",I,"primary")="true"
- Q
- ;
- MVT(CA) ; -- add movements to ADM("movement",i,"attribute")
- N DATE,DA,CNT,X S (DATE,CNT)=0
- ;DE2818, ^DGPM( - ICR 1865
- F S DATE=$O(^DGPM("APCA",DFN,CA,DATE)) Q:DATE<1 S DA=+$O(^(DATE,0)) I DA'=CA D
- . S X0=$G(^DGPM(DA,0)),CNT=CNT+1
- . S ADM("movements",CNT,"localId")=DA
- . S ADM("movements",CNT,"dateTime")=$$JSONDT^HMPUTILS(DATE)
- . S ADM("movements",CNT,"movementType")=$$EXTERNAL^DILFD(405,.02,,$P(X0,U,2))
- . S X=+$P(X0,U,19) I X D
- .. S ADM("movements",CNT,"providerUid")=$$SETUID^HMPUTILS("user",,X)
- .. S ADM("movements",CNT,"providerName")=$$GET1^DIQ(200,X_",",.01) ;DE2818, changed ^VA(200) to FileMan ICR 10060
- . S X=+$P(X0,U,9)
- . S:X ADM("movements",CNT,"specialty")=$$EXTERNAL^DILFD(405,.09,,X)
- . ;DE2818, changed ^DIC(42) to FileMan, ICR 10039
- . S HLOC=+$$GET1^DIQ(42,+$P(X0,U,6)_",",44,"I"),FAC=$$FAC^HMPD(HLOC) I HLOC D
- .. S ADM("movements",CNT,"locationUid")=$$SETUID^HMPUTILS("location",,HLOC)
- .. ;DE2818, changed ^SC to FileMan, ICR 10040
- .. S ADM("movements",CNT,"locationName")=$$GET1^DIQ(44,HLOC_",",.01) ;(#.01) NAME
- Q
- ;
- PTFA(HMPLID) ; -- find ID in ^PXRMINDX(45) and call PTF1 if successful
- ;Purpose - Build ^TMP("HMPPX") from ^PXRMINDX(45,HMPISYS,"PNI",DFN)
- ;
- ;Called by - PTF^HMPDJ0 (if HMPID is set)
- ;
- ;Assumptions -
- ;1. ID is being passed and DFN variable exists
- ;2. ^TMP("HMPPX") does not already exist
- ;
- ;
- ;Modification History -
- ;US5630 (TW) 1. HMPISYS can be either "ICD" (ICD-9) or "10D" (ICD-10)
- ; 2. Namespaced variables and enhanced newing
- ;
- N HMPLEN,HMPTYP,HMPID,HMPISYS,HMPTYP,HMPDX,HMPDT,HMPITEM,HMPRDT,HMPX
- S HMPLEN=$L(HMPLID,";"),HMPTYP=$P(HMPLID,";",HMPLEN),HMPID=$P(HMPLID,";",1,HMPLEN-1)
- ; DE2818, ^PXRMINDX - ICR 4290
- ;Get ICD System from ^PXRMINDX Xref and loop for remaining subscripts
- S HMPISYS="" F S HMPISYS=$O(^PXRMINDX(45,HMPISYS)) Q:HMPISYS="" D
- . I '$D(^PXRMINDX(45,HMPISYS,"PNI",+$G(DFN),HMPTYP)) Q
- . S HMPDX="" F S HMPDX=$O(^PXRMINDX(45,HMPISYS,"PNI",+$G(DFN),HMPTYP,HMPDX)) Q:HMPDX="" D
- .. S HMPDT=0 F S HMPDT=$O(^PXRMINDX(45,HMPISYS,"PNI",+$G(DFN),HMPTYP,HMPDX,HMPDT)) Q:HMPDT="" D
- ... S HMPITEM="" F S HMPITEM=$O(^PXRMINDX(45,HMPISYS,"PNI",+$G(DFN),HMPTYP,HMPDX,HMPDT,HMPITEM)) Q:HMPITEM="" D
- .... I HMPITEM'[HMPID Q
- .... S HMPRDT=9999999-HMPDT
- .... S HMPX=HMPDX_U_HMPDT_U_HMPISYS
- .... S ^TMP("HMPPX",$J,HMPRDT,HMPLID)=HMPX
- Q:'$D(^TMP("HMPPX",$J))
- D PTF1
- K ^TMP("HMPPX",$J)
- Q
- ;
- PTF1 ; Set PTF data into PTF array
- ;Purpose - Get data from ^TMP("HMPPX"), lookup addl PTF, set into PTF array and ^TMP
- ;
- ;Called by - PTFA^HMPDJ04A if HMPID is set, otherwise PTF^HMPDJ0
- ;
- ;Assumptions -
- ;1. HMPLID (local ID) is being passed and DFN,HMPRDT variables exist
- ;2. ^TMP("HMPPX",$J,HMPRDT,ID)=DxCode^[Discharge]Date exists
- ;
- ;Modification History -
- ;US5630 (TW)- HMPISYS can be either "ICD9" or "10D" (ICD-10)
- ;
- N HMPTMP,PTF,HMPP,HMPTYP,HMPDIS,VAIN,HMPADM,VAINDT,HMPLOC,HMPFAC,HMPX,HMPISYS
- S HMPTMP=$G(^TMP("HMPPX",$J,HMPRDT,HMPLID))
- S PTF("localId")=HMPLID
- S PTF("uid")=$$SETUID^HMPUTILS("ptf",DFN,HMPLID)
- S HMPP=$L(HMPLID,";")
- S HMPTYP=$P(HMPLID,";",HMPP)
- I HMPTYP="DXLS" S PTF("principalDx")="true" ; Is this the principal dx?
- I $P(HMPTYP," ")="M" Q ; Quit if movement dx
- S HMPDIS=$P(HMPTMP,U,2)
- I HMPDIS S VAINDT=HMPDIS-.0001
- D INP^VADPT ; Get inpatient VAIN array
- I '$G(VAIN(1)) Q ; Quit if not inpatient
- ;US5630 - TW - Extract Calculated DRG for PTF
- S PTF("drg")=$$GET1^DIQ(45,+HMPLID_",",9,"")
- S PTF("admissionUid")=$$SETUID^HMPUTILS("visit",DFN,"H"_VAIN(1))
- S HMPADM=+$G(VAIN(7)) ; Admission date
- ;DE2818, changed from ^DIC(42) to FileMan, ICR 10039
- S HMPLOC=+$$GET1^DIQ(42,+$G(VAIN(4))_",",44,"I") ; Get location
- S:HMPADM PTF("arrivalDateTime")=$$JSONDT^HMPUTILS(HMPADM)
- S:HMPDIS PTF("dischargeDateTime")=$$JSONDT^HMPUTILS(HMPDIS)
- S HMPFAC=$$FAC^HMPD(HMPLOC) D:HMPFAC FACILITY^HMPUTILS(HMPFAC,"PTF")
- S PTF("lastUpdateTime")=$$EN^HMPSTMP("ptf") ;RHL 20150102
- S PTF("stampTime")=PTF("lastUpdateTime") ; RHL 20150102
- ;US5630 - TW - Check for ICD Coding System
- S HMPDX=$P(HMPTMP,U)
- S HMPISYS=$P(HMPTMP,U,3)
- S HMPISYS=$S(HMPISYS="ICD":1,"ICP":2,"10D":30,"10P":31,1:1) ; Identify ICD coding system for correct lookup
- S HMPX=$$ICDDX^ICDEX(HMPDX,"",HMPISYS)
- S PTF("icdCode")=$$SETNCS^HMPUTILS("icd",$P(HMPX,U,2))
- S PTF("icdName")=$P(HMPX,U,4)
- ;US6734 - pre-compile metastamp
- I $G(HMPMETA) D ADD^HMPMETA("ptf",PTF("uid"),PTF("stampTime")) Q:HMPMETA=1 ;US6734,US11019
- D ADD^HMPDJ("PTF","ptf")
- Q
- ;
- VISIT(DFN,DATE) ; -- Return visit# for admission
- N X,Y
- S X=9999999-$P(DATE,".")_"."_$P(DATE,".",2)
- S Y=+$O(^AUPNVSIT("AAH",DFN,X,0)) ;DE2818, ICR 2028
- Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPDJ04A 9340 printed Feb 18, 2025@23:19:42 Page 2
- HMPDJ04A ;ASMR/MKB - Admissions,PTF;Nov 12, 2015 16:42:22
- +1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; External References DBIA#
- +5 ; ------------------- -----
- +6 ; ^AUPNVSIT 2028
- +7 ; ^DGPM 1865
- +8 ; ^DIC(42 10039
- +9 ; ^DPT 10035
- +10 ; ^SC 10040
- +11 ; ^VA(200 10060
- +12 ; DGPTFAPI 3157
- +13 ; DIC 2051
- +14 ; DILFD 2055
- +15 ; DIQ 2056
- +16 ; ICDCODE 3990
- +17 ; ICPTCOD 1995
- +18 ; VADPT 10061
- +19 ; XUAF4 2171
- +20 ;
- +21 ; All tags expect DFN, ID, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
- +22 QUIT
- +23 ;
- ADM(ID,DATE) ; -- admission [from VSIT1]
- +1 NEW ADM,VADMVT,VAIP,VAERR,MVT,SPEC,HLOC,FAC,ICD,I
- +2 ;Q:DATE<1
- SET ID=$GET(ID)
- SET DATE=+$GET(DATE)
- if ID=""
- QUIT
- +3 IF ID
- SET VAIP("D")=DATE
- SET VST=+ID
- +4 IF ID?1"H"1.N
- SET VAIP("E")=+$EXTRACT(ID,2,99)
- SET VST=0
- +5 ;deleted
- DO IN5^VADPT
- if '$GET(VAIP(1))
- QUIT
- +6 SET VADMVT=+$GET(VAIP(13))
- SET ID="H"_VADMVT
- +7 SET ADM("localId")=ID
- SET ADM("uid")=$$SETUID^HMPUTILS("visit",DFN,ID)
- +8 if 'DATE
- SET DATE=+$GET(VAIP(13,1))
- if 'VST
- SET VST=$$VISIT(DFN,DATE)
- +9 SET (ADM("dateTime"),ADM("stay","arrivalDateTime"))=$$JSONDT^HMPUTILS(DATE)
- +10 if $LENGTH($PIECE(VAIP(6),U,2))
- SET ADM("roomBed")=$PIECE(VAIP(6),U,2)
- +11 ;DE2818, (#.105) CURRENT ADMISSION, changed ^DPT to FileMan, ICR 10035
- +12 ;if current admission,
- SET MVT=13
- SET I=0
- IF VADMVT=$$GET1^DIQ(2,DFN_",",.105,"I")
- Begin DoDot:1
- +13 ; use last movement info
- SET ADM("current")="true"
- SET MVT=14
- +14 ;(#.101) ROOM-BED, DE2818
- SET X=$$GET1^DIQ(2,DFN_",",.101,"I")
- if $LENGTH(X)
- SET ADM("roomBed")=X
- +15 ;kill flag from HMPDJ0
- KILL HMPADMIT
- End DoDot:1
- +16 SET SPEC=$GET(VAIP(MVT,6))
- SET ADM("specialty")=$PIECE(SPEC,U,2)
- +17 SET X=$$SERV^HMPDVSIT(+SPEC)
- SET ADM("service")=X
- +18 ;DE2818, changed from ^DIC(42) to FileMan, ICR 10039
- +19 SET HLOC=+$$GET1^DIQ(42,+$GET(VAIP(MVT,4))_",",44,"I")
- SET FAC=$$FAC^HMPD(+HLOC)
- IF HLOC
- Begin DoDot:1
- +20 SET ADM("locationUid")=$$SETUID^HMPUTILS("location",,+HLOC)
- +21 ;DE2818 begin, changed ^SC to FileMan, ICR 10040
- +22 ;(#1) ABBREVIATION
- SET X=$$GET1^DIQ(44,HLOC_",",1)
- if X]""
- SET ADM("shortLocationName")=X
- +23 ;(#.01) NAME
- SET ADM("locationName")=$$GET1^DIQ(44,HLOC_",",.01)
- +24 ;(#8) STOP CODE NUMBER
- SET X=$$AMIS^HMPDVSIT($$GET1^DIQ(44,HLOC_",",8,"I"))
- +25 ;DE2818, end
- +26 if $LENGTH($GET(X))
- SET ADM("stopCodeUid")="urn:va:stop-code:"_$PIECE(X,U)
- SET ADM("stopCodeName")=$PIECE(X,U,2)
- +27 SET ADM("summary")="${"_ADM("service")_"}:"_ADM("locationName")
- End DoDot:1
- +28 DO FACILITY^HMPUTILS(FAC,"ADM")
- +29 SET ADM("categoryCode")="urn:va:encounter-category:AD"
- SET ADM("categoryName")="Admission"
- +30 SET ADM("patientClassCode")="urn:va:patient-class:IMP"
- SET ADM("patientClassName")="Inpatient"
- +31 IF $GET(VAIP(17))
- SET ADM("stay","dischargeDateTime")=$$JSONDT^HMPUTILS(+$GET(VAIP(17,1)))
- +32 ;attending
- IF $GET(VAIP(18))
- SET I=I+1
- DO PROV("ADM",I,+VAIP(18),"A")
- +33 ;primary
- IF $GET(VAIP(MVT,5))
- SET I=I+1
- DO PROV("ADM",I,+VAIP(MVT,5),"P",1)
- +34 ;PTF>ICD
- SET ICD=$$POV^HMPDJ04(VST)
- if 'ICD
- SET ICD=$$PTF^HMPDVSIT(DFN,VAIP(12))
- +35 IF $LENGTH(ICD)<2
- SET ADM("reasonName")=$GET(VAIP(MVT,7))
- +36 IF '$TEST
- SET ADM("reasonUid")=$$SETNCS^HMPUTILS("icd",ICD)
- SET ADM("reasonName")=$PIECE(ICD,U,2)
- +37 SET X=$$CPT^HMPDJ04(VST)
- SET ADM("typeName")=$SELECT(X:$PIECE($$CPT^ICPTCOD(X),U,3),1:$$CATG^HMPDVSIT("H"))
- +38 ;sub-movements
- DO MVT(VADMVT)
- +39 ; TIU(VST,.ADM) ;notes/summary
- +40 ; Next 2 lines added for visits whose IDs start with an "H". JD - 1/26/15
- +41 ;RHL 20150102
- SET ADM("lastUpdateTime")=$$EN^HMPSTMP("adm")
- +42 ; RHL 20150102
- SET ADM("stampTime")=ADM("lastUpdateTime")
- +43 ;US6734 - pre-compile metastamp
- +44 ;US6734,US11019
- IF $GET(HMPMETA)
- DO ADD^HMPMETA("visit",ADM("uid"),ADM("stampTime"))
- if HMPMETA=1
- QUIT
- +45 DO ADD^HMPDJ("ADM","visit")
- +46 QUIT
- +47 ;
- TIU(VISIT,ARR) ; -- add notes to ARR("document")
- +1 NEW X,Y,I,HMPX,LT,NT,DA,CNT,HMPY
- +2 DO FIND^DIC(8925,,.01,"QX",+$GET(VISIT),,"V",,,"HMPX")
- +3 SET Y=""
- SET (I,CNT)=0
- +4 FOR
- SET I=$ORDER(HMPX("DILIST",1,I))
- if I<1
- QUIT
- Begin DoDot:1
- +5 SET LT=$GET(HMPX("DILIST","ID",I,.01))
- if $PIECE(LT," ")="Addendum"
- QUIT
- +6 SET DA=$GET(HMPX("DILIST",2,I))
- +7 SET NT=$$GET1^DIQ(8925,+DA_",",".01:1501")
- +8 SET CNT=CNT+1
- SET ARR("documents",CNT,"uid")=$$SETUID^HMPUTILS("document",DFN,+DA)
- +9 SET ARR("documents",CNT,"localTitle")=LT
- +10 if $LENGTH(NT)
- SET ARR("documents",CNT,"nationalTitle")=NT
- End DoDot:1
- +11 QUIT
- +12 ;
- PROV(ARR,I,IEN,ROLE,PRIM) ; -- add providers
- +1 SET @ARR@("providers",I,"providerUid")=$$SETUID^HMPUTILS("user",,+IEN)
- +2 ;DE2818, changed ^VA(200) to FileMan ICR 10060
- 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 ;
- MVT(CA) ; -- add movements to ADM("movement",i,"attribute")
- +1 NEW DATE,DA,CNT,X
- SET (DATE,CNT)=0
- +2 ;DE2818, ^DGPM( - ICR 1865
- +3 FOR
- SET DATE=$ORDER(^DGPM("APCA",DFN,CA,DATE))
- if DATE<1
- QUIT
- SET DA=+$ORDER(^(DATE,0))
- IF DA'=CA
- Begin DoDot:1
- +4 SET X0=$GET(^DGPM(DA,0))
- SET CNT=CNT+1
- +5 SET ADM("movements",CNT,"localId")=DA
- +6 SET ADM("movements",CNT,"dateTime")=$$JSONDT^HMPUTILS(DATE)
- +7 SET ADM("movements",CNT,"movementType")=$$EXTERNAL^DILFD(405,.02,,$PIECE(X0,U,2))
- +8 SET X=+$PIECE(X0,U,19)
- IF X
- Begin DoDot:2
- +9 SET ADM("movements",CNT,"providerUid")=$$SETUID^HMPUTILS("user",,X)
- +10 ;DE2818, changed ^VA(200) to FileMan ICR 10060
- SET ADM("movements",CNT,"providerName")=$$GET1^DIQ(200,X_",",.01)
- End DoDot:2
- +11 SET X=+$PIECE(X0,U,9)
- +12 if X
- SET ADM("movements",CNT,"specialty")=$$EXTERNAL^DILFD(405,.09,,X)
- +13 ;DE2818, changed ^DIC(42) to FileMan, ICR 10039
- +14 SET HLOC=+$$GET1^DIQ(42,+$PIECE(X0,U,6)_",",44,"I")
- SET FAC=$$FAC^HMPD(HLOC)
- IF HLOC
- Begin DoDot:2
- +15 SET ADM("movements",CNT,"locationUid")=$$SETUID^HMPUTILS("location",,HLOC)
- +16 ;DE2818, changed ^SC to FileMan, ICR 10040
- +17 ;(#.01) NAME
- SET ADM("movements",CNT,"locationName")=$$GET1^DIQ(44,HLOC_",",.01)
- End DoDot:2
- End DoDot:1
- +18 QUIT
- +19 ;
- PTFA(HMPLID) ; -- find ID in ^PXRMINDX(45) and call PTF1 if successful
- +1 ;Purpose - Build ^TMP("HMPPX") from ^PXRMINDX(45,HMPISYS,"PNI",DFN)
- +2 ;
- +3 ;Called by - PTF^HMPDJ0 (if HMPID is set)
- +4 ;
- +5 ;Assumptions -
- +6 ;1. ID is being passed and DFN variable exists
- +7 ;2. ^TMP("HMPPX") does not already exist
- +8 ;
- +9 ;
- +10 ;Modification History -
- +11 ;US5630 (TW) 1. HMPISYS can be either "ICD" (ICD-9) or "10D" (ICD-10)
- +12 ; 2. Namespaced variables and enhanced newing
- +13 ;
- +14 NEW HMPLEN,HMPTYP,HMPID,HMPISYS,HMPTYP,HMPDX,HMPDT,HMPITEM,HMPRDT,HMPX
- +15 SET HMPLEN=$LENGTH(HMPLID,";")
- SET HMPTYP=$PIECE(HMPLID,";",HMPLEN)
- SET HMPID=$PIECE(HMPLID,";",1,HMPLEN-1)
- +16 ; DE2818, ^PXRMINDX - ICR 4290
- +17 ;Get ICD System from ^PXRMINDX Xref and loop for remaining subscripts
- +18 SET HMPISYS=""
- FOR
- SET HMPISYS=$ORDER(^PXRMINDX(45,HMPISYS))
- if HMPISYS=""
- QUIT
- Begin DoDot:1
- +19 IF '$DATA(^PXRMINDX(45,HMPISYS,"PNI",+$GET(DFN),HMPTYP))
- QUIT
- +20 SET HMPDX=""
- FOR
- SET HMPDX=$ORDER(^PXRMINDX(45,HMPISYS,"PNI",+$GET(DFN),HMPTYP,HMPDX))
- if HMPDX=""
- QUIT
- Begin DoDot:2
- +21 SET HMPDT=0
- FOR
- SET HMPDT=$ORDER(^PXRMINDX(45,HMPISYS,"PNI",+$GET(DFN),HMPTYP,HMPDX,HMPDT))
- if HMPDT=""
- QUIT
- Begin DoDot:3
- +22 SET HMPITEM=""
- FOR
- SET HMPITEM=$ORDER(^PXRMINDX(45,HMPISYS,"PNI",+$GET(DFN),HMPTYP,HMPDX,HMPDT,HMPITEM))
- if HMPITEM=""
- QUIT
- Begin DoDot:4
- +23 IF HMPITEM'[HMPID
- QUIT
- +24 SET HMPRDT=9999999-HMPDT
- +25 SET HMPX=HMPDX_U_HMPDT_U_HMPISYS
- +26 SET ^TMP("HMPPX",$JOB,HMPRDT,HMPLID)=HMPX
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +27 if '$DATA(^TMP("HMPPX",$JOB))
- QUIT
- +28 DO PTF1
- +29 KILL ^TMP("HMPPX",$JOB)
- +30 QUIT
- +31 ;
- PTF1 ; Set PTF data into PTF array
- +1 ;Purpose - Get data from ^TMP("HMPPX"), lookup addl PTF, set into PTF array and ^TMP
- +2 ;
- +3 ;Called by - PTFA^HMPDJ04A if HMPID is set, otherwise PTF^HMPDJ0
- +4 ;
- +5 ;Assumptions -
- +6 ;1. HMPLID (local ID) is being passed and DFN,HMPRDT variables exist
- +7 ;2. ^TMP("HMPPX",$J,HMPRDT,ID)=DxCode^[Discharge]Date exists
- +8 ;
- +9 ;Modification History -
- +10 ;US5630 (TW)- HMPISYS can be either "ICD9" or "10D" (ICD-10)
- +11 ;
- +12 NEW HMPTMP,PTF,HMPP,HMPTYP,HMPDIS,VAIN,HMPADM,VAINDT,HMPLOC,HMPFAC,HMPX,HMPISYS
- +13 SET HMPTMP=$GET(^TMP("HMPPX",$JOB,HMPRDT,HMPLID))
- +14 SET PTF("localId")=HMPLID
- +15 SET PTF("uid")=$$SETUID^HMPUTILS("ptf",DFN,HMPLID)
- +16 SET HMPP=$LENGTH(HMPLID,";")
- +17 SET HMPTYP=$PIECE(HMPLID,";",HMPP)
- +18 ; Is this the principal dx?
- IF HMPTYP="DXLS"
- SET PTF("principalDx")="true"
- +19 ; Quit if movement dx
- IF $PIECE(HMPTYP," ")="M"
- QUIT
- +20 SET HMPDIS=$PIECE(HMPTMP,U,2)
- +21 IF HMPDIS
- SET VAINDT=HMPDIS-.0001
- +22 ; Get inpatient VAIN array
- DO INP^VADPT
- +23 ; Quit if not inpatient
- IF '$GET(VAIN(1))
- QUIT
- +24 ;US5630 - TW - Extract Calculated DRG for PTF
- +25 SET PTF("drg")=$$GET1^DIQ(45,+HMPLID_",",9,"")
- +26 SET PTF("admissionUid")=$$SETUID^HMPUTILS("visit",DFN,"H"_VAIN(1))
- +27 ; Admission date
- SET HMPADM=+$GET(VAIN(7))
- +28 ;DE2818, changed from ^DIC(42) to FileMan, ICR 10039
- +29 ; Get location
- SET HMPLOC=+$$GET1^DIQ(42,+$GET(VAIN(4))_",",44,"I")
- +30 if HMPADM
- SET PTF("arrivalDateTime")=$$JSONDT^HMPUTILS(HMPADM)
- +31 if HMPDIS
- SET PTF("dischargeDateTime")=$$JSONDT^HMPUTILS(HMPDIS)
- +32 SET HMPFAC=$$FAC^HMPD(HMPLOC)
- if HMPFAC
- DO FACILITY^HMPUTILS(HMPFAC,"PTF")
- +33 ;RHL 20150102
- SET PTF("lastUpdateTime")=$$EN^HMPSTMP("ptf")
- +34 ; RHL 20150102
- SET PTF("stampTime")=PTF("lastUpdateTime")
- +35 ;US5630 - TW - Check for ICD Coding System
- +36 SET HMPDX=$PIECE(HMPTMP,U)
- +37 SET HMPISYS=$PIECE(HMPTMP,U,3)
- +38 ; Identify ICD coding system for correct lookup
- SET HMPISYS=$SELECT(HMPISYS="ICD":1,"ICP":2,"10D":30,"10P":31,1:1)
- +39 SET HMPX=$$ICDDX^ICDEX(HMPDX,"",HMPISYS)
- +40 SET PTF("icdCode")=$$SETNCS^HMPUTILS("icd",$PIECE(HMPX,U,2))
- +41 SET PTF("icdName")=$PIECE(HMPX,U,4)
- +42 ;US6734 - pre-compile metastamp
- +43 ;US6734,US11019
- IF $GET(HMPMETA)
- DO ADD^HMPMETA("ptf",PTF("uid"),PTF("stampTime"))
- if HMPMETA=1
- QUIT
- +44 DO ADD^HMPDJ("PTF","ptf")
- +45 QUIT
- +46 ;
- VISIT(DFN,DATE) ; -- Return visit# for admission
- +1 NEW X,Y
- +2 SET X=9999999-$PIECE(DATE,".")_"."_$PIECE(DATE,".",2)
- +3 ;DE2818, ICR 2028
- SET Y=+$ORDER(^AUPNVSIT("AAH",DFN,X,0))
- +4 QUIT Y
