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

XUMVINPB.m

Go to the documentation of this file. 
  1. XUMVINPB ;MVI/DRI - Master Veteran Index New Person Bulk Pull RPC ;7/29/20  13:59
  1.  ;;8.0;KERNEL;**710,725,733**;Jul 10, 1995;Build 1
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ;**710 - STORY_952862  (dri) new routine
  1.  ;**725 - STORY_1238392 (dri) add fields 7, 8, 9.2, 29, 205.1, 205.5, 8910
  1.  ;                      sort by Active, Disuser/Terminate, Visitor or All
  1.  ;**733 - STORY 1291666 (dri) add field 101.13
  1.  ;
  1.  ;Reference to ^XWB2HL7 supported by IA #3144
  1.  ;
  1.  ;
  1.  ; This functionality is called by option 'MPI BULK NEW PERSON DATA PULL'
  1.  ; (^MPINPBLK) on the MPI.
  1.  ;
  1. BULKGET(XURET,XUDUZ,XUTYPE) ;rpc to retrieve bulk pull of new person file data
  1.  ; 
  1.  ; called from rpc: XUS MVI NEW PERSON BULK GET
  1.  ;
  1.  ; Input:
  1.  ;  XUDUZ = NEW PERSON IEN TO BEGIN LOOPING ON
  1.  ;  XUTYPE = TYPE OF EXTRACT ('A'ctive, 'D'isuser/Terminated, 'V'isitor or 'ALL')
  1.  ;
  1.  ; Output:
  1.  ;  Success:
  1.  ;   XURET = ^TMP("XUMVINPB",$J)
  1.  ;    @XURET@(#) = FILE #;FIELD #<SUBFIELD #><FILE POINTER>^FIELD NAME^<COUNTER #>^INTERNAL VALUE^EXTERNAL VALUE
  1.  ;      If Counter populated, denotes multiple value <1 to n>.
  1.  ;      If multiple Subfield's, Internal and External Values will be sub-delimited by '~'.
  1.  ;    @XURET@(#)="200;IEN^DUZ^^^"
  1.  ;    @XURET@(#)="200;.01^NAME^^^"
  1.  ;    @XURET@(#)="200;.111^STREET ADDRESS 1^^^"
  1.  ;    @XURET@(#)="200;.112^STREET ADDRESS 2^^^"
  1.  ;    @XURET@(#)="200;.113^STREET ADDRESS 3^^^"
  1.  ;    @XURET@(#)="200;.114^CITY^^^"
  1.  ;    @XURET@(#)="200;.115^STATE^^^"
  1.  ;    @XURET@(#)="200;.116^ZIP CODE^^^"
  1.  ;    @XURET@(#)="200;.132^OFFICE PHONE^^^"
  1.  ;    @XURET@(#)="200;.151^EMAIL ADDRESS^^^"
  1.  ;    @XURET@(#)="200;4^SEX^^^"
  1.  ;    @XURET@(#)="200;5^DOB^^^"
  1.  ;    @XURET@(#)="200;7^DISUSER^^^"
  1.  ;    @XURET@(#)="200;8^TITLE^^^"
  1.  ;    @XURET@(#)="200;9^SSN^^^"
  1.  ;    @XURET@(#)="200;9.2^TERMINATION DATE^^^"
  1.  ;    @XURET@(#)="200;16;.01^DIVISION^<1 to n>^^"
  1.  ;    @XURET@(#)="200;10.1^NAME COMPONENTS^^^"
  1.  ;    @XURET@(#)="20;1^FAMILY (LAST) NAME^^^"
  1.  ;    @XURET@(#)="20;2^GIVEN (FIRST) NAME^^^"
  1.  ;    @XURET@(#)="20;3^MIDDLE NAME^^^"
  1.  ;    @XURET@(#)="20;4^PREFIX^^^"
  1.  ;    @XURET@(#)="20;5^SUFFIX^^^"
  1.  ;    @XURET@(#)="20;6^DEGREE^^^"
  1.  ;    @XURET@(#)="200;29^SERVICE/SECTION^^^"
  1.  ;    @XURET@(#)="200;205.1^SECID^^^"
  1.  ;    @XURET@(#)="200;205.2^SUBJECT ORGANIZATION^^^"
  1.  ;    @XURET@(#)="200;205.3^SUBJECT ORGANIZATION ID^^^"
  1.  ;    @XURET@(#)="200;205.4^UNIQUE USER ID^^^"
  1.  ;    @XURET@(#)="200;205.5^ADUPN^^^"
  1.  ;    @XURET@(#)="200;501.1^NETWORK USERNAME^^^"
  1.  ;    @XURET@(#)="200;41.99^NPI^^^"
  1.  ;    @XURET@(#)="200;53.2^DEA#^^^"
  1.  ;    @XURET@(#)="200;747.44^DEA EXPIRATION DATE^^^"
  1.  ;    @XURET@(#)="200;201^PRIMARY MENU OPTION^^^"
  1.  ;    @XURET@(#)="200;203;.01^SECONDARY MENU OPTIONS^<1 to n>^^"
  1.  ;    @XURET@(#)="200;51;.01^KEY^<1 to n>^^"
  1.  ;    @XURET@(#)="200;8910;.01~2^KEY^<1 to n>^~^~"
  1.  ;    @XURET@(#)="200;8910;.01~2^VISITED FROM~DUZ AT HOME SITE^<1 to n)^~^~1"
  1.  ;    @XURET@(#)="200;101.13;.01~.02~.03^CPRS TAB~EFFECTIVE DATE~EXPIRATION DATE^<1 to n>^~~^~~"
  1.  ;
  1.  ;    @XURET@(#)="200;EOF^EOF^" - if end of new person file reached
  1.  ;
  1.  ;  Fail:
  1.  ;   XURET = ^TMP("XUMVINPB",$J)
  1.  ;   @XURET@(1)="-1^No Data to Retrieve"
  1.  ;
  1.  ; Example calling rpc from VistA:
  1.  ;  >D BULKGET^XUMVINPB(.XURET,12595,"A")
  1.  ;  >ZW XURET
  1.  ;  >XURET="^TMP(""XUMVINPB"",17226)"
  1.  ;
  1.  ;  D ^%G would return:
  1.  ;    ^TMP("XUMVINPB",17226,1)="200;IEN^DUZ^12596^12596"
  1.  ;                          2)="200;.01^NAME^LAST,FIRST MIDDLE SUFFIX^LAST,FIRST MIDDLE SUFFIX"
  1.  ;                          3)="200;.111^STREET ADDRESS 1^^STREET ADDRESS 1^STREET ADDRESS 1"
  1.  ;                          4)="200;.112^STREET ADDRESS 2^^STREET ADDRESS 2^STREET ADDRESS 2"
  1.  ;                          #)=continuation of returned data
  1.  ;
  1.  ; Example calling rpc from MVI:
  1.  ;  D DIRECT^XWB2HL7(.XURET,SITE,"XUS MVI NEW PERSON BULK GET","",$G(XUDUZ),$G(XUTYPE))
  1.  ;
  1.  ;
  1.  K XURET
  1.  N I,CNT,FILE,FLD,FLDS,FLDNM,LINETAG,RETURN,SFILE,SFLD,XUGBL
  1.  ;
  1.  S XUGBL="^TMP("_"""XUMVINPB"""_","_$J_")"
  1.  K @XUGBL
  1.  ;
  1.  I '$D(XUDUZ) S XUDUZ=.9 ;skip over postmaster and shared mail
  1.  S LINETAG=$$LINETAG() ;get line label for type of extract requested
  1.  ;
  1.  ;lets only get the labels once per bulk run
  1.  S FILE=200
  1.  S FLDS=".01;.111;.112;.113;.114;.115;.116;.132;.151;4;5;7;8;9;9.2;16*;10.1;29;205.1;205.2;205.3;205.4;205.5;501.1;41.99;53.2;747.44;201;203*;51*;8910*;101.13*"
  1.  F I=1:1:$L(FLDS,";") S FLD=$P($P(FLDS,";",I),"*") D
  1.  .D FIELD^DID(FILE,FLD,"","LABEL","FLDNM(FILE,FLD)")
  1.  .I FLD=16 S SFILE=200.02,SFLD=.01 D FIELD^DID(SFILE,SFLD,"","LABEL","FLDNM(SFILE,SFLD)") ;division multiple
  1.  .I FLD=10.1 S SFILE=20 F SFLD=1,2,3,4,5,6 D FIELD^DID(SFILE,SFLD,"","LABEL","FLDNM(SFILE,SFLD)") ;name components
  1.  .I FLD=51 S SFILE=200.051,SFLD=.01 D FIELD^DID(SFILE,SFLD,"","LABEL","FLDNM(SFILE,SFLD)") ;keys
  1.  .I FLD=101.13 S SFILE=200.010113 F SFLD=.01,.02,.03 D FIELD^DID(SFILE,SFLD,"","LABEL","FLDNM(SFILE,SFLD)") ;cprs tab multiple
  1.  .I FLD=203 S SFILE=200.03,SFLD=.01 D FIELD^DID(SFILE,SFLD,"","LABEL","FLDNM(SFILE,SFLD)") ;secondary menu options multiple
  1.  .I FLD=8910 S SFILE=200.06 F SFLD=.01,2 D FIELD^DID(SFILE,SFLD,"","LABEL","FLDNM(SFILE,SFLD)") ;visited from multiple
  1.  ;
  1.  S CNT=1
  1.  F  S XUDUZ=$O(^VA(200,XUDUZ)) Q:'XUDUZ  D @(LINETAG_"(.RETURN,"_XUDUZ_")") I RETURN D  Q  ;get next new person for type of extract
  1.  .N XUARR
  1.  .D GETS^DIQ(FILE,+XUDUZ_",",FLDS,"EI","XUARR") ;retrieve data
  1.  .;
  1.  .S @XUGBL@(CNT)=FILE_";IEN^DUZ^^"_XUDUZ_"^"_XUDUZ S CNT=CNT+1
  1.  .;
  1.  .F I=1:1:$L(FLDS,";") S FLD=$P($P(FLDS,";",I),"*") D
  1.  ..I $S(FLD=16:1,FLD=51:1,FLD=203:1,1:0) D  Q  ;division, keys, secondary menu options multiple
  1.  ...N IENS,MCNT,SFILE,SFLD
  1.  ...S MCNT=1,SFILE=$S(FLD=16:200.02,FLD=51:200.051,FLD=203:200.03),SFLD=.01
  1.  ...I '$D(XUARR(SFILE)) S @XUGBL@(CNT)=FILE_";"_FLD_";"_SFLD_"^"_$G(FLDNM(SFILE,SFLD,"LABEL"))_"^"_MCNT_"^^" S CNT=CNT+1 Q
  1.  ...S IENS="" F  S IENS=$O(XUARR(SFILE,IENS)) Q:IENS=""  S @XUGBL@(CNT)=FILE_";"_FLD_";"_SFLD_"^"_$G(FLDNM(SFILE,SFLD,"LABEL"))_"^"_MCNT_"^"_$G(XUARR(SFILE,IENS,SFLD,"I"))_"^"_$G(XUARR(SFILE,IENS,SFLD,"E")) S MCNT=MCNT+1,CNT=CNT+1
  1.  ..;
  1.  ..I FLD=10.1 D  Q  ;name components
  1.  ...S @XUGBL@(CNT)=FILE_";"_FLD_"^"_$G(FLDNM(FILE,FLD,"LABEL"))_"^^"_$G(XUARR(FILE,XUDUZ_",",FLD,"I"))_"^"_$G(XUARR(FILE,XUDUZ_",",FLD,"E")) S CNT=CNT+1
  1.  ...N NCFILE,NCFLD
  1.  ...S NCFILE=20
  1.  ...D GETS^DIQ(NCFILE,+$G(XUARR(FILE,XUDUZ_",",FLD,"I"))_",","1;2;3;4;5;6","EI","XUARR") ;retrieve name component data
  1.  ...F NCFLD=1,2,3,4,5,6 D
  1.  ....S @XUGBL@(CNT)=NCFILE_";"_NCFLD_"^"_$G(FLDNM(NCFILE,NCFLD,"LABEL"))_"^^"_$G(XUARR(NCFILE,+$G(XUARR(FILE,XUDUZ_",",FLD,"I"))_",",NCFLD,"I"))_"^"_$G(XUARR(NCFILE,+$G(XUARR(FILE,XUDUZ_",",FLD,"I"))_",",NCFLD,"E")) S CNT=CNT+1
  1.  ..;
  1.  ..I FLD=101.13 D  Q  ;cprs tab multiple
  1.  ...N IENS,MCNT,SFILE,SFLD,SFLD2,SFLD3
  1.  ...S MCNT=1,SFILE=200.010113,SFLD=.01,SFLD2=.02,SFLD3=.03
  1.  ...I '$D(XUARR(SFILE)) S @XUGBL@(CNT)=FILE_";"_FLD_";"_SFLD_"~"_SFLD2_"~"_SFLD3_"^"_$G(FLDNM(SFILE,SFLD,"LABEL"))_"~"_$G(FLDNM(SFILE,SFLD2,"LABEL"))_"~"_$G(FLDNM(SFILE,SFLD3,"LABEL"))_"^"_MCNT_"^~~^~~",CNT=CNT+1 Q
  1.  ...S IENS="" F  S IENS=$O(XUARR(SFILE,IENS)) Q:IENS=""  D
  1.  ....S @XUGBL@(CNT)=FILE_";"_FLD_";"_SFLD_"~"_SFLD2_"~"_SFLD3_"^"_$G(FLDNM(SFILE,SFLD,"LABEL"))_"~"_$G(FLDNM(SFILE,SFLD2,"LABEL"))_"~"_$G(FLDNM(SFILE,SFLD3,"LABEL"))
  1.  ....S @XUGBL@(CNT)=@XUGBL@(CNT)_"^"_MCNT_"^"_$G(XUARR(SFILE,IENS,SFLD,"I"))_"~"_$G(XUARR(SFILE,IENS,SFLD2,"I"))_"~"_$G(XUARR(SFILE,IENS,SFLD3,"I"))
  1.  ....S @XUGBL@(CNT)=@XUGBL@(CNT)_"^"_$G(XUARR(SFILE,IENS,SFLD,"E"))_"~"_$G(XUARR(SFILE,IENS,SFLD2,"E"))_"~"_$G(XUARR(SFILE,IENS,SFLD3,"E")),MCNT=MCNT+1,CNT=CNT+1
  1.  ..;
  1.  ..I FLD=8910 D  Q  ;visited from multiple
  1.  ...N IENS,MCNT,SFILE,SFLD,SFLD2
  1.  ...S MCNT=1,SFILE=200.06,SFLD=.01,SFLD2=2
  1.  ...I '$D(XUARR(SFILE)) S @XUGBL@(CNT)=FILE_";"_FLD_";"_SFLD_"~"_SFLD2_"^"_$G(FLDNM(SFILE,SFLD,"LABEL"))_"~"_$G(FLDNM(SFILE,SFLD2,"LABEL"))_"^"_MCNT_"^~^~",CNT=CNT+1 Q
  1.  ...S IENS="" F  S IENS=$O(XUARR(SFILE,IENS)) Q:IENS=""  D
  1.  ....S @XUGBL@(CNT)=FILE_";"_FLD_";"_SFLD_"~"_SFLD2_"^"_$G(FLDNM(SFILE,SFLD,"LABEL"))_"~"_$G(FLDNM(SFILE,SFLD2,"LABEL"))
  1.  ....S @XUGBL@(CNT)=@XUGBL@(CNT)_"^"_MCNT_"^"_$G(XUARR(SFILE,IENS,SFLD,"I"))_"~"_$G(XUARR(SFILE,IENS,SFLD2,"I"))_"^"_$G(XUARR(SFILE,IENS,SFLD,"E"))_"~"_$G(XUARR(SFILE,IENS,SFLD2,"E")),MCNT=MCNT+1,CNT=CNT+1
  1.  ..;
  1.  ..S @XUGBL@(CNT)=FILE_";"_FLD_"^"_$G(FLDNM(FILE,FLD,"LABEL"))_"^^"_$G(XUARR(FILE,XUDUZ_",",FLD,"I"))_"^"_$G(XUARR(FILE,XUDUZ_",",FLD,"E")) S CNT=CNT+1 ;all other fields
  1.  ;
  1.  I 'XUDUZ S @XUGBL@(CNT)=FILE_";EOF^EOF^" ;end of file, no more new persons
  1.  I '$D(@XUGBL) S @XUGBL@(CNT)="-1^No Data to Retrieve"
  1.  ;
  1.  S XURET=$NA(@XUGBL)
  1.  Q
  1.  ;
  1. LINETAG() ;return line tag for type of extract requested
  1.  Q $S(XUTYPE="A":"ACTIVE",XUTYPE="D":"DISTERM",XUTYPE="V":"VISITOR",XUTYPE="ALL":"ALL",1:"UNKNOWN")
  1.  ;
  1. ACTIVE(RETURN,XUDUZ) ;person is not disuser'd, not terminated, has primary menu option
  1.  N FILE,FLDS,XUARR
  1.  K RETURN
  1.  S RETURN=0
  1.  S FILE=200,FLDS="7;9.2;201" ;disuser; termination date; primary menu option
  1.  D GETS^DIQ(FILE,+XUDUZ_",",FLDS,"EI","XUARR") ;retrieve data
  1.  I $G(XUARR(FILE,+XUDUZ_",",7,"I"))'=1,($G(XUARR(FILE,+XUDUZ_",",9.2,"I"))=""!($G(XUARR(FILE,+XUDUZ_",",9.2,"I"))>DT)),($G(XUARR(FILE,+XUDUZ_",",201,"I"))'="") S RETURN=1 Q
  1.  Q
  1.  ;
  1. DISTERM(RETURN,XUDUZ) ;person is disuser'd or terminated
  1.  N FILE,FLDS,XUARR
  1.  K RETURN
  1.  S RETURN=0
  1.  S FILE=200,FLDS="7;9.2" ;disuser; termination date
  1.  D GETS^DIQ(FILE,+XUDUZ_",",FLDS,"EI","XUARR") ;retrieve data
  1.  I $S($G(XUARR(FILE,+XUDUZ_",",7,"I"))=1:1,($G(XUARR(FILE,+XUDUZ_",",9.2,"I"))'=""&($G(XUARR(FILE,+XUDUZ_",",9.2,"I"))'>DT)):1,1:0) S RETURN=1 Q
  1.  Q
  1.  ;
  1. VISITOR(RETURN,XUDUZ) ;person has visitor records
  1.  K RETURN
  1.  S RETURN=0
  1.  ;I $O(^VA(200,XUDUZ,8910,0)),$P($G(^VA(200,XUDUZ,201)),"^",1)'="" S RETURN=1 Q  ;must have visitor records and a primary menu option (currently not utilized)
  1.  I $O(^VA(200,XUDUZ,8910,0)) S RETURN=1 Q
  1.  Q
  1. ALL(RETURN,XUDUZ) ;retrieve all persons
  1.  K RETURN
  1.  S RETURN=0
  1.  I XUDUZ S RETURN=1
  1.  Q
  1.  ;