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

MHVUMRPC.m

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