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

MHVXUSR.m

Go to the documentation of this file. 
  1. MHVXUSR ;WAS/DLF/MJK - User extract ; 5/6/10 4:12pm
  1.  ;;1.0;My HealtheVet;**6,29**;July 10, 2017;Build 73
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;  Integration Agreements:
  1.  ;       10060 : New Person file #200
  1.  ;       2343  : $$ACTIVE^XUSER(Y)
  1.  ;       10103 : $$DT^XLFDT
  1.  ;               $$NOW^XLFDT
  1.  ;       10076 : Read ^XUSEC("PROVIDER",DUZ
  1.  ;       1625  : PERSON CLASS- PROVIDER TYPE - CLASSIFICATION (File #8932.1)
  1.  ;               $$GET^XUA4A72(USRIEN) - Patch 29
  1.  ;       10093 : SERVICE/SECTION file #49
  1.  ;       2533  : $$DIV4^XUSER(.ZZ[,duz])- DIVISIONS - Patch 29
  1.  ;
  1. USERS(QRY,ERR,DATAROOT)        ; return users from file 200
  1.  ;
  1.  ; Primary Care Management Module interface
  1.  ; return user data in DATAROOT
  1.  ; QRY, ERR passed by ref.
  1.  ;
  1.  ;  Input:
  1.  ;       QRY - Query array
  1.  ;       ERR - Variable to hold error conditions
  1.  ;       DATAROOT - Root of array to hold extract data
  1.  ;  Output:
  1.  ;       DATAROOT - Populated data array
  1.  ;                  includes number of hits and timestamp
  1.  ;       ERR - Errors during extraction, zero on success
  1.  ;
  1.  ;
  1.  ;
  1.  D LOG^MHVUL2("USERS~MHVXUSR","BEGIN","S","TRACE")
  1.  ;
  1.  K @DATAROOT,^TMP("MHXUSR",$J)  ; clean up residue
  1.  ;
  1.  N NXT,IIEN,NODE,TEAM,OUT,MHVPURPA,MHVROLEA,MHVLIST,MHVERR
  1.  N DIERR,DT,EXTIME,HIT,LOGND,RTN,TMIEN,NM,U,X
  1.  N USRNAME,USROUT,USRFNAME,OUT,PPHONE,SSECTION,USRIEN,PRV,TTITLE
  1.  N PRVCLS,REQSIG,NETWKID
  1.  N PERSCLS,PCEFDT,PCEXDT,PROVSPEC,PROVDIVS,USERCLS,DATARSTR,I,RETST,SUB
  1.  ;
  1.  S U="^",DT=$$DT^XLFDT,ERR=0,EXTIME=$$NOW^XLFDT,HIT=0
  1.  ;
  1.  S OUT=$NA(^TMP("MHVXUSR",$J))
  1.  S NXT=0,IIEN=0
  1.  K @OUT
  1.  ;
  1.  ;FIND ALL ACTIVE NEW PERSONS THAT MATCH ENTRY
  1.  ;
  1.  I QRY("IEN")=""  D    ; Name lookup
  1.  . ;JAZZ#409966-Fix Names with Space in SM queries;and more User Fields - existing issue
  1.  . ;retrieve only active user patrial match - if Name passed in
  1.  . D LIST^DIC(200,"","","",,QRY("LNAME"),QRY("LNAME"),"B","I $$ACTIVE^XUSER(Y)","",OUT)
  1.  E  D  ; Lookup by IEN
  1.  . ;JAZZ#409966-Fix Names with Space in SM queries;and more User Fields - existing issue
  1.  . ;retrieve both active and inactive user for exact DUZ match -
  1.  . S @OUT@("DILIST",2,1)=QRY("IEN")
  1.  ;
  1.  ;$O through the OUT array to get the IEN to check for roles
  1.  ;
  1.  S IIEN="",HIT=0
  1.  F  S IIEN=$O(@OUT@("DILIST",2,IIEN)) Q:IIEN=""  D
  1.  .S USRIEN=@OUT@("DILIST",2,IIEN)
  1.  . ; Fieds extracted pre-patch 29:
  1.  . ; - #.01 NAME                - AI#10060 New Person file #200
  1.  . ; - #.132 OFFICE PHONE       - AI#10060 New Person file #200
  1.  . ; - #8 TITLE                 - AI#10060 New Person file #200
  1.  . ; - #29 SERVICE/SECTION      - AI#10093 SERVICE/SECTION file #49
  1.  . ;-----------------------------------------------------------------------------------------
  1.  . ;JAZZ#409966-Fix Names with Space in SM queries- existing issue;and more User Fields;ADDED:
  1.  . ; - #53.5-PROVIDER CLASS - POINTER TO #7 PROVIDER CLASS FILE - AI#10060
  1.  . ; - #53.7 REQUIRES COSIGNER - AI#10060
  1.  . ; - #501.1 NETWORK ID - AI#10060
  1.  . ; - #8932.1-PERSON CLASS-PROVIDER TYPE-CLASSIFICATION -today's active-AI#1625
  1.  . ;        .01  Person Class (*P8932.1'a), [0;1]
  1.  . ;         2    Effective Date (RDXa), [0;2]
  1.  . ;         3    Expiration Date (Da), [0;3]
  1.  . ; - #747.111-SPECIALTY -[pointer to SPECIALTY file (#747.9)]-today's active-above call- AI#1625
  1.  . ; - #16- DIVISION (multiple) [pointer to INSTITUTION FILE (#4)] - AI#2533
  1.  . ;        $$DIV4^XUSER(.ZZ[,duz])- DIVISIONS
  1.  . ;-----------------------------------------------------------------------------------------
  1.  .;D GETS^DIQ(200,USRIEN_",",".01;.132;8;29","E","USROUT","DIERR")
  1.  .K DIERR
  1.  .D GETS^DIQ(200,USRIEN_",",".01;.132;8;29;53.5;53.7;501.1","E","USROUT","DIERR")
  1.  .Q:$G(DIERR)
  1.  .S USRNAME=$G(USROUT(200,USRIEN_",",.01,"E"))
  1.  .S USRFNAME=$P(USRNAME,",",2)
  1.  .Q:$E(USRFNAME,1,$L(QRY("FNAME")))'=QRY("FNAME")
  1.  .S PPHONE=$G(USROUT(200,USRIEN_",",.132,"E"))
  1.  .S TTITLE=$G(USROUT(200,USRIEN_",",8,"E"))
  1.  .S SSECTION=$G(USROUT(200,USRIEN_",",29,"E"))
  1.  .S PRV="",PRVCLS="",REQSIG="",NETWKID=""
  1.  .I $D(^XUSEC("PROVIDER",USRIEN)) S PRV="PROVIDER"
  1.  .S PRVCLS=$G(USROUT(200,USRIEN_",",53.5,"E"))
  1.  .S REQSIG=$G(USROUT(200,USRIEN_",",53.7,"E"))
  1.  .S NETWKID=$G(USROUT(200,USRIEN_",",501.1,"E"))
  1.  .;PERSON CLASS-EFFECTIVE DATE;EXPIRATION DATE; SPECIALTY(multiple)-only there is an active entry -#1625
  1.  .S RETST="",PERSCLS="",PCEFDT="",PCEXDT="",PROVSPEC=""
  1.  .S RETST=$$GET^XUA4A72(USRIEN)
  1.  .;PERSON CLASS; EFFECTIVE DATE; EXPIRATION DATE;SPECIALTY- AI#1625
  1.  .I RETST>0 D
  1.  .. S PERSCLS=$P(RETST,"^",2)
  1.  .. S PCEFDT=$P(RETST,"^",5),PCEXDT=$P(RETST,"^",6)
  1.  .. S PROVSPEC=$P(RETST,"^",3)
  1.  .I RETST<=0 D
  1.  .. I RETST=-1 S PERSCLS="Person Class never assigned"
  1.  .. I RETST=-2 S PERSCLS="No active Person Class"
  1.  .;DIVISION (multiple)
  1.  .K DIERR
  1.  .D GETS^DIQ(200,USRIEN_",","16*","E","USROUT","DIERR")
  1.  .S PROVDIVS=""
  1.  .S SUB="0,"_USRIEN_","
  1.  .F  S SUB=$O(USROUT(200.02,SUB)) Q:SUB'[USRIEN_","  D
  1.  .. I $D(USROUT(200.02,SUB))>1 D 
  1.  ... S PROVDIVS=PROVDIVS_$G(USROUT(200.02,SUB,.01,"E"))_"~"_$G(USROUT(200.02,SUB,1,"E"))_"_"
  1.  .S HIT=HIT+1
  1.  .;JAZZ#409966-Fix Names with Space in SM queries- existing issue;and more User Fields
  1.  .;S @DATAROOT@(HIT)=USRIEN_U_USRNAME_U_PRV_U_U_U_U_PPHONE_U_SSECTION_U_TTITLE
  1.  .S DATARSTR=USRIEN_U_USRNAME_U_PRV_U_PRVCLS_U_PROVSPEC_U_REQSIG_U_PPHONE_U_SSECTION_U_TTITLE_U_NETWKID
  1.  .S DATARSTR=DATARSTR_U_PERSCLS_U_PCEFDT_U_PCEXDT_U_PROVDIVS
  1.  .S @DATAROOT@(HIT)=DATARSTR
  1.  ;
  1.  ; Update dataroot with number of hits and
  1.  ; write to the log
  1.  ;
  1.  K @OUT
  1.  S @DATAROOT=HIT_U_EXTIME  ; count of hits ^ time
  1.  D LOG^MHVUL2("USERS~MHVXUSR",HIT_" HITS","S","TRACE")
  1.  D LOG^MHVUL2("USERS~MHVXUSR","END","S","TRACE")
  1.  Q