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

XUMF04.m

Go to the documentation of this file. 
  1. XUMF04 ;BP/RAM - INSTITUTION SEGMENTS ;12/02/2019
  1.  ;;8.0;KERNEL;**549,678,723**;Jul 10, 1995;Build 3
  1.  ;;Per VA Directive 6402, this routine should not be modified
  1.  ;
  1.  Q
  1.  ;
  1. MSA(ERROR,HLFS,HL) ; - ACK 
  1.  ;
  1.  S:$G(HLFS)="" HLFS="^"
  1.  ;
  1.  Q "MSA"_HLFS_$S(ERROR:"AE",1:"AA")_HLFS_$G(HL("MID"))
  1.  ;
  1. QRD(HLFS,WHO) ; -- query definition segment
  1.  ;
  1.  S:$G(HLFS)="" HLFS="^"
  1.  S:$G(WHO)="" WHO="VASTANUM"
  1.  ;
  1.  N QDT,QFC,QP,QID,ZDRT,ZDRDT,QLR,WHAT,WDDC,WDCVQ,QRL,QRD
  1.  ;
  1.  S QDT=$$HLDATE^HLFNC($$NOW^XLFDT)
  1.  S QFC="R"
  1.  S QP="I"
  1.  S QID="Z04"
  1.  S ZDRT=""
  1.  S ZDRDT=""
  1.  S QLR="RD"_HLCS_999
  1.  S WHAT="INSTITUTION"
  1.  S WDDC="VA"
  1.  S WDCVQ=""
  1.  S QRL=""
  1.  S QRD="QRD"_HLFS_QDT_HLFS_QFC_HLFS_QP_HLFS_QID_HLFS_ZDRT_HLFS_ZDRDT
  1.  S QRD=QRD_HLFS_QLR_HLFS_WHO_HLFS_WHAT_HLFS_WDDC_HLFS_WDCVQ_HLFS_QRL
  1.  ;
  1.  Q QRD
  1.  ;
  1. MFI() ; master file identifier segment
  1.  ;
  1.  N ID,APP,EVENT,ENDT,EFFDT,RESP,MFI
  1.  ;
  1.  S ID="Z04"
  1.  S APP="MFS"
  1.  S EVENT="UPD"
  1.  S ENDT=$$NOW^XLFDT
  1.  S EFFDT=$$NOW^XLFDT
  1.  S RESP="NE"
  1.  S MFI=$$MFI^XUMFMFI(ID,APP,EVENT,ENDT,EFFDT,RESP)
  1.  ;
  1.  Q MFI
  1.  ;
  1. MFE(IEN) ; master file entry segment
  1.  ;
  1.  N EVENT,MFN,EDT,CODE,MFE
  1.  ;
  1.  S EVENT="MUP"
  1.  S MFN=""
  1.  S EDT=$$NOW^XLFDT
  1.  S CODE=$$CODESYS(IEN)
  1.  S MFE=$$MFE^XUMFMFE(EVENT,MFN,EDT,CODE)
  1.  ;
  1.  Q MFE
  1.  ;
  1. ZIN(IEN,NODE,HLFS,HLCS) ; ZIN segment
  1.  ;
  1.  N IENS,NAME,STATE,STREET1,STREET2,CITY,ZIP,ST1,ST2,CITY1,STATE1,ZIP1
  1.  N X,ARRAY,BILLNAME,NPIDT,TAX,TAXSTAT,TAXPC,CLIA,DMIS,MAMMO
  1.  N STATUS,FACTYP,AGENCY,STANUM,OFFNAME,INACTIVE,VISN,PARENT,NPI,NPISTAT
  1.  N LOCTZONE,COUNTRY,TZONEX,CERNER
  1.  ;
  1.  S IENS=IEN_","
  1.  ;
  1.  S:$G(HLFS)="" HLFS="^"
  1.  S:$G(HLCS)="" HLCS="~"
  1.  ;
  1.  D GETS^DIQ(4,IENS,"*","","ARRAY")
  1.  ;
  1.  S NAME=ARRAY(4,IENS,.01)
  1.  S STATE=ARRAY(4,IENS,.02)
  1.  S STREET1=ARRAY(4,IENS,1.01)
  1.  S STREET2=ARRAY(4,IENS,1.02)
  1.  S CITY=ARRAY(4,IENS,1.03)
  1.  S ZIP=ARRAY(4,IENS,1.04)
  1.  S ST1=ARRAY(4,IENS,4.01)
  1.  S ST2=ARRAY(4,IENS,4.02)
  1.  S CITY1=ARRAY(4,IENS,4.03)
  1.  S STATE1=ARRAY(4,IENS,4.04)
  1.  S ZIP1=ARRAY(4,IENS,4.05)
  1.  S STATUS=ARRAY(4,IENS,11)
  1.  S FACTYP=ARRAY(4,IENS,13)
  1.  S AGENCY=ARRAY(4,IENS,95)
  1.  S STANUM=ARRAY(4,IENS,99)
  1.  S OFFNAME=ARRAY(4,IENS,100)
  1.  S INACTIVE=ARRAY(4,IENS,101)
  1.  S CERNER=ARRAY(4,IENS,102) ;723
  1.  S BILLNAME=ARRAY(4,IENS,200)
  1.  S LOCTZONE=ARRAY(4,IENS,800)
  1.  S COUNTRY=ARRAY(4,IENS,801)
  1.  S TZONEX=ARRAY(4,IENS,802)
  1.  S VISN=$P($G(^DIC(4,+$P($G(^DIC(4,+IEN,7,1,0)),U,2),0)),U)
  1.  S PARENT=$P($G(^DIC(4,+$P($G(^DIC(4,+IEN,7,2,0)),U,2),99)),U)
  1.  S NPI=$$NPI^XUSNPI("Organization_ID",IEN)
  1.  S:$P(NPI,U)="-1" NPI=""
  1.  S NPIDT=$$HLDATE^HLFNC($P(NPI,U,2))
  1.  S NPISTAT=$$UP^XLFSTR($P(NPI,U,3))
  1.  S NPI=$P(NPI,U)
  1.  ;S TAX=$$TAXORG^XUSTAX(IEN)
  1.  ;S X=$P(TAX,U,2),TAX=$P(TAX,U)
  1.  ;S:X X=$O(^DIC(4,IEN,"TAXONOMY","B",X,0))
  1.  S TAX=$O(^DIC(4,IEN,"TAXONOMY","A"),-1)
  1.  I TAX'>0 S TAX=""
  1.  I TAX>0 S X=$G(^DIC(4,IEN,"TAXONOMY",TAX,0))
  1.  I +$G(X)>0 S TAX=$P($G(^USC(8932.1,+X,0)),"^",7) D
  1.  . ;S X=$G(^DIC(4,+IEN,"TAXONOMY",+$G(TAX),0))
  1.  . S TAXPC=$S('X:"",$P(X,U,2)=1:"YES",1:"NO")
  1.  . S TAXSTAT=$S('X:"",$P(X,U,3)="A":"ACTIVE",1:"INACTIVE")
  1.  S TAX=$G(TAX),TAXPC=$G(TAXPC),TAXSTAT=$G(TAXSTAT)
  1.  S CLIA=$$ID^XUAF4("CLIA",IEN)
  1.  S MAMMO=$$ID^XUAF4("MAMMO-ACR",IEN)
  1.  S DMIS=$$ID^XUAF4("DMIS",IEN)
  1.  ;
  1.  S NODE="ZIN"_HLFS_NAME_HLFS_STANUM_HLFS_STATUS_HLFS_FACTYP_HLFS
  1.  S NODE(1)=OFFNAME_HLFS_INACTIVE_HLFS_STATE_HLFS_VISN_HLFS_PARENT
  1.  S NODE(1)=NODE(1)_HLFS_HLFS_HLFS_HLFS_HLFS
  1.  S NODE(2)=STREET1_HLCS_STREET2_HLCS_CITY_HLCS_STATE_HLCS_ZIP_HLCS_COUNTRY_HLFS
  1.  S NODE(3)=ST1_HLCS_ST2_HLCS_CITY1_HLCS_STATE1_HLCS_ZIP1_HLFS
  1.  S NODE(4)=AGENCY_HLFS_NPI_HLFS_NPISTAT_HLFS_NPIDT_HLFS_TAX_HLFS
  1.  S NODE(4)=NODE(4)_TAXSTAT_HLFS_TAXPC_HLFS
  1.  S NODE(4)=NODE(4)_CLIA_HLFS_MAMMO_HLFS_DMIS_HLFS_BILLNAME_HLFS
  1.  S NODE(5)=LOCTZONE_HLFS_TZONEX_HLFS_CERNER
  1.  ;
  1.  Q
  1.  ;
  1. CODESYS(IEN) ; coding system / id
  1.  ;
  1.  N X
  1.  ;
  1.  S X=$$STA^XUAF4(IEN) Q:X X_"~"_$P(^DIC(4,IEN,0),U)_"~VASTANUM"
  1.  ;
  1.  S X=$$ID^XUAF4("NPI",IEN) Q:X'="" X_"~"_$P(^DIC(4,IEN,0),U)_"~NPI"
  1.  ;
  1.  S X=$$ID^XUAF4("DMIS",IEN) Q:X'="" X_"~"_$P(^DIC(4,IEN,0),U)_"~DMIS"
  1.  ;
  1.  Q 0
  1.  ;