XUMF04 ;BP/RAM - INSTITUTION SEGMENTS ;12/02/2019
;;8.0;KERNEL;**549,678,723**;Jul 10, 1995;Build 3
;;Per VA Directive 6402, this routine should not be modified
;
Q
;
MSA(ERROR,HLFS,HL) ; - ACK
;
S:$G(HLFS)="" HLFS="^"
;
Q "MSA"_HLFS_$S(ERROR:"AE",1:"AA")_HLFS_$G(HL("MID"))
;
QRD(HLFS,WHO) ; -- query definition segment
;
S:$G(HLFS)="" HLFS="^"
S:$G(WHO)="" WHO="VASTANUM"
;
N QDT,QFC,QP,QID,ZDRT,ZDRDT,QLR,WHAT,WDDC,WDCVQ,QRL,QRD
;
S QDT=$$HLDATE^HLFNC($$NOW^XLFDT)
S QFC="R"
S QP="I"
S QID="Z04"
S ZDRT=""
S ZDRDT=""
S QLR="RD"_HLCS_999
S WHAT="INSTITUTION"
S WDDC="VA"
S WDCVQ=""
S QRL=""
S QRD="QRD"_HLFS_QDT_HLFS_QFC_HLFS_QP_HLFS_QID_HLFS_ZDRT_HLFS_ZDRDT
S QRD=QRD_HLFS_QLR_HLFS_WHO_HLFS_WHAT_HLFS_WDDC_HLFS_WDCVQ_HLFS_QRL
;
Q QRD
;
MFI() ; master file identifier segment
;
N ID,APP,EVENT,ENDT,EFFDT,RESP,MFI
;
S ID="Z04"
S APP="MFS"
S EVENT="UPD"
S ENDT=$$NOW^XLFDT
S EFFDT=$$NOW^XLFDT
S RESP="NE"
S MFI=$$MFI^XUMFMFI(ID,APP,EVENT,ENDT,EFFDT,RESP)
;
Q MFI
;
MFE(IEN) ; master file entry segment
;
N EVENT,MFN,EDT,CODE,MFE
;
S EVENT="MUP"
S MFN=""
S EDT=$$NOW^XLFDT
S CODE=$$CODESYS(IEN)
S MFE=$$MFE^XUMFMFE(EVENT,MFN,EDT,CODE)
;
Q MFE
;
ZIN(IEN,NODE,HLFS,HLCS) ; ZIN segment
;
N IENS,NAME,STATE,STREET1,STREET2,CITY,ZIP,ST1,ST2,CITY1,STATE1,ZIP1
N X,ARRAY,BILLNAME,NPIDT,TAX,TAXSTAT,TAXPC,CLIA,DMIS,MAMMO
N STATUS,FACTYP,AGENCY,STANUM,OFFNAME,INACTIVE,VISN,PARENT,NPI,NPISTAT
N LOCTZONE,COUNTRY,TZONEX,CERNER
;
S IENS=IEN_","
;
S:$G(HLFS)="" HLFS="^"
S:$G(HLCS)="" HLCS="~"
;
D GETS^DIQ(4,IENS,"*","","ARRAY")
;
S NAME=ARRAY(4,IENS,.01)
S STATE=ARRAY(4,IENS,.02)
S STREET1=ARRAY(4,IENS,1.01)
S STREET2=ARRAY(4,IENS,1.02)
S CITY=ARRAY(4,IENS,1.03)
S ZIP=ARRAY(4,IENS,1.04)
S ST1=ARRAY(4,IENS,4.01)
S ST2=ARRAY(4,IENS,4.02)
S CITY1=ARRAY(4,IENS,4.03)
S STATE1=ARRAY(4,IENS,4.04)
S ZIP1=ARRAY(4,IENS,4.05)
S STATUS=ARRAY(4,IENS,11)
S FACTYP=ARRAY(4,IENS,13)
S AGENCY=ARRAY(4,IENS,95)
S STANUM=ARRAY(4,IENS,99)
S OFFNAME=ARRAY(4,IENS,100)
S INACTIVE=ARRAY(4,IENS,101)
S CERNER=ARRAY(4,IENS,102) ;723
S BILLNAME=ARRAY(4,IENS,200)
S LOCTZONE=ARRAY(4,IENS,800)
S COUNTRY=ARRAY(4,IENS,801)
S TZONEX=ARRAY(4,IENS,802)
S VISN=$P($G(^DIC(4,+$P($G(^DIC(4,+IEN,7,1,0)),U,2),0)),U)
S PARENT=$P($G(^DIC(4,+$P($G(^DIC(4,+IEN,7,2,0)),U,2),99)),U)
S NPI=$$NPI^XUSNPI("Organization_ID",IEN)
S:$P(NPI,U)="-1" NPI=""
S NPIDT=$$HLDATE^HLFNC($P(NPI,U,2))
S NPISTAT=$$UP^XLFSTR($P(NPI,U,3))
S NPI=$P(NPI,U)
;S TAX=$$TAXORG^XUSTAX(IEN)
;S X=$P(TAX,U,2),TAX=$P(TAX,U)
;S:X X=$O(^DIC(4,IEN,"TAXONOMY","B",X,0))
S TAX=$O(^DIC(4,IEN,"TAXONOMY","A"),-1)
I TAX'>0 S TAX=""
I TAX>0 S X=$G(^DIC(4,IEN,"TAXONOMY",TAX,0))
I +$G(X)>0 S TAX=$P($G(^USC(8932.1,+X,0)),"^",7) D
. ;S X=$G(^DIC(4,+IEN,"TAXONOMY",+$G(TAX),0))
. S TAXPC=$S('X:"",$P(X,U,2)=1:"YES",1:"NO")
. S TAXSTAT=$S('X:"",$P(X,U,3)="A":"ACTIVE",1:"INACTIVE")
S TAX=$G(TAX),TAXPC=$G(TAXPC),TAXSTAT=$G(TAXSTAT)
S CLIA=$$ID^XUAF4("CLIA",IEN)
S MAMMO=$$ID^XUAF4("MAMMO-ACR",IEN)
S DMIS=$$ID^XUAF4("DMIS",IEN)
;
S NODE="ZIN"_HLFS_NAME_HLFS_STANUM_HLFS_STATUS_HLFS_FACTYP_HLFS
S NODE(1)=OFFNAME_HLFS_INACTIVE_HLFS_STATE_HLFS_VISN_HLFS_PARENT
S NODE(1)=NODE(1)_HLFS_HLFS_HLFS_HLFS_HLFS
S NODE(2)=STREET1_HLCS_STREET2_HLCS_CITY_HLCS_STATE_HLCS_ZIP_HLCS_COUNTRY_HLFS
S NODE(3)=ST1_HLCS_ST2_HLCS_CITY1_HLCS_STATE1_HLCS_ZIP1_HLFS
S NODE(4)=AGENCY_HLFS_NPI_HLFS_NPISTAT_HLFS_NPIDT_HLFS_TAX_HLFS
S NODE(4)=NODE(4)_TAXSTAT_HLFS_TAXPC_HLFS
S NODE(4)=NODE(4)_CLIA_HLFS_MAMMO_HLFS_DMIS_HLFS_BILLNAME_HLFS
S NODE(5)=LOCTZONE_HLFS_TZONEX_HLFS_CERNER
;
Q
;
CODESYS(IEN) ; coding system / id
;
N X
;
S X=$$STA^XUAF4(IEN) Q:X X_"~"_$P(^DIC(4,IEN,0),U)_"~VASTANUM"
;
S X=$$ID^XUAF4("NPI",IEN) Q:X'="" X_"~"_$P(^DIC(4,IEN,0),U)_"~NPI"
;
S X=$$ID^XUAF4("DMIS",IEN) Q:X'="" X_"~"_$P(^DIC(4,IEN,0),U)_"~DMIS"
;
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMF04 4005 printed Sep 23, 2025@19:46:20 Page 2
XUMF04 ;BP/RAM - INSTITUTION SEGMENTS ;12/02/2019
+1 ;;8.0;KERNEL;**549,678,723**;Jul 10, 1995;Build 3
+2 ;;Per VA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
MSA(ERROR,HLFS,HL) ; - ACK
+1 ;
+2 if $GET(HLFS)=""
SET HLFS="^"
+3 ;
+4 QUIT "MSA"_HLFS_$SELECT(ERROR:"AE",1:"AA")_HLFS_$GET(HL("MID"))
+5 ;
QRD(HLFS,WHO) ; -- query definition segment
+1 ;
+2 if $GET(HLFS)=""
SET HLFS="^"
+3 if $GET(WHO)=""
SET WHO="VASTANUM"
+4 ;
+5 NEW QDT,QFC,QP,QID,ZDRT,ZDRDT,QLR,WHAT,WDDC,WDCVQ,QRL,QRD
+6 ;
+7 SET QDT=$$HLDATE^HLFNC($$NOW^XLFDT)
+8 SET QFC="R"
+9 SET QP="I"
+10 SET QID="Z04"
+11 SET ZDRT=""
+12 SET ZDRDT=""
+13 SET QLR="RD"_HLCS_999
+14 SET WHAT="INSTITUTION"
+15 SET WDDC="VA"
+16 SET WDCVQ=""
+17 SET QRL=""
+18 SET QRD="QRD"_HLFS_QDT_HLFS_QFC_HLFS_QP_HLFS_QID_HLFS_ZDRT_HLFS_ZDRDT
+19 SET QRD=QRD_HLFS_QLR_HLFS_WHO_HLFS_WHAT_HLFS_WDDC_HLFS_WDCVQ_HLFS_QRL
+20 ;
+21 QUIT QRD
+22 ;
MFI() ; master file identifier segment
+1 ;
+2 NEW ID,APP,EVENT,ENDT,EFFDT,RESP,MFI
+3 ;
+4 SET ID="Z04"
+5 SET APP="MFS"
+6 SET EVENT="UPD"
+7 SET ENDT=$$NOW^XLFDT
+8 SET EFFDT=$$NOW^XLFDT
+9 SET RESP="NE"
+10 SET MFI=$$MFI^XUMFMFI(ID,APP,EVENT,ENDT,EFFDT,RESP)
+11 ;
+12 QUIT MFI
+13 ;
MFE(IEN) ; master file entry segment
+1 ;
+2 NEW EVENT,MFN,EDT,CODE,MFE
+3 ;
+4 SET EVENT="MUP"
+5 SET MFN=""
+6 SET EDT=$$NOW^XLFDT
+7 SET CODE=$$CODESYS(IEN)
+8 SET MFE=$$MFE^XUMFMFE(EVENT,MFN,EDT,CODE)
+9 ;
+10 QUIT MFE
+11 ;
ZIN(IEN,NODE,HLFS,HLCS) ; ZIN segment
+1 ;
+2 NEW IENS,NAME,STATE,STREET1,STREET2,CITY,ZIP,ST1,ST2,CITY1,STATE1,ZIP1
+3 NEW X,ARRAY,BILLNAME,NPIDT,TAX,TAXSTAT,TAXPC,CLIA,DMIS,MAMMO
+4 NEW STATUS,FACTYP,AGENCY,STANUM,OFFNAME,INACTIVE,VISN,PARENT,NPI,NPISTAT
+5 NEW LOCTZONE,COUNTRY,TZONEX,CERNER
+6 ;
+7 SET IENS=IEN_","
+8 ;
+9 if $GET(HLFS)=""
SET HLFS="^"
+10 if $GET(HLCS)=""
SET HLCS="~"
+11 ;
+12 DO GETS^DIQ(4,IENS,"*","","ARRAY")
+13 ;
+14 SET NAME=ARRAY(4,IENS,.01)
+15 SET STATE=ARRAY(4,IENS,.02)
+16 SET STREET1=ARRAY(4,IENS,1.01)
+17 SET STREET2=ARRAY(4,IENS,1.02)
+18 SET CITY=ARRAY(4,IENS,1.03)
+19 SET ZIP=ARRAY(4,IENS,1.04)
+20 SET ST1=ARRAY(4,IENS,4.01)
+21 SET ST2=ARRAY(4,IENS,4.02)
+22 SET CITY1=ARRAY(4,IENS,4.03)
+23 SET STATE1=ARRAY(4,IENS,4.04)
+24 SET ZIP1=ARRAY(4,IENS,4.05)
+25 SET STATUS=ARRAY(4,IENS,11)
+26 SET FACTYP=ARRAY(4,IENS,13)
+27 SET AGENCY=ARRAY(4,IENS,95)
+28 SET STANUM=ARRAY(4,IENS,99)
+29 SET OFFNAME=ARRAY(4,IENS,100)
+30 SET INACTIVE=ARRAY(4,IENS,101)
+31 ;723
SET CERNER=ARRAY(4,IENS,102)
+32 SET BILLNAME=ARRAY(4,IENS,200)
+33 SET LOCTZONE=ARRAY(4,IENS,800)
+34 SET COUNTRY=ARRAY(4,IENS,801)
+35 SET TZONEX=ARRAY(4,IENS,802)
+36 SET VISN=$PIECE($GET(^DIC(4,+$PIECE($GET(^DIC(4,+IEN,7,1,0)),U,2),0)),U)
+37 SET PARENT=$PIECE($GET(^DIC(4,+$PIECE($GET(^DIC(4,+IEN,7,2,0)),U,2),99)),U)
+38 SET NPI=$$NPI^XUSNPI("Organization_ID",IEN)
+39 if $PIECE(NPI,U)="-1"
SET NPI=""
+40 SET NPIDT=$$HLDATE^HLFNC($PIECE(NPI,U,2))
+41 SET NPISTAT=$$UP^XLFSTR($PIECE(NPI,U,3))
+42 SET NPI=$PIECE(NPI,U)
+43 ;S TAX=$$TAXORG^XUSTAX(IEN)
+44 ;S X=$P(TAX,U,2),TAX=$P(TAX,U)
+45 ;S:X X=$O(^DIC(4,IEN,"TAXONOMY","B",X,0))
+46 SET TAX=$ORDER(^DIC(4,IEN,"TAXONOMY","A"),-1)
+47 IF TAX'>0
SET TAX=""
+48 IF TAX>0
SET X=$GET(^DIC(4,IEN,"TAXONOMY",TAX,0))
+49 IF +$GET(X)>0
SET TAX=$PIECE($GET(^USC(8932.1,+X,0)),"^",7)
Begin DoDot:1
+50 ;S X=$G(^DIC(4,+IEN,"TAXONOMY",+$G(TAX),0))
+51 SET TAXPC=$SELECT('X:"",$PIECE(X,U,2)=1:"YES",1:"NO")
+52 SET TAXSTAT=$SELECT('X:"",$PIECE(X,U,3)="A":"ACTIVE",1:"INACTIVE")
End DoDot:1
+53 SET TAX=$GET(TAX)
SET TAXPC=$GET(TAXPC)
SET TAXSTAT=$GET(TAXSTAT)
+54 SET CLIA=$$ID^XUAF4("CLIA",IEN)
+55 SET MAMMO=$$ID^XUAF4("MAMMO-ACR",IEN)
+56 SET DMIS=$$ID^XUAF4("DMIS",IEN)
+57 ;
+58 SET NODE="ZIN"_HLFS_NAME_HLFS_STANUM_HLFS_STATUS_HLFS_FACTYP_HLFS
+59 SET NODE(1)=OFFNAME_HLFS_INACTIVE_HLFS_STATE_HLFS_VISN_HLFS_PARENT
+60 SET NODE(1)=NODE(1)_HLFS_HLFS_HLFS_HLFS_HLFS
+61 SET NODE(2)=STREET1_HLCS_STREET2_HLCS_CITY_HLCS_STATE_HLCS_ZIP_HLCS_COUNTRY_HLFS
+62 SET NODE(3)=ST1_HLCS_ST2_HLCS_CITY1_HLCS_STATE1_HLCS_ZIP1_HLFS
+63 SET NODE(4)=AGENCY_HLFS_NPI_HLFS_NPISTAT_HLFS_NPIDT_HLFS_TAX_HLFS
+64 SET NODE(4)=NODE(4)_TAXSTAT_HLFS_TAXPC_HLFS
+65 SET NODE(4)=NODE(4)_CLIA_HLFS_MAMMO_HLFS_DMIS_HLFS_BILLNAME_HLFS
+66 SET NODE(5)=LOCTZONE_HLFS_TZONEX_HLFS_CERNER
+67 ;
+68 QUIT
+69 ;
CODESYS(IEN) ; coding system / id
+1 ;
+2 NEW X
+3 ;
+4 SET X=$$STA^XUAF4(IEN)
if X
QUIT X_"~"_$PIECE(^DIC(4,IEN,0),U)_"~VASTANUM"
+5 ;
+6 SET X=$$ID^XUAF4("NPI",IEN)
if X'=""
QUIT X_"~"_$PIECE(^DIC(4,IEN,0),U)_"~NPI"
+7 ;
+8 SET X=$$ID^XUAF4("DMIS",IEN)
if X'=""
QUIT X_"~"_$PIECE(^DIC(4,IEN,0),U)_"~DMIS"
+9 ;
+10 QUIT 0
+11 ;
