MHVECFLR ;KUM - myHealtheVet File Workload ; 6/18/2013
;;1.0;My HealtheVet;**11**;June 18, 2013;Build 61
;;Per VHA Directive 2004-038, this routine should not be modified
;
Q
;
; Integration Agreements:
;
; 6012 : Event Capture API $$FILE^ECFLRPC
; 6013 : ^ECD(D0
; 1894 : PCE API $$GETENC^PXAPI
; 10004 : $$GET1^DIQ
; 10104 : $$REPLACE^XLFSTR
; 2701 : $$GETDFN^MPIF001
;
;
FILE(RESULT,ECSTRING) ;Start filing data into #721
;FILE^LOCATION^DSS UNIT^CATEGORY^PROCEDURE DATE TIME^PROCEDURE^PATIENT IEN^ORDERING SECTION^ENTER BY^PAT STATUS^PROVIDER^DX^
;ASSOC CLINIC^PATIENT STATUS AND CLASSIFICATION DATA^ELIGIBILITY IEN
;
N MHVDXSTR,MHVCLSTR,DFN,ENCDT,HLOC,MHVVIEN,MHVWLI,ECUA,MHVERR,MHVECX,MHVQUIT,MHVSECS,MHVPDT,MHVVID,MHVSPEC
;
S ECARY("ECFILE")=$P(ECSTRING,"^",1)
S ECARY("ECL")=$P(ECSTRING,"^",2) ; Location, Pointer to #4
S ECARY("ECD")=$P(ECSTRING,"^",3) ; DSS Unit, Pointer to #724
S ECARY("ECC")=$P(ECSTRING,"^",4) ; Category, Pointer to #726
;
S MHVPDT=$P(ECSTRING,"^",5)
S MHVPDT=$E(MHVPDT,1,4)_$E(MHVPDT,6,7)_$E(MHVPDT,9,10)_"@"_$E(MHVPDT,12,13)_$E(MHVPDT,15,16)
S X=MHVPDT
S %DT="TS"
D ^%DT
S MHVPDT=Y
S ECARY("ECDT")=MHVPDT ; Date and Time of Procedure
S ECARY("ECP")=$P(ECSTRING,"^",6) ; Procedure
;
; Get Patient IEN from Patient ICN
S MHVPICN=+$P(ECSTRING,"^",7)
I $G(MHVPICN)'>0 S RESULT(1)="0^No Patient ICN" Q
S MHVPIEN=$$GETDFN^MPIF001(MHVPICN)
I $P(MHVPIEN,"^",1)=-1 S RESULT(1)="0^Patient ICN not in Database" Q
S ECARY("ECDFN")=MHVPIEN ; Patient IEN for file #2
;
; DO - Retrieve Ordering Section from DSS Unit
;
S ECARY("ECMN")=$P(ECSTRING,"^",8) ; Ordering Section, Pointer to #723
S ECARY("ECMN")=$$GET1^DIQ(724,ECARY("ECD"),2,"I")
S ECARY("ECDUZ")=$P(ECSTRING,"^",9) ; Entered/Edited by, pointer to #200
S ECARY("ECPTSTAT")=$P(ECSTRING,"^",10) ; Patient Status
;
; Loading List of Providers
;
S ECUA=$P(ECSTRING,"^",11) ; Primary and Secondary Providers
S MHVERR=0
F MHVECX=1:1 Q:MHVERR D
. I $P(ECUA,";",MHVECX)="" S MHVERR=1 Q
. S ECARY("ECU"_MHVECX)=$P(ECUA,";",MHVECX)
;
; Loading List of Diagnosis Codes
;
S ECARY("ECDX")=$S($F($P(ECSTRING,"^",12),";"):$P($P(ECSTRING,"^",12),";",1),1:$P(ECSTRING,"^",12)) ; Primary Diagnosis
S MHVDXSTR=$P(ECSTRING,"^",12)
I $F(MHVDXSTR,";") D
. S MHVDXSTR=$E(MHVDXSTR,$F(MHVDXSTR,";"),$L(MHVDXSTR))
. S MHVSPEC(";")="^"
. S ECARY("ECDXS")=$$REPLACE^XLFSTR(MHVDXSTR,.MHVSPEC) ; Secondary Diagnosis codes
;
; Additional Fields
;
S ECARY("EC4")=$P(ECSTRING,"^",13) ; Associated Clinic - Pointer to #44
;
; Load Patient Eligibility and Patient Classification data
;
S MHVCLSTR=$P(ECSTRING,"^",14)
S ECARY("ECELIG")=$S($F(MHVCLSTR,";"):$P(MHVCLSTR,";",1),1:MHVCLSTR) ; Patient Eligibility
I $F(MHVCLSTR,";") D
. S MHVCLSTR=$E(MHVCLSTR,$F(MHVCLSTR,";"),$L(MHVCLSTR))
. S MHVSPEC(";")="^"
. S ECARY("ECLASS")=$$REPLACE^XLFSTR(MHVCLSTR,.MHVSPEC) ; Patient Classification data
D FILE^ECFLRPC(.RESULT,.ECARY)
;
; Retrieve Visit IEN - 5 Seconds Loop till you get Visit IEN
;
S MHVBTIM=$H
S ENCDT=MHVPDT
S HLOC=$P(ECSTRING,"^",13)
S MHVVIEN=0
S MHVSECS=0
S MHVQUIT=0
F MHVECX=1:1 Q:MHVQUIT D
. S MHVVIEN=$$GETENC^PXAPI(MHVPIEN,ENCDT,HLOC)
. I MHVVIEN<=0 D
. . S MHVETIM=$H
. . S MHVBTIM(1)=$P(MHVBTIM,",",1),MHVBTIM(2)=$P(MHVBTIM,",",2),MHVETIM(1)=$P(MHVETIM,",",1),MHVETIM(2)=$P(MHVETIM,",",2)
. . I MHVBTIM(1)=MHVETIM(1) S MHVSECS=MHVETIM(2)-MHVBTIM(2) Q
. . S MHVSECS=86400*(MHVETIM(1)-MHVBTIM(1))+(MHVETIM(2)-MHVBTIM(2)) Q
. I ((MHVVIEN>0)!(MHVSECS>=5)) S MHVQUIT=1
;
; Return IEN of workload
;
S MHVWLI=0
S MHVWLI=$O(^ECH("APAT",MHVPIEN,MHVPDT,MHVWLI))
;
S RESULT1=""
S SUB="" F S SUB=$O(^TMP($J,"ECMSG",SUB)) Q:SUB="" D
. S RESULT1=RESULT1_" SUBSCRIPT "_$G(SUB)_":"_$G(^TMP($J,"ECMSG",SUB))
S RESULT=$G(^TMP($J,"ECMSG",1))
;
; Populate Workload IEN and Visit IEN
;
I $L(RESULT,"^")=2 S RESULT=RESULT_"^"
I $G(MHVVIEN)<=0 S MHVVIEN=""
;I $G(MHVVIEN)>0 S MHVVID=$$GET1^DIQ(9000010,MHVVIEN,15001)
S RESULT(1)=RESULT_"^"_$G(MHVWLI)_"^"_$G(MHVVIEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHVECFLR 4322 printed Oct 16, 2024@18:16:47 Page 2
MHVECFLR ;KUM - myHealtheVet File Workload ; 6/18/2013
+1 ;;1.0;My HealtheVet;**11**;June 18, 2013;Build 61
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
+6 ; Integration Agreements:
+7 ;
+8 ; 6012 : Event Capture API $$FILE^ECFLRPC
+9 ; 6013 : ^ECD(D0
+10 ; 1894 : PCE API $$GETENC^PXAPI
+11 ; 10004 : $$GET1^DIQ
+12 ; 10104 : $$REPLACE^XLFSTR
+13 ; 2701 : $$GETDFN^MPIF001
+14 ;
+15 ;
FILE(RESULT,ECSTRING) ;Start filing data into #721
+1 ;FILE^LOCATION^DSS UNIT^CATEGORY^PROCEDURE DATE TIME^PROCEDURE^PATIENT IEN^ORDERING SECTION^ENTER BY^PAT STATUS^PROVIDER^DX^
+2 ;ASSOC CLINIC^PATIENT STATUS AND CLASSIFICATION DATA^ELIGIBILITY IEN
+3 ;
+4 NEW MHVDXSTR,MHVCLSTR,DFN,ENCDT,HLOC,MHVVIEN,MHVWLI,ECUA,MHVERR,MHVECX,MHVQUIT,MHVSECS,MHVPDT,MHVVID,MHVSPEC
+5 ;
+6 SET ECARY("ECFILE")=$PIECE(ECSTRING,"^",1)
+7 ; Location, Pointer to #4
SET ECARY("ECL")=$PIECE(ECSTRING,"^",2)
+8 ; DSS Unit, Pointer to #724
SET ECARY("ECD")=$PIECE(ECSTRING,"^",3)
+9 ; Category, Pointer to #726
SET ECARY("ECC")=$PIECE(ECSTRING,"^",4)
+10 ;
+11 SET MHVPDT=$PIECE(ECSTRING,"^",5)
+12 SET MHVPDT=$EXTRACT(MHVPDT,1,4)_$EXTRACT(MHVPDT,6,7)_$EXTRACT(MHVPDT,9,10)_"@"_$EXTRACT(MHVPDT,12,13)_$EXTRACT(MHVPDT,15,16)
+13 SET X=MHVPDT
+14 SET %DT="TS"
+15 DO ^%DT
+16 SET MHVPDT=Y
+17 ; Date and Time of Procedure
SET ECARY("ECDT")=MHVPDT
+18 ; Procedure
SET ECARY("ECP")=$PIECE(ECSTRING,"^",6)
+19 ;
+20 ; Get Patient IEN from Patient ICN
+21 SET MHVPICN=+$PIECE(ECSTRING,"^",7)
+22 IF $GET(MHVPICN)'>0
SET RESULT(1)="0^No Patient ICN"
QUIT
+23 SET MHVPIEN=$$GETDFN^MPIF001(MHVPICN)
+24 IF $PIECE(MHVPIEN,"^",1)=-1
SET RESULT(1)="0^Patient ICN not in Database"
QUIT
+25 ; Patient IEN for file #2
SET ECARY("ECDFN")=MHVPIEN
+26 ;
+27 ; DO - Retrieve Ordering Section from DSS Unit
+28 ;
+29 ; Ordering Section, Pointer to #723
SET ECARY("ECMN")=$PIECE(ECSTRING,"^",8)
+30 SET ECARY("ECMN")=$$GET1^DIQ(724,ECARY("ECD"),2,"I")
+31 ; Entered/Edited by, pointer to #200
SET ECARY("ECDUZ")=$PIECE(ECSTRING,"^",9)
+32 ; Patient Status
SET ECARY("ECPTSTAT")=$PIECE(ECSTRING,"^",10)
+33 ;
+34 ; Loading List of Providers
+35 ;
+36 ; Primary and Secondary Providers
SET ECUA=$PIECE(ECSTRING,"^",11)
+37 SET MHVERR=0
+38 FOR MHVECX=1:1
if MHVERR
QUIT
Begin DoDot:1
+39 IF $PIECE(ECUA,";",MHVECX)=""
SET MHVERR=1
QUIT
+40 SET ECARY("ECU"_MHVECX)=$PIECE(ECUA,";",MHVECX)
End DoDot:1
+41 ;
+42 ; Loading List of Diagnosis Codes
+43 ;
+44 ; Primary Diagnosis
SET ECARY("ECDX")=$SELECT($FIND($PIECE(ECSTRING,"^",12),";"):$PIECE($PIECE(ECSTRING,"^",12),";",1),1:$PIECE(ECSTRING,"^",12))
+45 SET MHVDXSTR=$PIECE(ECSTRING,"^",12)
+46 IF $FIND(MHVDXSTR,";")
Begin DoDot:1
+47 SET MHVDXSTR=$EXTRACT(MHVDXSTR,$FIND(MHVDXSTR,";"),$LENGTH(MHVDXSTR))
+48 SET MHVSPEC(";")="^"
+49 ; Secondary Diagnosis codes
SET ECARY("ECDXS")=$$REPLACE^XLFSTR(MHVDXSTR,.MHVSPEC)
End DoDot:1
+50 ;
+51 ; Additional Fields
+52 ;
+53 ; Associated Clinic - Pointer to #44
SET ECARY("EC4")=$PIECE(ECSTRING,"^",13)
+54 ;
+55 ; Load Patient Eligibility and Patient Classification data
+56 ;
+57 SET MHVCLSTR=$PIECE(ECSTRING,"^",14)
+58 ; Patient Eligibility
SET ECARY("ECELIG")=$SELECT($FIND(MHVCLSTR,";"):$PIECE(MHVCLSTR,";",1),1:MHVCLSTR)
+59 IF $FIND(MHVCLSTR,";")
Begin DoDot:1
+60 SET MHVCLSTR=$EXTRACT(MHVCLSTR,$FIND(MHVCLSTR,";"),$LENGTH(MHVCLSTR))
+61 SET MHVSPEC(";")="^"
+62 ; Patient Classification data
SET ECARY("ECLASS")=$$REPLACE^XLFSTR(MHVCLSTR,.MHVSPEC)
End DoDot:1
+63 DO FILE^ECFLRPC(.RESULT,.ECARY)
+64 ;
+65 ; Retrieve Visit IEN - 5 Seconds Loop till you get Visit IEN
+66 ;
+67 SET MHVBTIM=$HOROLOG
+68 SET ENCDT=MHVPDT
+69 SET HLOC=$PIECE(ECSTRING,"^",13)
+70 SET MHVVIEN=0
+71 SET MHVSECS=0
+72 SET MHVQUIT=0
+73 FOR MHVECX=1:1
if MHVQUIT
QUIT
Begin DoDot:1
+74 SET MHVVIEN=$$GETENC^PXAPI(MHVPIEN,ENCDT,HLOC)
+75 IF MHVVIEN<=0
Begin DoDot:2
+76 SET MHVETIM=$HOROLOG
+77 SET MHVBTIM(1)=$PIECE(MHVBTIM,",",1)
SET MHVBTIM(2)=$PIECE(MHVBTIM,",",2)
SET MHVETIM(1)=$PIECE(MHVETIM,",",1)
SET MHVETIM(2)=$PIECE(MHVETIM,",",2)
+78 IF MHVBTIM(1)=MHVETIM(1)
SET MHVSECS=MHVETIM(2)-MHVBTIM(2)
QUIT
+79 SET MHVSECS=86400*(MHVETIM(1)-MHVBTIM(1))+(MHVETIM(2)-MHVBTIM(2))
QUIT
End DoDot:2
+80 IF ((MHVVIEN>0)!(MHVSECS>=5))
SET MHVQUIT=1
End DoDot:1
+81 ;
+82 ; Return IEN of workload
+83 ;
+84 SET MHVWLI=0
+85 SET MHVWLI=$ORDER(^ECH("APAT",MHVPIEN,MHVPDT,MHVWLI))
+86 ;
+87 SET RESULT1=""
+88 SET SUB=""
FOR
SET SUB=$ORDER(^TMP($JOB,"ECMSG",SUB))
if SUB=""
QUIT
Begin DoDot:1
+89 SET RESULT1=RESULT1_" SUBSCRIPT "_$GET(SUB)_":"_$GET(^TMP($JOB,"ECMSG",SUB))
End DoDot:1
+90 SET RESULT=$GET(^TMP($JOB,"ECMSG",1))
+91 ;
+92 ; Populate Workload IEN and Visit IEN
+93 ;
+94 IF $LENGTH(RESULT,"^")=2
SET RESULT=RESULT_"^"
+95 IF $GET(MHVVIEN)<=0
SET MHVVIEN=""
+96 ;I $G(MHVVIEN)>0 S MHVVID=$$GET1^DIQ(9000010,MHVVIEN,15001)
+97 SET RESULT(1)=RESULT_"^"_$GET(MHVWLI)_"^"_$GET(MHVVIEN)
+98 QUIT
