MHVUMRPC ;KUM/LB - myHealtheVet Management Utilities ; 6/18/2013
;;1.0;My HealtheVet;**11,22,24,29,40**;July 10, 2017;Build 26
;;Per VA Directive 6402, this routine should not be modified
;
Q
;
; Integration Agreements:
;
; 5266 : ^SC(D0
; 6013 : ^ECD(D0
; 2051 : LIST^DIC
; 6009 : ^ECJ(D0
; 6009 : ^ECJ("AP"
; 6010 : Event Capture API $$ELIG^ECUERPC
; 6011 : Event Capture API $$PATCLAST^ECUERPC1
; 6016 : Event Capture API $$SRCLST^ECUMRPC1
; 2701 : $$GETDFN^MPIF001
; 1874 : ^EC(725,D0
; 1873 : Read File 721
; 2741 : OE/RR Calls to GMPLUTL2
; 1995 : CPT Code APIs
; 3990 : ICD Code APIs
; 6155 : Read access to DMMS Units in NEW PERSON File
; 10004 : $$GET1^DIQ
;
Q
DSSUNT(RESULTS,MHVSTRING) ;
;
;This broker entry point returns DSS units from file 724
; RPC: MHV GETDSSUNIT
;INPUTS MHVARY - Contains the following subscripted elements
; ACLNIEN - Associated Clinic IEN (required) and PRVDUZ - Provider
;
;OUTPUTS RESULTS - Array of DSS units. Data pieces as follows:-
; PIECE - Description
; 1 IEN of Location
; 2 Name of Location
; 3 IEN of DSS Unit
; 4 Name of DSS Unit
; 5 Inactive flag (1-Yes/0-No)
; 6 Send to PCE flag
;
N MHVLIEN,MHVLNAM,MHVCIEN,MHVDIEN,MHVDNAM,MHVCNT,MHVDIACT,MHVCHKF,MHVDPCE,MHVR1
N MHVR1E,MHVR1C,MHVDIV,MHVDIVN,MHVPDUZ,FLAG
S MHVCNT=0
S MHVDPCE=0
S FLAG=0
;JAZZ#409966-Fix Names with Space in SM queries
;S MHVCIEN=+$P(MHVSTRING,"^",1)
S MHVCIEN=$P(MHVSTRING,"^",1)
I MHVCIEN='"*" S MHVCIEN=+MHVCIEN
;--------------------------------
S MHVPDUZ=+$P(MHVSTRING,"^",2)
K ^TMP($J,"MHVDUNT")
; Fetch Location IEN and Location Name
;JAZZ#409966-Fix Names with Space in SM queries
;and more User Fields: Retrieve all (*) User DSS Units
;I '$D(^SC(MHVCIEN,0)) S RESULTS(1)="0^DSS1-No clinic for IEN:"_MHVCIEN Q
I '$D(^SC(MHVCIEN,0)),$G(MHVCIEN)'="*" S RESULTS(1)="0^DSS1-No clinic for IEN:"_MHVCIEN Q
I $G(MHVCIEN)'="*" S FLAG=$$CLINIC Q:FLAG ;JAZZ#409966 ;JAZZ#
; Fetch DSS Unit IEN from file #200
D LIST^DIC(200.72,","_MHVPDUZ_",","@","QP","","","","","","","MHVR1","MHVR1E")
I $G(MHVR1("DILIST",0))'>0 S RESULTS(1)="0^DSS3-No DSS Units found in New Person File" Q
D:$G(MHVR1("DILIST",0))>0
. S MHVR1C=0
. F S MHVR1C=$O(MHVR1("DILIST",MHVR1C)) Q:MHVR1C'>0 D
. . S MHVDIEN=$G(MHVR1("DILIST",MHVR1C,0))
. . I +$G(MHVDIEN)'>0 Q
. . S MHVDNAM=$$GET1^DIQ(724,+MHVDIEN,.01)
. . S MHVDIACT=$$GET1^DIQ(724,+MHVDIEN,5,"I")
. . S MHVDPCE=$$GET1^DIQ(724,+MHVDIEN,13,"I")
. . D MHVCHK
. . I ($G(MHVCIEN)="*") Q:((+$G(MHVDIACT)=1)!(MHVCHKF=1)) ;JAZZ#409966
. . ;I (+$G(MHVDIACT)=1)!(MHVCHKF=1)!('$D(^ECJ("AP",MHVLIEN,MHVDIEN))) Q
. . I ($G(MHVCIEN)'="*"),((+$G(MHVDIACT)=1)!(MHVCHKF=1)!('$D(^ECJ("AP",MHVLIEN,MHVDIEN)))) Q
. . D MHVRST
I MHVCNT=0 D
.I ($G(MHVCIEN)'="*") S RESULTS(1)="0^DSS4-No DSS Units found (Missing Event Code Screen) clinic IEN:"_MHVCIEN Q
.S RESULTS(1)="0^DSS4-No DSS Units found clinic IEN:"_MHVCIEN Q
Q
MHVRST ;Populate results array
S MHVCNT=MHVCNT+1
S RESULTS(MHVCNT)=$G(MHVLIEN)_"^"_$G(MHVLNAM)_"^"_$G(MHVDIEN)_"^"_$G(MHVDNAM)_"^"_$G(MHVDIACT)_"^"_$G(MHVDPCE)
Q
MHVCHK ;Check if DSS Unit is already populated in results array ;JAZZ#
N MHVI
S MHVCHKF=0
S MHVI=0 F S MHVI=$O(RESULTS(MHVI)) Q:'MHVI!MHVCHKF D
. I MHVDIEN=$P(RESULTS(MHVI),"^",3) S MHVCHKF=1
Q
CLINIC() ;Get clinic
N FLG
S FLG=0
S MHVDIV=$$GET1^DIQ(44,+MHVCIEN,3.5,"I"),MHVDIVN=$$GET1^DIQ(44,+MHVCIEN,3.5,"E")
I +$G(MHVDIV)=0!($G(MHVDIVN)="") S RESULTS(1)="0^DSS2-No Division found for clinic IEN:"_MHVCIEN,FLG=1 Q FLG
S MHVLIEN=$$GET1^DIQ(40.8,+MHVDIV,.07,"I"),MHVLNAM=$$GET1^DIQ(40.8,+MHVDIV,.07,"E")
I MHVLIEN="" S MHVLIEN=$$GET1^DIQ(44,+MHVCIEN,3,"I"),MHVLNAM=$$GET1^DIQ(44,+MHVCIEN,3,"E")
I +$G(MHVLIEN)=0!($G(MHVLNAM)="") S RESULTS(1)="0^DSS1-No Institution found for clinic IEN:"_MHVCIEN,FLG=1 Q FLG
Q FLG
PRINTRES ; Print Results
N I
S I="" F S I=$O(@RESULTS@(I)) Q:I="" D
. W !,"LOCATIONIEN LOCATIONNAME DSSUNITIEN DSSUNITNAME INACTIVE"
. W !,@RESULTS@(I)
Q
DSSPROCS(RESULTS,MHVARY) ; Get Procedures from DSS Unit IEN and Locaiton IEN
; MHVARY IS DSS UNIT IEN AND LOCATION IEN
; RESULTS = Procedure IEN^Procedure 5 digit code and description^synonym^Active flag
N MHVLOC,MHVECD,MHVCAT,MHVPX,MHVIEN,MHVNODE,MHVPRO,MHVSYN,MHVPN,MHVSTAT,MHVCNT
S MHVLOC=+$P(MHVARY,"^",1)
S MHVECD=+$P(MHVARY,"^",2)
S MHVCNT=0
S MHVCAT="" F S MHVCAT=$O(^ECJ("AP",MHVLOC,MHVECD,MHVCAT)) Q:MHVCAT="" D
. S MHVPX="" F S MHVPX=$O(^ECJ("AP",MHVLOC,MHVECD,MHVCAT,MHVPX)) Q:MHVPX="" S MHVIEN=0 D
..F S MHVIEN=$O(^ECJ("AP",MHVLOC,MHVECD,MHVCAT,MHVPX,MHVIEN)) Q:'MHVIEN D
...S MHVNODE=$G(^ECJ(MHVIEN,0)) I MHVNODE="" Q
...S MHVPRO=$G(^ECJ(MHVIEN,"PRO")),MHVSYN=$P(MHVPRO,U,2),MHVPN=$P($P(MHVPRO,U),";")
...I $G(MHVPN)="" Q
...I $P(MHVPRO,U)["EC" S MHVPN=$G(^EC(725,MHVPN,0)),MHVPRO=$P(MHVPN,U,2)_" "_$P(MHVPN,U)
...E S MHVPN=$$CPT^ICPTCOD(MHVPN) S MHVPRO=$P(MHVPN,U,2)_" "_$P(MHVPN,U,3)
...S MHVSTAT=$S($P(MHVNODE,U,2)'="":"No",1:"Yes")
...; STATUS (Y-Active/N-Inactive)
...I $G(MHVSTAT)="No" Q
...S MHVCNT=MHVCNT+1
...S RESULTS(MHVCNT)=$G(MHVPX)_U_$P($G(MHVPN),U)_U_$P($G(MHVPN),U,2)_U_$G(MHVSYN)_U_$G(MHVSTAT)
I MHVCNT=0 S RESULTS(1)="0^No Procedures found for DSS Unit IEN:"_MHVECD_" and Location IEN:"_MHVLOC Q
Q
PATECLS(RESULTS,MHVSTRING) ; Get Patient eligibility and Classification data
; MHVSTRING IS PATIENT ICN, DSS UNIT IEN, PROCEDURE DATE AND TIME IN FILEMAN FORMAT
; RESULTS = PATIENT STATUS ^CLASSIFICATION DATA (AGENT ORANCE, IONIZING RADIATION, SC CONDITION, ENVIRONMENTAL CONTAMINANTS, MILITARY SEXUAL TRUMA
; RESULTS(1,2...)=PRIMARY/SECONDARY FLAG (1-PRIMARY,0-SECONDARY)^ELIGIBILITY IEN^ELIGIBILITY DESCRIPTION
N MHVPIEN,MHVECD,MHVPDT,MHVI,MHVCNT,MHVPICN,ECARY
; Get Patient IEN from Patient ICN
S MHVPICN=+$P(MHVSTRING,"^",1)
I $G(MHVPICN)'>0 S RESULTS(1)="0^No Patient ICN" Q
S MHVPIEN=$$GETDFN^MPIF001(MHVPICN)
I $P($G(MHVPIEN),"^",1)=-1 S RESULTS(1)="0^Patient ICN not in Database" Q
;
S $P(MHVSTRING,"^",1)=MHVPIEN
S MHVECD=$P(MHVSTRING,"^",2)
S MHVPDT=$P(MHVSTRING,"^",3)
; GET PATIENT ELIGIBILITY
S ECARY=$G(MHVPIEN)
D ELIG^ECUERPC(.RESULTS,.ECARY)
I $G(RESULTS)="" S RESULTS(1)="0^No Eligibility codes found for Patient DFN:"_MHVPIEN Q
S MHVCNT=0
S MHVI="" F S MHVI=$O(@RESULTS@(MHVI)) Q:MHVI="" D
. S MHVCNT=MHVCNT+1
. S RESULTS(MHVCNT)=@RESULTS@(MHVI)
I MHVCNT=0 S RESULTS(1)="0^No Eligibility codes found for Patient DFN:"_MHVPIEN Q
; GET PATIENT CLASSIFICATION DATA
S ECARY=MHVSTRING
S RESULTS=""
D PATCLAST^ECUERPC1(.RESULTS,.ECARY)
S RESULTS(0)=RESULTS
I RESULTS="" S RESULTS(1)="0^No Classification data found for Patient DFN:"_MHVPIEN Q
Q
DIAGPL(RESULTS,MHVSTRING) ; Get Patient Diagnosis codes from Patient Probelm list
; MHVSTRING IS PATIENT ICN
; RESULTS = DIAGNOSIS CODE IEN^DIAGNOSIS CODE^SNOMED-CT DESCRIPTION~ICD-10 DESCRIPTION^ICD CODING SYSTEM
N MHVPIEN,MHVPICN,MHVCNT,MHVDCOD,PRB,DCOD
; Get Patient IEN from Patient ICN
S MHVPICN=+$P(MHVSTRING,"^",1)
I $G(MHVPICN)'>0 S RESULTS(1)="0^No Patient ICN" Q
S MHVPIEN=$$GETDFN^MPIF001(MHVPICN)
I $P($G(MHVPIEN),"^",1)=-1 S RESULTS(1)="0^Patient ICN not in Database" Q
;
S $P(MHVSTRING,"^",1)=$G(MHVPIEN)
K MHVROOTP
D LIST^GMPLUTL2(.MHVROOTP,MHVPIEN,"A")
I $G(MHVROOTP(0))<1 S RESULTS(1)="0^No Diagnosis codes found in Patient Problem List" Q
S MHVCNT=0
;Fix for ICD 10 PRODUCTION ISSUE on date switch
;Item#2.Story 223914: SM WLC - ICD10 - SNOMED CT Problem List and Encounter Completion and Workload
F S MHVCNT=MHVCNT+1 Q:MHVCNT>$G(MHVROOTP(0)) D
. S MHVDCOD=$P($P(MHVROOTP(MHVCNT),"^",4),"/",1)
. S MHVDIEN=$P($$CODEN^ICDCODE(MHVDCOD,80),"~",1)
. ;Story 272695 Emergency Fix
. ;- adding the ICD-10 Description as second " - " piece to Problem SNOMED-CT Description
. I $P(MHVROOTP(MHVCNT),"^",13)="10D",$L($G(MHVDCOD)) D
. . S DCOD="757.01^"_$G(MHVDCOD)
. . D DIAGSRCH(.PRB,.DCOD)
. . I $L($G(PRB(1))),($P(PRB(1),"^",2)'=0) S $P(MHVROOTP(MHVCNT),"^",3)=$P(MHVROOTP(MHVCNT),"^",3)_" - "_$P($G(PRB(1)),"^",3)
. .;- end of code for Story 272695 Emergency Fix
. S RESULTS(MHVCNT)=$G(MHVDIEN)_"^"_$G(MHVDCOD)_"^"_$P(MHVROOTP(MHVCNT),"^",3)_"^"_$P(MHVROOTP(MHVCNT),"^",13)
Q
DIAGSRCH(RESULTS,MHVSTRING) ; Get Diagnosis codes and description from Search string
; MHVSTRING IS SEARCH STRING AND FILE TO SEARCH
; RESULTS = DIAGNOSIS CODE IEN IN FILE 80^DIAGNOSIS CODE^DESCRIPTION
N MHVSTR,MHVCNT
K MHVROOT
; FILENAME^ICD
;S MHVSTR=$P(MHVSTRING,U)_"^ICD|"_$P(MHVSTRING,U,2)_"|DT^"
;Fix for ICD 10 PRODUCTION ISSUE on date switch
;Item#1.Story 26244 SM WLC - ICD10 - SNOMED CT Problem List and Encounter Completion and Workload
S MHVSTR=$P(MHVSTRING,U)_"^ICD|"_$P(MHVSTRING,U,2)_"|"_DT_"^"
D SRCLST^ECUMRPC1(.MHVROOT,.MHVSTR)
I $G(MHVROOT)="" S RESULTS(1)="^0^No results found" Q
S MHVCNT=0
;Per Secure Messaging (SM) Change Request (CR)Release 12.15
;User Story: Problem List ICD-10 enhancement:
;restrict the number of records returned from VistA to 199 or less
;S I="" F S I=$O(@MHVROOT@(I)) Q:I="" D
S I="" F S I=$O(@MHVROOT@(I)) Q:(I="")!(MHVCNT>199) D
. S MHVCNT=MHVCNT+1
. S RESULTS(I)=@MHVROOT@(I)
. S RESULTS(I)=$P(RESULTS(I),"^",3)_"^"_$P(RESULTS(I),"^",1)_"^"_$P(RESULTS(I),"^",2)_"^"_$P($P(RESULTS(I),"(",2),")",1)
I MHVCNT=0 S RESULTS(1)="^0^No results found" Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHVUMRPC 9910 printed Apr 09, 2024@21:17:54 Page 2
MHVUMRPC ;KUM/LB - myHealtheVet Management Utilities ; 6/18/2013
+1 ;;1.0;My HealtheVet;**11,22,24,29,40**;July 10, 2017;Build 26
+2 ;;Per VA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
+6 ; Integration Agreements:
+7 ;
+8 ; 5266 : ^SC(D0
+9 ; 6013 : ^ECD(D0
+10 ; 2051 : LIST^DIC
+11 ; 6009 : ^ECJ(D0
+12 ; 6009 : ^ECJ("AP"
+13 ; 6010 : Event Capture API $$ELIG^ECUERPC
+14 ; 6011 : Event Capture API $$PATCLAST^ECUERPC1
+15 ; 6016 : Event Capture API $$SRCLST^ECUMRPC1
+16 ; 2701 : $$GETDFN^MPIF001
+17 ; 1874 : ^EC(725,D0
+18 ; 1873 : Read File 721
+19 ; 2741 : OE/RR Calls to GMPLUTL2
+20 ; 1995 : CPT Code APIs
+21 ; 3990 : ICD Code APIs
+22 ; 6155 : Read access to DMMS Units in NEW PERSON File
+23 ; 10004 : $$GET1^DIQ
+24 ;
+25 QUIT
DSSUNT(RESULTS,MHVSTRING) ;
+1 ;
+2 ;This broker entry point returns DSS units from file 724
+3 ; RPC: MHV GETDSSUNIT
+4 ;INPUTS MHVARY - Contains the following subscripted elements
+5 ; ACLNIEN - Associated Clinic IEN (required) and PRVDUZ - Provider
+6 ;
+7 ;OUTPUTS RESULTS - Array of DSS units. Data pieces as follows:-
+8 ; PIECE - Description
+9 ; 1 IEN of Location
+10 ; 2 Name of Location
+11 ; 3 IEN of DSS Unit
+12 ; 4 Name of DSS Unit
+13 ; 5 Inactive flag (1-Yes/0-No)
+14 ; 6 Send to PCE flag
+15 ;
+16 NEW MHVLIEN,MHVLNAM,MHVCIEN,MHVDIEN,MHVDNAM,MHVCNT,MHVDIACT,MHVCHKF,MHVDPCE,MHVR1
+17 NEW MHVR1E,MHVR1C,MHVDIV,MHVDIVN,MHVPDUZ,FLAG
+18 SET MHVCNT=0
+19 SET MHVDPCE=0
+20 SET FLAG=0
+21 ;JAZZ#409966-Fix Names with Space in SM queries
+22 ;S MHVCIEN=+$P(MHVSTRING,"^",1)
+23 SET MHVCIEN=$PIECE(MHVSTRING,"^",1)
+24 IF MHVCIEN='"*"
SET MHVCIEN=+MHVCIEN
+25 ;--------------------------------
+26 SET MHVPDUZ=+$PIECE(MHVSTRING,"^",2)
+27 KILL ^TMP($JOB,"MHVDUNT")
+28 ; Fetch Location IEN and Location Name
+29 ;JAZZ#409966-Fix Names with Space in SM queries
+30 ;and more User Fields: Retrieve all (*) User DSS Units
+31 ;I '$D(^SC(MHVCIEN,0)) S RESULTS(1)="0^DSS1-No clinic for IEN:"_MHVCIEN Q
+32 IF '$DATA(^SC(MHVCIEN,0))
IF $GET(MHVCIEN)'="*"
SET RESULTS(1)="0^DSS1-No clinic for IEN:"_MHVCIEN
QUIT
+33 ;JAZZ#409966 ;JAZZ#
IF $GET(MHVCIEN)'="*"
SET FLAG=$$CLINIC
if FLAG
QUIT
+34 ; Fetch DSS Unit IEN from file #200
+35 DO LIST^DIC(200.72,","_MHVPDUZ_",","@","QP","","","","","","","MHVR1","MHVR1E")
+36 IF $GET(MHVR1("DILIST",0))'>0
SET RESULTS(1)="0^DSS3-No DSS Units found in New Person File"
QUIT
+37 if $GET(MHVR1("DILIST",0))>0
Begin DoDot:1
+38 SET MHVR1C=0
+39 FOR
SET MHVR1C=$ORDER(MHVR1("DILIST",MHVR1C))
if MHVR1C'>0
QUIT
Begin DoDot:2
+40 SET MHVDIEN=$GET(MHVR1("DILIST",MHVR1C,0))
+41 IF +$GET(MHVDIEN)'>0
QUIT
+42 SET MHVDNAM=$$GET1^DIQ(724,+MHVDIEN,.01)
+43 SET MHVDIACT=$$GET1^DIQ(724,+MHVDIEN,5,"I")
+44 SET MHVDPCE=$$GET1^DIQ(724,+MHVDIEN,13,"I")
+45 DO MHVCHK
+46 ;JAZZ#409966
IF ($GET(MHVCIEN)="*")
if ((+$GET(MHVDIACT)=1)!(MHVCHKF=1))
QUIT
+47 ;I (+$G(MHVDIACT)=1)!(MHVCHKF=1)!('$D(^ECJ("AP",MHVLIEN,MHVDIEN))) Q
+48 IF ($GET(MHVCIEN)'="*")
IF ((+$GET(MHVDIACT)=1)!(MHVCHKF=1)!('$DATA(^ECJ("AP",MHVLIEN,MHVDIEN))))
QUIT
+49 DO MHVRST
End DoDot:2
End DoDot:1
+50 IF MHVCNT=0
Begin DoDot:1
+51 IF ($GET(MHVCIEN)'="*")
SET RESULTS(1)="0^DSS4-No DSS Units found (Missing Event Code Screen) clinic IEN:"_MHVCIEN
QUIT
+52 SET RESULTS(1)="0^DSS4-No DSS Units found clinic IEN:"_MHVCIEN
QUIT
End DoDot:1
+53 QUIT
MHVRST ;Populate results array
+1 SET MHVCNT=MHVCNT+1
+2 SET RESULTS(MHVCNT)=$GET(MHVLIEN)_"^"_$GET(MHVLNAM)_"^"_$GET(MHVDIEN)_"^"_$GET(MHVDNAM)_"^"_$GET(MHVDIACT)_"^"_$GET(MHVDPCE)
+3 QUIT
MHVCHK ;Check if DSS Unit is already populated in results array ;JAZZ#
+1 NEW MHVI
+2 SET MHVCHKF=0
+3 SET MHVI=0
FOR
SET MHVI=$ORDER(RESULTS(MHVI))
if 'MHVI!MHVCHKF
QUIT
Begin DoDot:1
+4 IF MHVDIEN=$PIECE(RESULTS(MHVI),"^",3)
SET MHVCHKF=1
End DoDot:1
+5 QUIT
CLINIC() ;Get clinic
+1 NEW FLG
+2 SET FLG=0
+3 SET MHVDIV=$$GET1^DIQ(44,+MHVCIEN,3.5,"I")
SET MHVDIVN=$$GET1^DIQ(44,+MHVCIEN,3.5,"E")
+4 IF +$GET(MHVDIV)=0!($GET(MHVDIVN)="")
SET RESULTS(1)="0^DSS2-No Division found for clinic IEN:"_MHVCIEN
SET FLG=1
QUIT FLG
+5 SET MHVLIEN=$$GET1^DIQ(40.8,+MHVDIV,.07,"I")
SET MHVLNAM=$$GET1^DIQ(40.8,+MHVDIV,.07,"E")
+6 IF MHVLIEN=""
SET MHVLIEN=$$GET1^DIQ(44,+MHVCIEN,3,"I")
SET MHVLNAM=$$GET1^DIQ(44,+MHVCIEN,3,"E")
+7 IF +$GET(MHVLIEN)=0!($GET(MHVLNAM)="")
SET RESULTS(1)="0^DSS1-No Institution found for clinic IEN:"_MHVCIEN
SET FLG=1
QUIT FLG
+8 QUIT FLG
PRINTRES ; Print Results
+1 NEW I
+2 SET I=""
FOR
SET I=$ORDER(@RESULTS@(I))
if I=""
QUIT
Begin DoDot:1
+3 WRITE !,"LOCATIONIEN LOCATIONNAME DSSUNITIEN DSSUNITNAME INACTIVE"
+4 WRITE !,@RESULTS@(I)
End DoDot:1
+5 QUIT
DSSPROCS(RESULTS,MHVARY) ; Get Procedures from DSS Unit IEN and Locaiton IEN
+1 ; MHVARY IS DSS UNIT IEN AND LOCATION IEN
+2 ; RESULTS = Procedure IEN^Procedure 5 digit code and description^synonym^Active flag
+3 NEW MHVLOC,MHVECD,MHVCAT,MHVPX,MHVIEN,MHVNODE,MHVPRO,MHVSYN,MHVPN,MHVSTAT,MHVCNT
+4 SET MHVLOC=+$PIECE(MHVARY,"^",1)
+5 SET MHVECD=+$PIECE(MHVARY,"^",2)
+6 SET MHVCNT=0
+7 SET MHVCAT=""
FOR
SET MHVCAT=$ORDER(^ECJ("AP",MHVLOC,MHVECD,MHVCAT))
if MHVCAT=""
QUIT
Begin DoDot:1
+8 SET MHVPX=""
FOR
SET MHVPX=$ORDER(^ECJ("AP",MHVLOC,MHVECD,MHVCAT,MHVPX))
if MHVPX=""
QUIT
SET MHVIEN=0
Begin DoDot:2
+9 FOR
SET MHVIEN=$ORDER(^ECJ("AP",MHVLOC,MHVECD,MHVCAT,MHVPX,MHVIEN))
if 'MHVIEN
QUIT
Begin DoDot:3
+10 SET MHVNODE=$GET(^ECJ(MHVIEN,0))
IF MHVNODE=""
QUIT
+11 SET MHVPRO=$GET(^ECJ(MHVIEN,"PRO"))
SET MHVSYN=$PIECE(MHVPRO,U,2)
SET MHVPN=$PIECE($PIECE(MHVPRO,U),";")
+12 IF $GET(MHVPN)=""
QUIT
+13 IF $PIECE(MHVPRO,U)["EC"
SET MHVPN=$GET(^EC(725,MHVPN,0))
SET MHVPRO=$PIECE(MHVPN,U,2)_" "_$PIECE(MHVPN,U)
+14 IF '$TEST
SET MHVPN=$$CPT^ICPTCOD(MHVPN)
SET MHVPRO=$PIECE(MHVPN,U,2)_" "_$PIECE(MHVPN,U,3)
+15 SET MHVSTAT=$SELECT($PIECE(MHVNODE,U,2)'="":"No",1:"Yes")
+16 ; STATUS (Y-Active/N-Inactive)
+17 IF $GET(MHVSTAT)="No"
QUIT
+18 SET MHVCNT=MHVCNT+1
+19 SET RESULTS(MHVCNT)=$GET(MHVPX)_U_$PIECE($GET(MHVPN),U)_U_$PIECE($GET(MHVPN),U,2)_U_$GET(MHVSYN)_U_$GET(MHVSTAT)
End DoDot:3
End DoDot:2
End DoDot:1
+20 IF MHVCNT=0
SET RESULTS(1)="0^No Procedures found for DSS Unit IEN:"_MHVECD_" and Location IEN:"_MHVLOC
QUIT
+21 QUIT
PATECLS(RESULTS,MHVSTRING) ; Get Patient eligibility and Classification data
+1 ; MHVSTRING IS PATIENT ICN, DSS UNIT IEN, PROCEDURE DATE AND TIME IN FILEMAN FORMAT
+2 ; RESULTS = PATIENT STATUS ^CLASSIFICATION DATA (AGENT ORANCE, IONIZING RADIATION, SC CONDITION, ENVIRONMENTAL CONTAMINANTS, MILITARY SEXUAL TRUMA
+3 ; RESULTS(1,2...)=PRIMARY/SECONDARY FLAG (1-PRIMARY,0-SECONDARY)^ELIGIBILITY IEN^ELIGIBILITY DESCRIPTION
+4 NEW MHVPIEN,MHVECD,MHVPDT,MHVI,MHVCNT,MHVPICN,ECARY
+5 ; Get Patient IEN from Patient ICN
+6 SET MHVPICN=+$PIECE(MHVSTRING,"^",1)
+7 IF $GET(MHVPICN)'>0
SET RESULTS(1)="0^No Patient ICN"
QUIT
+8 SET MHVPIEN=$$GETDFN^MPIF001(MHVPICN)
+9 IF $PIECE($GET(MHVPIEN),"^",1)=-1
SET RESULTS(1)="0^Patient ICN not in Database"
QUIT
+10 ;
+11 SET $PIECE(MHVSTRING,"^",1)=MHVPIEN
+12 SET MHVECD=$PIECE(MHVSTRING,"^",2)
+13 SET MHVPDT=$PIECE(MHVSTRING,"^",3)
+14 ; GET PATIENT ELIGIBILITY
+15 SET ECARY=$GET(MHVPIEN)
+16 DO ELIG^ECUERPC(.RESULTS,.ECARY)
+17 IF $GET(RESULTS)=""
SET RESULTS(1)="0^No Eligibility codes found for Patient DFN:"_MHVPIEN
QUIT
+18 SET MHVCNT=0
+19 SET MHVI=""
FOR
SET MHVI=$ORDER(@RESULTS@(MHVI))
if MHVI=""
QUIT
Begin DoDot:1
+20 SET MHVCNT=MHVCNT+1
+21 SET RESULTS(MHVCNT)=@RESULTS@(MHVI)
End DoDot:1
+22 IF MHVCNT=0
SET RESULTS(1)="0^No Eligibility codes found for Patient DFN:"_MHVPIEN
QUIT
+23 ; GET PATIENT CLASSIFICATION DATA
+24 SET ECARY=MHVSTRING
+25 SET RESULTS=""
+26 DO PATCLAST^ECUERPC1(.RESULTS,.ECARY)
+27 SET RESULTS(0)=RESULTS
+28 IF RESULTS=""
SET RESULTS(1)="0^No Classification data found for Patient DFN:"_MHVPIEN
QUIT
+29 QUIT
DIAGPL(RESULTS,MHVSTRING) ; Get Patient Diagnosis codes from Patient Probelm list
+1 ; MHVSTRING IS PATIENT ICN
+2 ; RESULTS = DIAGNOSIS CODE IEN^DIAGNOSIS CODE^SNOMED-CT DESCRIPTION~ICD-10 DESCRIPTION^ICD CODING SYSTEM
+3 NEW MHVPIEN,MHVPICN,MHVCNT,MHVDCOD,PRB,DCOD
+4 ; Get Patient IEN from Patient ICN
+5 SET MHVPICN=+$PIECE(MHVSTRING,"^",1)
+6 IF $GET(MHVPICN)'>0
SET RESULTS(1)="0^No Patient ICN"
QUIT
+7 SET MHVPIEN=$$GETDFN^MPIF001(MHVPICN)
+8 IF $PIECE($GET(MHVPIEN),"^",1)=-1
SET RESULTS(1)="0^Patient ICN not in Database"
QUIT
+9 ;
+10 SET $PIECE(MHVSTRING,"^",1)=$GET(MHVPIEN)
+11 KILL MHVROOTP
+12 DO LIST^GMPLUTL2(.MHVROOTP,MHVPIEN,"A")
+13 IF $GET(MHVROOTP(0))<1
SET RESULTS(1)="0^No Diagnosis codes found in Patient Problem List"
QUIT
+14 SET MHVCNT=0
+15 ;Fix for ICD 10 PRODUCTION ISSUE on date switch
+16 ;Item#2.Story 223914: SM WLC - ICD10 - SNOMED CT Problem List and Encounter Completion and Workload
+17 FOR
SET MHVCNT=MHVCNT+1
if MHVCNT>$GET(MHVROOTP(0))
QUIT
Begin DoDot:1
+18 SET MHVDCOD=$PIECE($PIECE(MHVROOTP(MHVCNT),"^",4),"/",1)
+19 SET MHVDIEN=$PIECE($$CODEN^ICDCODE(MHVDCOD,80),"~",1)
+20 ;Story 272695 Emergency Fix
+21 ;- adding the ICD-10 Description as second " - " piece to Problem SNOMED-CT Description
+22 IF $PIECE(MHVROOTP(MHVCNT),"^",13)="10D"
IF $LENGTH($GET(MHVDCOD))
Begin DoDot:2
+23 SET DCOD="757.01^"_$GET(MHVDCOD)
+24 DO DIAGSRCH(.PRB,.DCOD)
+25 IF $LENGTH($GET(PRB(1)))
IF ($PIECE(PRB(1),"^",2)'=0)
SET $PIECE(MHVROOTP(MHVCNT),"^",3)=$PIECE(MHVROOTP(MHVCNT),"^",3)_" - "_$PIECE($GET(PRB(1)),"^",3)
+26 ;- end of code for Story 272695 Emergency Fix
End DoDot:2
+27 SET RESULTS(MHVCNT)=$GET(MHVDIEN)_"^"_$GET(MHVDCOD)_"^"_$PIECE(MHVROOTP(MHVCNT),"^",3)_"^"_$PIECE(MHVROOTP(MHVCNT),"^",13)
End DoDot:1
+28 QUIT
DIAGSRCH(RESULTS,MHVSTRING) ; Get Diagnosis codes and description from Search string
+1 ; MHVSTRING IS SEARCH STRING AND FILE TO SEARCH
+2 ; RESULTS = DIAGNOSIS CODE IEN IN FILE 80^DIAGNOSIS CODE^DESCRIPTION
+3 NEW MHVSTR,MHVCNT
+4 KILL MHVROOT
+5 ; FILENAME^ICD
+6 ;S MHVSTR=$P(MHVSTRING,U)_"^ICD|"_$P(MHVSTRING,U,2)_"|DT^"
+7 ;Fix for ICD 10 PRODUCTION ISSUE on date switch
+8 ;Item#1.Story 26244 SM WLC - ICD10 - SNOMED CT Problem List and Encounter Completion and Workload
+9 SET MHVSTR=$PIECE(MHVSTRING,U)_"^ICD|"_$PIECE(MHVSTRING,U,2)_"|"_DT_"^"
+10 DO SRCLST^ECUMRPC1(.MHVROOT,.MHVSTR)
+11 IF $GET(MHVROOT)=""
SET RESULTS(1)="^0^No results found"
QUIT
+12 SET MHVCNT=0
+13 ;Per Secure Messaging (SM) Change Request (CR)Release 12.15
+14 ;User Story: Problem List ICD-10 enhancement:
+15 ;restrict the number of records returned from VistA to 199 or less
+16 ;S I="" F S I=$O(@MHVROOT@(I)) Q:I="" D
+17 SET I=""
FOR
SET I=$ORDER(@MHVROOT@(I))
if (I="")!(MHVCNT>199)
QUIT
Begin DoDot:1
+18 SET MHVCNT=MHVCNT+1
+19 SET RESULTS(I)=@MHVROOT@(I)
+20 SET RESULTS(I)=$PIECE(RESULTS(I),"^",3)_"^"_$PIECE(RESULTS(I),"^",1)_"^"_$PIECE(RESULTS(I),"^",2)_"^"_$PIECE($PIECE(RESULTS(I),"(",2),")",1)
End DoDot:1
+21 IF MHVCNT=0
SET RESULTS(1)="^0^No results found"
QUIT
+22 QUIT
