Released XU*8*678 SEQ #531 Extracted from mail message **KIDS**:XU*8.0*678^ **INSTALL NAME** XU*8.0*678 "BLD",9900,0) XU*8.0*678^KERNEL^0^3170119^y "BLD",9900,1,0) ^^2^2^3161031^ "BLD",9900,1,1,0) This package contains routines necessary to accommodate "BLD",9900,1,2,0) the UTC changes to the INSTITUTION file (#4). "BLD",9900,4,0) ^9.64PA^^ "BLD",9900,6.3) 13 "BLD",9900,"ABPKG") n "BLD",9900,"INID") ^n "BLD",9900,"INIT") BG^XUMF04Q "BLD",9900,"KRN",0) ^9.67PA^779.2^20 "BLD",9900,"KRN",.4,0) .4 "BLD",9900,"KRN",.401,0) .401 "BLD",9900,"KRN",.402,0) .402 "BLD",9900,"KRN",.403,0) .403 "BLD",9900,"KRN",.5,0) .5 "BLD",9900,"KRN",.84,0) .84 "BLD",9900,"KRN",3.6,0) 3.6 "BLD",9900,"KRN",3.8,0) 3.8 "BLD",9900,"KRN",9.2,0) 9.2 "BLD",9900,"KRN",9.8,0) 9.8 "BLD",9900,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",9900,"KRN",9.8,"NM",1,0) XUMF04^^0^B21394417 "BLD",9900,"KRN",9.8,"NM",2,0) XUMF04H^^0^B32714425 "BLD",9900,"KRN",9.8,"NM","B","XUMF04",1) "BLD",9900,"KRN",9.8,"NM","B","XUMF04H",2) "BLD",9900,"KRN",19,0) 19 "BLD",9900,"KRN",19.1,0) 19.1 "BLD",9900,"KRN",101,0) 101 "BLD",9900,"KRN",409.61,0) 409.61 "BLD",9900,"KRN",771,0) 771 "BLD",9900,"KRN",779.2,0) 779.2 "BLD",9900,"KRN",870,0) 870 "BLD",9900,"KRN",8989.51,0) 8989.51 "BLD",9900,"KRN",8989.52,0) 8989.52 "BLD",9900,"KRN",8994,0) 8994 "BLD",9900,"KRN","B",.4,.4) "BLD",9900,"KRN","B",.401,.401) "BLD",9900,"KRN","B",.402,.402) "BLD",9900,"KRN","B",.403,.403) "BLD",9900,"KRN","B",.5,.5) "BLD",9900,"KRN","B",.84,.84) "BLD",9900,"KRN","B",3.6,3.6) "BLD",9900,"KRN","B",3.8,3.8) "BLD",9900,"KRN","B",9.2,9.2) "BLD",9900,"KRN","B",9.8,9.8) "BLD",9900,"KRN","B",19,19) "BLD",9900,"KRN","B",19.1,19.1) "BLD",9900,"KRN","B",101,101) "BLD",9900,"KRN","B",409.61,409.61) "BLD",9900,"KRN","B",771,771) "BLD",9900,"KRN","B",779.2,779.2) "BLD",9900,"KRN","B",870,870) "BLD",9900,"KRN","B",8989.51,8989.51) "BLD",9900,"KRN","B",8989.52,8989.52) "BLD",9900,"KRN","B",8994,8994) "BLD",9900,"QDEF") ^^^^NO^^^^NO^^NO "BLD",9900,"QUES",0) ^9.62^^ "BLD",9900,"REQB",0) ^9.611^2^2 "BLD",9900,"REQB",1,0) DI*22.2*2^2 "BLD",9900,"REQB",2,0) XU*8.0*549^2 "BLD",9900,"REQB","B","DI*22.2*2",1) "BLD",9900,"REQB","B","XU*8.0*549",2) "INIT") BG^XUMF04Q "MBREQ") 0 "PKG",173,-1) 1^1 "PKG",173,0) KERNEL^XU^SIGN-ON, SECURITY, MENU DRIVER, DEVICES, TASKMAN^ "PKG",173,20,0) ^9.402P^2^2 "PKG",173,20,1,0) 200^^XDRM200N "PKG",173,20,1,1) "PKG",173,20,2,0) 2^^RGDRM03 "PKG",173,20,2,1) "PKG",173,20,"B",2,2) "PKG",173,20,"B",200,1) "PKG",173,22,0) ^9.49I^1^1 "PKG",173,22,1,0) 8.0^2950703^2951015^1 "PKG",173,22,1,"PAH",1,0) 678^3170119^520736460 "PKG",173,22,1,"PAH",1,1,0) ^^2^2^3170119 "PKG",173,22,1,"PAH",1,1,1,0) This package contains routines necessary to accommodate "PKG",173,22,1,"PAH",1,1,2,0) the UTC changes to the INSTITUTION file (#4). "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 3 "RTN","XUMF04") 0^1^B21394417^B19370991 "RTN","XUMF04",1,0) XUMF04 ;BP/RAM - INSTITUTION SEGMENTS ;06/28/00 "RTN","XUMF04",2,0) ;;8.0;KERNEL;**549,678**;Jul 10, 1995;Build 13 "RTN","XUMF04",3,0) ;;Per VA Directive 6402, this routine should not be modified "RTN","XUMF04",4,0) ; "RTN","XUMF04",5,0) Q "RTN","XUMF04",6,0) ; "RTN","XUMF04",7,0) MSA(ERROR,HLFS,HL) ; - ACK "RTN","XUMF04",8,0) ; "RTN","XUMF04",9,0) S:$G(HLFS)="" HLFS="^" "RTN","XUMF04",10,0) ; "RTN","XUMF04",11,0) Q "MSA"_HLFS_$S(ERROR:"AE",1:"AA")_HLFS_$G(HL("MID")) "RTN","XUMF04",12,0) ; "RTN","XUMF04",13,0) QRD(HLFS,WHO) ; -- query definition segment "RTN","XUMF04",14,0) ; "RTN","XUMF04",15,0) S:$G(HLFS)="" HLFS="^" "RTN","XUMF04",16,0) S:$G(WHO)="" WHO="VASTANUM" "RTN","XUMF04",17,0) ; "RTN","XUMF04",18,0) N QDT,QFC,QP,QID,ZDRT,ZDRDT,QLR,WHAT,WDDC,WDCVQ,QRL,QRD "RTN","XUMF04",19,0) ; "RTN","XUMF04",20,0) S QDT=$$HLDATE^HLFNC($$NOW^XLFDT) "RTN","XUMF04",21,0) S QFC="R" "RTN","XUMF04",22,0) S QP="I" "RTN","XUMF04",23,0) S QID="Z04" "RTN","XUMF04",24,0) S ZDRT="" "RTN","XUMF04",25,0) S ZDRDT="" "RTN","XUMF04",26,0) S QLR="RD"_HLCS_999 "RTN","XUMF04",27,0) S WHAT="INSTITUTION" "RTN","XUMF04",28,0) S WDDC="VA" "RTN","XUMF04",29,0) S WDCVQ="" "RTN","XUMF04",30,0) S QRL="" "RTN","XUMF04",31,0) S QRD="QRD"_HLFS_QDT_HLFS_QFC_HLFS_QP_HLFS_QID_HLFS_ZDRT_HLFS_ZDRDT "RTN","XUMF04",32,0) S QRD=QRD_HLFS_QLR_HLFS_WHO_HLFS_WHAT_HLFS_WDDC_HLFS_WDCVQ_HLFS_QRL "RTN","XUMF04",33,0) ; "RTN","XUMF04",34,0) Q QRD "RTN","XUMF04",35,0) ; "RTN","XUMF04",36,0) MFI() ; master file identifier segment "RTN","XUMF04",37,0) ; "RTN","XUMF04",38,0) N ID,APP,EVENT,ENDT,EFFDT,RESP,MFI "RTN","XUMF04",39,0) ; "RTN","XUMF04",40,0) S ID="Z04" "RTN","XUMF04",41,0) S APP="MFS" "RTN","XUMF04",42,0) S EVENT="UPD" "RTN","XUMF04",43,0) S ENDT=$$NOW^XLFDT "RTN","XUMF04",44,0) S EFFDT=$$NOW^XLFDT "RTN","XUMF04",45,0) S RESP="NE" "RTN","XUMF04",46,0) S MFI=$$MFI^XUMFMFI(ID,APP,EVENT,ENDT,EFFDT,RESP) "RTN","XUMF04",47,0) ; "RTN","XUMF04",48,0) Q MFI "RTN","XUMF04",49,0) ; "RTN","XUMF04",50,0) MFE(IEN) ; master file entry segment "RTN","XUMF04",51,0) ; "RTN","XUMF04",52,0) N EVENT,MFN,EDT,CODE,MFE "RTN","XUMF04",53,0) ; "RTN","XUMF04",54,0) S EVENT="MUP" "RTN","XUMF04",55,0) S MFN="" "RTN","XUMF04",56,0) S EDT=$$NOW^XLFDT "RTN","XUMF04",57,0) S CODE=$$CODESYS(IEN) "RTN","XUMF04",58,0) S MFE=$$MFE^XUMFMFE(EVENT,MFN,EDT,CODE) "RTN","XUMF04",59,0) ; "RTN","XUMF04",60,0) Q MFE "RTN","XUMF04",61,0) ; "RTN","XUMF04",62,0) ZIN(IEN,NODE,HLFS,HLCS) ; ZIN segment "RTN","XUMF04",63,0) ; "RTN","XUMF04",64,0) N IENS,NAME,STATE,STREET1,STREET2,CITY,ZIP,ST1,ST2,CITY1,STATE1,ZIP1 "RTN","XUMF04",65,0) N X,ARRAY,BILLNAME,NPIDT,TAX,TAXSTAT,TAXPC,CLIA,DMIS,MAMMO "RTN","XUMF04",66,0) N STATUS,FACTYP,AGENCY,STANUM,OFFNAME,INACTIVE,VISN,PARENT,NPI,NPISTAT "RTN","XUMF04",67,0) N LOCTZONE,COUNTRY,TZONEX "RTN","XUMF04",68,0) ; "RTN","XUMF04",69,0) S IENS=IEN_"," "RTN","XUMF04",70,0) ; "RTN","XUMF04",71,0) S:$G(HLFS)="" HLFS="^" "RTN","XUMF04",72,0) S:$G(HLCS)="" HLCS="~" "RTN","XUMF04",73,0) ; "RTN","XUMF04",74,0) D GETS^DIQ(4,IENS,"*","","ARRAY") "RTN","XUMF04",75,0) ; "RTN","XUMF04",76,0) S NAME=ARRAY(4,IENS,.01) "RTN","XUMF04",77,0) S STATE=ARRAY(4,IENS,.02) "RTN","XUMF04",78,0) S STREET1=ARRAY(4,IENS,1.01) "RTN","XUMF04",79,0) S STREET2=ARRAY(4,IENS,1.02) "RTN","XUMF04",80,0) S CITY=ARRAY(4,IENS,1.03) "RTN","XUMF04",81,0) S ZIP=ARRAY(4,IENS,1.04) "RTN","XUMF04",82,0) S ST1=ARRAY(4,IENS,4.01) "RTN","XUMF04",83,0) S ST2=ARRAY(4,IENS,4.02) "RTN","XUMF04",84,0) S CITY1=ARRAY(4,IENS,4.03) "RTN","XUMF04",85,0) S STATE1=ARRAY(4,IENS,4.04) "RTN","XUMF04",86,0) S ZIP1=ARRAY(4,IENS,4.05) "RTN","XUMF04",87,0) S STATUS=ARRAY(4,IENS,11) "RTN","XUMF04",88,0) S FACTYP=ARRAY(4,IENS,13) "RTN","XUMF04",89,0) S AGENCY=ARRAY(4,IENS,95) "RTN","XUMF04",90,0) S STANUM=ARRAY(4,IENS,99) "RTN","XUMF04",91,0) S OFFNAME=ARRAY(4,IENS,100) "RTN","XUMF04",92,0) S INACTIVE=ARRAY(4,IENS,101) "RTN","XUMF04",93,0) S BILLNAME=ARRAY(4,IENS,200) "RTN","XUMF04",94,0) S LOCTZONE=ARRAY(4,IENS,800) "RTN","XUMF04",95,0) S COUNTRY=ARRAY(4,IENS,801) "RTN","XUMF04",96,0) S TZONEX=ARRAY(4,IENS,802) "RTN","XUMF04",97,0) S VISN=$P($G(^DIC(4,+$P($G(^DIC(4,+IEN,7,1,0)),U,2),0)),U) "RTN","XUMF04",98,0) S PARENT=$P($G(^DIC(4,+$P($G(^DIC(4,+IEN,7,2,0)),U,2),99)),U) "RTN","XUMF04",99,0) S NPI=$$NPI^XUSNPI("Organization_ID",IEN) "RTN","XUMF04",100,0) S:$P(NPI,U)="-1" NPI="" "RTN","XUMF04",101,0) S NPIDT=$$HLDATE^HLFNC($P(NPI,U,2)) "RTN","XUMF04",102,0) S NPISTAT=$$UP^XLFSTR($P(NPI,U,3)) "RTN","XUMF04",103,0) S NPI=$P(NPI,U) "RTN","XUMF04",104,0) S TAX=$$TAXORG^XUSTAX(IEN) "RTN","XUMF04",105,0) S X=$P(TAX,U,2),TAX=$P(TAX,U) "RTN","XUMF04",106,0) S:X X=$O(^DIC(4,IEN,"TAXONOMY","B",X,0)) "RTN","XUMF04",107,0) S X=$G(^DIC(4,+IEN,"TAXONOMY",+$G(X),0)) "RTN","XUMF04",108,0) S TAXPC=$S('X:"",$P(X,U,2)=1:"YES",1:"NO") "RTN","XUMF04",109,0) S TAXSTAT=$S('X:"",$P(X,U,3)="A":"ACTIVE",1:"INACTIVE") "RTN","XUMF04",110,0) S CLIA=$$ID^XUAF4("CLIA",IEN) "RTN","XUMF04",111,0) S MAMMO=$$ID^XUAF4("MAMMO-ACR",IEN) "RTN","XUMF04",112,0) S DMIS=$$ID^XUAF4("DMIS",IEN) "RTN","XUMF04",113,0) ; "RTN","XUMF04",114,0) S NODE="ZIN"_HLFS_NAME_HLFS_STANUM_HLFS_STATUS_HLFS_FACTYP_HLFS "RTN","XUMF04",115,0) S NODE(1)=OFFNAME_HLFS_INACTIVE_HLFS_STATE_HLFS_VISN_HLFS_PARENT "RTN","XUMF04",116,0) S NODE(1)=NODE(1)_HLFS_HLFS_HLFS_HLFS_HLFS "RTN","XUMF04",117,0) S NODE(2)=STREET1_HLCS_STREET2_HLCS_CITY_HLCS_STATE_HLCS_ZIP_HLCS_COUNTRY_HLFS "RTN","XUMF04",118,0) S NODE(3)=ST1_HLCS_ST2_HLCS_CITY1_HLCS_STATE1_HLCS_ZIP1_HLFS "RTN","XUMF04",119,0) S NODE(4)=AGENCY_HLFS_NPI_HLFS_NPISTAT_HLFS_NPIDT_HLFS_TAX_HLFS "RTN","XUMF04",120,0) S NODE(4)=NODE(4)_TAXSTAT_HLFS_TAXPC_HLFS "RTN","XUMF04",121,0) S NODE(4)=NODE(4)_CLIA_HLFS_MAMMO_HLFS_DMIS_HLFS_BILLNAME_HLFS "RTN","XUMF04",122,0) S NODE(5)=LOCTZONE_HLFS_TZONEX "RTN","XUMF04",123,0) ; "RTN","XUMF04",124,0) Q "RTN","XUMF04",125,0) ; "RTN","XUMF04",126,0) CODESYS(IEN) ; coding system / id "RTN","XUMF04",127,0) ; "RTN","XUMF04",128,0) N X "RTN","XUMF04",129,0) ; "RTN","XUMF04",130,0) S X=$$STA^XUAF4(IEN) Q:X X_"~"_$P(^DIC(4,IEN,0),U)_"~VASTANUM" "RTN","XUMF04",131,0) ; "RTN","XUMF04",132,0) S X=$$ID^XUAF4("NPI",IEN) Q:X'="" X_"~"_$P(^DIC(4,IEN,0),U)_"~NPI" "RTN","XUMF04",133,0) ; "RTN","XUMF04",134,0) S X=$$ID^XUAF4("DMIS",IEN) Q:X'="" X_"~"_$P(^DIC(4,IEN,0),U)_"~DMIS" "RTN","XUMF04",135,0) ; "RTN","XUMF04",136,0) Q 0 "RTN","XUMF04",137,0) ; "RTN","XUMF04H") 0^2^B32714425^B30233648 "RTN","XUMF04H",1,0) XUMF04H ;BP/RAM - INSTITUTION Handler ;11/16/05 "RTN","XUMF04H",2,0) ;;8.0;KERNEL;**549,678**;Jul 10, 1995;Build 13 "RTN","XUMF04H",3,0) ;;Per VA Directive 6402, this routine should not be modified "RTN","XUMF04H",4,0) ; This routine handles Institution Master File HL7 messages. "RTN","XUMF04H",5,0) ; "RTN","XUMF04H",6,0) MAIN ; -- entry point "RTN","XUMF04H",7,0) ; "RTN","XUMF04H",8,0) Q:$$KSP^XUPARAM("INST")=12000 "RTN","XUMF04H",9,0) ; "RTN","XUMF04H",10,0) N X,HLFS,HLCS,ERROR,HLRESLTA,IFN,IEN,KEY,VALUE,ROOT,HLSCS,CDSYS,TEXT,ID "RTN","XUMF04H",11,0) ; "RTN","XUMF04H",12,0) D INIT,PROCESS,REPLY,EXIT "RTN","XUMF04H",13,0) ; "RTN","XUMF04H",14,0) Q "RTN","XUMF04H",15,0) ; "RTN","XUMF04H",16,0) INIT ; -- initialize "RTN","XUMF04H",17,0) ; "RTN","XUMF04H",18,0) S ERROR=0,IEN="" "RTN","XUMF04H",19,0) S HLFS=HL("FS"),HLCS=$E(HL("ECH")),HLSCS=$E(HL("ECH"),4) "RTN","XUMF04H",20,0) ; "RTN","XUMF04H",21,0) Q "RTN","XUMF04H",22,0) ; "RTN","XUMF04H",23,0) PROCESS ; -- pull message text "RTN","XUMF04H",24,0) ; "RTN","XUMF04H",25,0) F X HLNEXT Q:HLQUIT'>0 D "RTN","XUMF04H",26,0) .Q:$P(HLNODE,HLFS)="" "RTN","XUMF04H",27,0) .D @($P(HLNODE,HLFS)) "RTN","XUMF04H",28,0) ; "RTN","XUMF04H",29,0) Q "RTN","XUMF04H",30,0) ; "RTN","XUMF04H",31,0) MSH ; -- MSH segment "RTN","XUMF04H",32,0) ; "RTN","XUMF04H",33,0) Q "RTN","XUMF04H",34,0) ; "RTN","XUMF04H",35,0) MSA ; -- MSA segment "RTN","XUMF04H",36,0) ; "RTN","XUMF04H",37,0) Q "RTN","XUMF04H",38,0) ; "RTN","XUMF04H",39,0) QRD ; -- QRD segment "RTN","XUMF04H",40,0) ; "RTN","XUMF04H",41,0) Q "RTN","XUMF04H",42,0) ; "RTN","XUMF04H",43,0) MFI ; -- MFI segment "RTN","XUMF04H",44,0) ; "RTN","XUMF04H",45,0) Q "RTN","XUMF04H",46,0) ; "RTN","XUMF04H",47,0) MFE ; -- MFE segment "RTN","XUMF04H",48,0) ; "RTN","XUMF04H",49,0) S KEY=$P(HLNODE,HLFS,5) "RTN","XUMF04H",50,0) ; "RTN","XUMF04H",51,0) S ID=$P(KEY,HLCS) "RTN","XUMF04H",52,0) S TEXT=$P(KEY,HLCS,2) "RTN","XUMF04H",53,0) S CDSYS=$P(KEY,HLCS,3) "RTN","XUMF04H",54,0) ; "RTN","XUMF04H",55,0) I CDSYS="VASTANUM" D Q "RTN","XUMF04H",56,0) .S IEN=$O(^DIC(4,"D",ID,0)) Q:IEN "RTN","XUMF04H",57,0) .S IEN=$O(^DIC(4,"B",TEXT,0)) "RTN","XUMF04H",58,0) ; "RTN","XUMF04H",59,0) I CDSYS="NPI" D Q "RTN","XUMF04H",60,0) .S IEN=$O(^DIC(4,"ANPI",ID,0)) Q:IEN "RTN","XUMF04H",61,0) .S IEN=$O(^DIC(4,"B",TEXT,0)) "RTN","XUMF04H",62,0) I CDSYS="DMIS" D Q "RTN","XUMF04H",63,0) .S IEN=$O(^DIC(4,"XUMFIDX","DMIS",ID,0)) Q:IEN "RTN","XUMF04H",64,0) .S IEN=$O(^DIC(4,"B",TEXT,0)) "RTN","XUMF04H",65,0) ; "RTN","XUMF04H",66,0) Q "RTN","XUMF04H",67,0) ; "RTN","XUMF04H",68,0) ZIN ; -- VHA Institution segment "RTN","XUMF04H",69,0) ; "RTN","XUMF04H",70,0) W "." "RTN","XUMF04H",71,0) ; "RTN","XUMF04H",72,0) N NAME,FACTYP,OFNME,INACTIVE,STATE,VISN,PARENT,STREET,STREET2,CITY,ZIP "RTN","XUMF04H",73,0) N STRT1,STRT2,CITY1,STATE1,STANUM,BILLNAME,IEN1,IENS,ERR,ERROR1 "RTN","XUMF04H",74,0) N ZIP1,AGENCY,NPIDT,NPISTAT,NPI,TAX,TAXPC,TAXSTAT,MAMMO,CLIA,DMIS,XXXX "RTN","XUMF04H",75,0) N LOCTZONE,COUNTRY,TZONEX "RTN","XUMF04H",76,0) ; "RTN","XUMF04H",77,0) D PARSE^XUMFXHL7("HLNODE","XXXX") "RTN","XUMF04H",78,0) ; "RTN","XUMF04H",79,0) S STANUM=XXXX(2) "RTN","XUMF04H",80,0) ; "RTN","XUMF04H",81,0) I $G(STANUM),CDSYS'="VASTANUM" Q "RTN","XUMF04H",82,0) ; "RTN","XUMF04H",83,0) S XUMF=1,ERROR1="" "RTN","XUMF04H",84,0) ; "RTN","XUMF04H",85,0) S NAME=XXXX(1) "RTN","XUMF04H",86,0) S FACTYP=$P(XXXX(4),"~",1) "RTN","XUMF04H",87,0) S OFNME=XXXX(5) "RTN","XUMF04H",88,0) S INACTIVE=XXXX(6) "RTN","XUMF04H",89,0) S STATE=XXXX(7) "RTN","XUMF04H",90,0) S VISN=XXXX(8) "RTN","XUMF04H",91,0) S PARENT=XXXX(9) "RTN","XUMF04H",92,0) S STREET=$P(XXXX(14),"~",1) "RTN","XUMF04H",93,0) S STREET2=$P(XXXX(14),"~",2) "RTN","XUMF04H",94,0) S CITY=$P(XXXX(14),"~",3) "RTN","XUMF04H",95,0) S ZIP=$P(XXXX(14),"~",5) "RTN","XUMF04H",96,0) S COUNTRY=$P(XXXX(14),"~",6) "RTN","XUMF04H",97,0) S STRT1=$P(XXXX(15),"~",1) "RTN","XUMF04H",98,0) S STRT2=$P(XXXX(15),"~",2) "RTN","XUMF04H",99,0) S CITY1=$P(XXXX(15),"~",3) "RTN","XUMF04H",100,0) S STATE1=$P(XXXX(15),"~",4) "RTN","XUMF04H",101,0) S ZIP1=$P(XXXX(15),"~",5) "RTN","XUMF04H",102,0) S AGENCY=$P(XXXX(16),"~") "RTN","XUMF04H",103,0) S NPI=XXXX(17) "RTN","XUMF04H",104,0) S NPISTAT=XXXX(18) "RTN","XUMF04H",105,0) S NPIDT=$$FMDATE^HLFNC(XXXX(19)) "RTN","XUMF04H",106,0) S TAX=XXXX(20) "RTN","XUMF04H",107,0) S TAXSTAT=XXXX(21) "RTN","XUMF04H",108,0) S TAXPC=XXXX(22) "RTN","XUMF04H",109,0) S CLIA=XXXX(23) "RTN","XUMF04H",110,0) S MAMMO=XXXX(24) "RTN","XUMF04H",111,0) S DMIS=XXXX(25) "RTN","XUMF04H",112,0) S BILLNAME=XXXX(26) "RTN","XUMF04H",113,0) S LOCTZONE=XXXX(27) "RTN","XUMF04H",114,0) S TZONEX=XXXX(28) "RTN","XUMF04H",115,0) ; "RTN","XUMF04H",116,0) ; -- new entry "RTN","XUMF04H",117,0) I 'IEN D Q:'IEN "RTN","XUMF04H",118,0) .N X,Y S X=NAME "RTN","XUMF04H",119,0) .K DIC S DIC=4,DIC(0)="F" "RTN","XUMF04H",120,0) .D FILE^DICN K DIC "RTN","XUMF04H",121,0) .S IEN=$S(Y="-1":0,1:+Y) "RTN","XUMF04H",122,0) ; "RTN","XUMF04H",123,0) S IENS=IEN_"," "RTN","XUMF04H",124,0) ; "RTN","XUMF04H",125,0) K FDA "RTN","XUMF04H",126,0) S FDA(4,IENS,.01)=NAME "RTN","XUMF04H",127,0) S FDA(4,IENS,13)=FACTYP "RTN","XUMF04H",128,0) S FDA(4,IENS,1.01)=STREET "RTN","XUMF04H",129,0) S FDA(4,IENS,1.02)=STREET2 "RTN","XUMF04H",130,0) S FDA(4,IENS,1.03)=CITY "RTN","XUMF04H",131,0) S FDA(4,IENS,1.04)=ZIP "RTN","XUMF04H",132,0) S FDA(4,IENS,.02)=STATE "RTN","XUMF04H",133,0) S FDA(4,IENS,4.01)=STRT1 "RTN","XUMF04H",134,0) S FDA(4,IENS,4.02)=STRT2 "RTN","XUMF04H",135,0) S FDA(4,IENS,4.03)=CITY1 "RTN","XUMF04H",136,0) S FDA(4,IENS,4.04)=STATE1 "RTN","XUMF04H",137,0) S FDA(4,IENS,4.05)=ZIP1 "RTN","XUMF04H",138,0) S FDA(4,IENS,11)="National" "RTN","XUMF04H",139,0) S FDA(4,IENS,100)=OFNME "RTN","XUMF04H",140,0) S FDA(4,IENS,101)=INACTIVE "RTN","XUMF04H",141,0) S FDA(4,IENS,95)=AGENCY "RTN","XUMF04H",142,0) S FDA(4,IENS,99)=STANUM "RTN","XUMF04H",143,0) S FDA(4,IENS,200)=BILLNAME "RTN","XUMF04H",144,0) S FDA(4,IENS,800)=LOCTZONE "RTN","XUMF04H",145,0) S FDA(4,IENS,801)=COUNTRY "RTN","XUMF04H",146,0) S FDA(4,IENS,802)=TZONEX "RTN","XUMF04H",147,0) D FILE^DIE("E","FDA") "RTN","XUMF04H",148,0) ; "RTN","XUMF04H",149,0) I $G(VISN)'="" D "RTN","XUMF04H",150,0) .K FDA "RTN","XUMF04H",151,0) .S IENS="?+1,"_IEN_"," "RTN","XUMF04H",152,0) .S FDA(4.014,IENS,.01)="VISN" "RTN","XUMF04H",153,0) .S FDA(4.014,IENS,1)=VISN "RTN","XUMF04H",154,0) .D UPDATE^DIE("E","FDA") "RTN","XUMF04H",155,0) ; "RTN","XUMF04H",156,0) I $G(PARENT)'="" D "RTN","XUMF04H",157,0) .K FDA "RTN","XUMF04H",158,0) .S IENS="?+2,"_IEN_"," "RTN","XUMF04H",159,0) .S FDA(4.014,IENS,.01)="PARENT FACILITY" "RTN","XUMF04H",160,0) .S FDA(4.014,IENS,1)=PARENT "RTN","XUMF04H",161,0) .D UPDATE^DIE("E","FDA") "RTN","XUMF04H",162,0) ; "RTN","XUMF04H",163,0) I $G(NPIDT)'="",$G(^DIC(4,IEN,"NPI"))'=NPI D "RTN","XUMF04H",164,0) .S IENS="?+1,"_IEN_"," "RTN","XUMF04H",165,0) .S FDA(4.042,IENS,.01)=NPIDT "RTN","XUMF04H",166,0) .S FDA(4.042,IENS,.02)=NPISTAT "RTN","XUMF04H",167,0) .S FDA(4.042,IENS,.03)=NPI "RTN","XUMF04H",168,0) .D UPDATE^DIE("E","FDA") "RTN","XUMF04H",169,0) ; "RTN","XUMF04H",170,0) I $G(TAX)'="",$P($$TAXORG^XUSTAX(IEN),U)'=TAX D "RTN","XUMF04H",171,0) .K FDA,ROOT,IDX "RTN","XUMF04H",172,0) .S IENS="?+1,"_IEN_"," "RTN","XUMF04H",173,0) .S FDA(4.043,IENS,.01)=TAX "RTN","XUMF04H",174,0) .S FDA(4.043,IENS,.02)=TAXPC "RTN","XUMF04H",175,0) .S FDA(4.043,IENS,.03)=TAXSTAT "RTN","XUMF04H",176,0) .D UPDATE^DIE("E","FDA") "RTN","XUMF04H",177,0) ; "RTN","XUMF04H",178,0) I $G(CLIA)'="" D "RTN","XUMF04H",179,0) .S IENS="?+2,"_IEN_"," "RTN","XUMF04H",180,0) .K FDA "RTN","XUMF04H",181,0) .S FDA(4.9999,IENS,.01)="CLIA" "RTN","XUMF04H",182,0) .S FDA(4.9999,IENS,.02)=CLIA "RTN","XUMF04H",183,0) .D UPDATE^DIE("E","FDA") "RTN","XUMF04H",184,0) ; "RTN","XUMF04H",185,0) I $G(MAMMO)'="" D "RTN","XUMF04H",186,0) .S IENS="?+2,"_IEN_"," "RTN","XUMF04H",187,0) .K FDA "RTN","XUMF04H",188,0) .S FDA(4.9999,IENS,.01)="MAMMO" "RTN","XUMF04H",189,0) .S FDA(4.9999,IENS,.02)=MAMMO "RTN","XUMF04H",190,0) .D UPDATE^DIE("E","FDA") "RTN","XUMF04H",191,0) ; "RTN","XUMF04H",192,0) I $G(DMIS)'="" D "RTN","XUMF04H",193,0) .S IENS="?+2,"_IEN_"," "RTN","XUMF04H",194,0) .K FDA "RTN","XUMF04H",195,0) .S FDA(4.9999,IENS,.01)="DMIS" "RTN","XUMF04H",196,0) .S FDA(4.9999,IENS,.02)=DMIS "RTN","XUMF04H",197,0) .D UPDATE^DIE("E","FDA") "RTN","XUMF04H",198,0) ; "RTN","XUMF04H",199,0) Q "RTN","XUMF04H",200,0) ; "RTN","XUMF04H",201,0) REPLY ; -- master file response "RTN","XUMF04H",202,0) ; "RTN","XUMF04H",203,0) Q:HL("MTN")="MFR" "RTN","XUMF04H",204,0) Q:HL("MTN")="MFK" "RTN","XUMF04H",205,0) Q:HL("MTN")="ACK" "RTN","XUMF04H",206,0) ; "RTN","XUMF04H",207,0) N X "RTN","XUMF04H",208,0) S X="MSA"_HLFS_$S(ERROR:"AE",1:"AA")_HLFS_HL("MID")_HLFS_$P(ERROR,U,2) "RTN","XUMF04H",209,0) S ^TMP("HLA",$J,1)=X "RTN","XUMF04H",210,0) ; "RTN","XUMF04H",211,0) S HLP("PRIORITY")="I" "RTN","XUMF04H",212,0) D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLT) "RTN","XUMF04H",213,0) ; "RTN","XUMF04H",214,0) ; check for error "RTN","XUMF04H",215,0) I ($P($G(HLRESLT),U,3)'="") D Q "RTN","XUMF04H",216,0) .S ERROR=1_U_$P(HLRESLT,HLFS,3)_U_$P(HLRESLT,HLFS,2)_U_$P(HLRESLT,U) "RTN","XUMF04H",217,0) ; "RTN","XUMF04H",218,0) ; successful call, message ID returned "RTN","XUMF04H",219,0) S ERROR="0^"_$P($G(HLRESLT),U,1) "RTN","XUMF04H",220,0) ; "RTN","XUMF04H",221,0) Q "RTN","XUMF04H",222,0) ; "RTN","XUMF04H",223,0) EXIT ; -- cleanup, and quit "RTN","XUMF04H",224,0) ; "RTN","XUMF04H",225,0) Q "RTN","XUMF04H",226,0) ; "RTN","XUMF04Q") 0^^B8431942^B8242499 "RTN","XUMF04Q",1,0) XUMF04Q ;BP/RAM - INSTITUTION QUERY ;06/28/00 "RTN","XUMF04Q",2,0) ;;8.0;KERNEL;**549,678**;Jul 10, 1995;Build 13 "RTN","XUMF04Q",3,0) ;;Per VA Directive 6402, this routine should not be modified "RTN","XUMF04Q",4,0) Q "RTN","XUMF04Q",5,0) ; "RTN","XUMF04Q",6,0) EN ; -- QUERY and PROCESS RESPONSE "RTN","XUMF04Q",7,0) ; "RTN","XUMF04Q",8,0) Q:$$KSP^XUPARAM("INST")=12000 "RTN","XUMF04Q",9,0) Q:$P($$PARAM^HLCS2,U,3)="T" "RTN","XUMF04Q",10,0) ; "RTN","XUMF04Q",11,0) N XUMFCD "RTN","XUMF04Q",12,0) ; "RTN","XUMF04Q",13,0) M ^TMP("XUMF 04",$$NOW^XLFDT,$J,4)=^DIC(4) "RTN","XUMF04Q",14,0) ; "RTN","XUMF04Q",15,0) W !!!,"GET FACILITY TYPE",!!! "RTN","XUMF04Q",16,0) ; load facility type "RTN","XUMF04Q",17,0) D LOAD^XUMF(4.1) "RTN","XUMF04Q",18,0) ; "RTN","XUMF04Q",19,0) W !!!,"GET INSTITUTION BY STATION NUMBER - PLEASE WAIT",!!! "RTN","XUMF04Q",20,0) ; load va station number "RTN","XUMF04Q",21,0) D MAIN^XUMF04Q "RTN","XUMF04Q",22,0) W !!!,"PROCESS STATION NUMBER",!!! "RTN","XUMF04Q",23,0) D MAIN^XUMF04H "RTN","XUMF04Q",24,0) ; "RTN","XUMF04Q",25,0) W !!!,"GET INSTITUTUION BY NPI",!!! "RTN","XUMF04Q",26,0) ; load NPI "RTN","XUMF04Q",27,0) S XUMFCD="NPI" "RTN","XUMF04Q",28,0) D MAIN^XUMF04Q "RTN","XUMF04Q",29,0) W !!!,"PROCESS NPI",!!! "RTN","XUMF04Q",30,0) D MAIN^XUMF04H "RTN","XUMF04Q",31,0) W !!!,"DONE",!!! "RTN","XUMF04Q",32,0) ; "RTN","XUMF04Q",33,0) Q "RTN","XUMF04Q",34,0) ; "RTN","XUMF04Q",35,0) BG ; -- background job "RTN","XUMF04Q",36,0) ; "RTN","XUMF04Q",37,0) N ZTRTN,ZTDESC,ZTDTH "RTN","XUMF04Q",38,0) ; "RTN","XUMF04Q",39,0) S ZTRTN="EN^XUMF04Q" "RTN","XUMF04Q",40,0) S ZTDESC="XUMF load all national Institution data" "RTN","XUMF04Q",41,0) S ZTDTH=$$NOW^XLFDT "RTN","XUMF04Q",42,0) S ZTIO="" "RTN","XUMF04Q",43,0) ; "RTN","XUMF04Q",44,0) D ^%ZTLOAD "RTN","XUMF04Q",45,0) ; "RTN","XUMF04Q",46,0) Q "RTN","XUMF04Q",47,0) ; "RTN","XUMF04Q",48,0) MAIN ; -- QUERY MESSAGE "RTN","XUMF04Q",49,0) ; "RTN","XUMF04Q",50,0) N CNT,ERR,I,X,HLFS,HLCS,ERROR,HLRESLTA,IFN,IEN,TYPE "RTN","XUMF04Q",51,0) N VALUE,HLSCS,PROTOCOL,TEST "RTN","XUMF04Q",52,0) ; "RTN","XUMF04Q",53,0) D INIT,BUILD,SEND,EXIT "RTN","XUMF04Q",54,0) ; "RTN","XUMF04Q",55,0) Q "RTN","XUMF04Q",56,0) ; "RTN","XUMF04Q",57,0) INIT ; -- initialize "RTN","XUMF04Q",58,0) ; "RTN","XUMF04Q",59,0) K ^TMP("HLS",$J) "RTN","XUMF04Q",60,0) ; "RTN","XUMF04Q",61,0) K HL,HLCS,HLDOM,HLECH,HLFS,HLINST,HLINSTN,HLL,HLMTIEN,HLNEXT "RTN","XUMF04Q",62,0) K HLNODE,HLP,HLPARAM,HLPROD,HLQ,HLQUIT,HLRESLT,HLSCS "RTN","XUMF04Q",63,0) ; "RTN","XUMF04Q",64,0) S PROTOCOL=$O(^ORD(101,"B","XUMF 04 MFQ",0)) "RTN","XUMF04Q",65,0) D INIT^HLFNC2(PROTOCOL,.HL) "RTN","XUMF04Q",66,0) S TEST=$S($P($$PARAM^HLCS2,U,3)="T":1,1:0) "RTN","XUMF04Q",67,0) S HLL("LINKS",1)="XUMF 04 MFR^XUMF "_$S('TEST:"FORUM",1:"TEST") "RTN","XUMF04Q",68,0) ; "RTN","XUMF04Q",69,0) S ERROR=0,CNT=1 "RTN","XUMF04Q",70,0) S HLFS=HL("FS"),HLCS=$E(HL("ECH")),HLSCS=$E(HL("ECH"),4) "RTN","XUMF04Q",71,0) ; "RTN","XUMF04Q",72,0) Q "RTN","XUMF04Q",73,0) ; "RTN","XUMF04Q",74,0) BUILD ; -- build message "RTN","XUMF04Q",75,0) ; "RTN","XUMF04Q",76,0) D QRD "RTN","XUMF04Q",77,0) ; "RTN","XUMF04Q",78,0) Q "RTN","XUMF04Q",79,0) ; "RTN","XUMF04Q",80,0) MSA ; -- MSA segment "RTN","XUMF04Q",81,0) ; "RTN","XUMF04Q",82,0) S ^TMP("HLS",$J,CNT)=$$MSA^XUMF04(ERROR,HLFS,.HL) "RTN","XUMF04Q",83,0) S CNT=CNT+1 "RTN","XUMF04Q",84,0) ; "RTN","XUMF04Q",85,0) Q "RTN","XUMF04Q",86,0) ; "RTN","XUMF04Q",87,0) QRD ; -- QRD segment "RTN","XUMF04Q",88,0) ; "RTN","XUMF04Q",89,0) S ^TMP("HLS",$J,CNT)=$$QRD^XUMF04(HLFS,$G(XUMFCD)) "RTN","XUMF04Q",90,0) S CNT=CNT+1 "RTN","XUMF04Q",91,0) ; "RTN","XUMF04Q",92,0) Q "RTN","XUMF04Q",93,0) ; "RTN","XUMF04Q",94,0) ; "RTN","XUMF04Q",95,0) ; "RTN","XUMF04Q",96,0) SEND ; -- send HL7 message "RTN","XUMF04Q",97,0) ; "RTN","XUMF04Q",98,0) S HLP("PRIORITY")="I" "RTN","XUMF04Q",99,0) ; "RTN","XUMF04Q",100,0) D DIRECT^HLMA(PROTOCOL,"GM",1,.HLRESLT,"",.HLP) "RTN","XUMF04Q",101,0) ; "RTN","XUMF04Q",102,0) ; check for error "RTN","XUMF04Q",103,0) I ($P($G(HLRESLT),U,3)'="") D Q "RTN","XUMF04Q",104,0) .S ERROR=1_U_$P(HLRESLT,HLFS,3)_U_$P(HLRESLT,HLFS,2)_U_$P(HLRESLT,U) "RTN","XUMF04Q",105,0) ; "RTN","XUMF04Q",106,0) ; successful call, message ID returned "RTN","XUMF04Q",107,0) S ERROR="0^"_$P($G(HLRESLT),U,1) "RTN","XUMF04Q",108,0) ; "RTN","XUMF04Q",109,0) Q "RTN","XUMF04Q",110,0) ; "RTN","XUMF04Q",111,0) EXIT ; -- exit "RTN","XUMF04Q",112,0) ; "RTN","XUMF04Q",113,0) D CLEAN^DILF "RTN","XUMF04Q",114,0) ; "RTN","XUMF04Q",115,0) K ^TMP("HLS",$J) "RTN","XUMF04Q",116,0) ; "RTN","XUMF04Q",117,0) Q "RTN","XUMF04Q",118,0) ; "RTN","XUMF04Q",119,0) DMIS ; - load DMIS "RTN","XUMF04Q",120,0) ; "RTN","XUMF04Q",121,0) Q:$$KSP^XUPARAM("INST")=12000 "RTN","XUMF04Q",122,0) Q:$P($$PARAM^HLCS2,U,3)="T" "RTN","XUMF04Q",123,0) ; "RTN","XUMF04Q",124,0) N XUMFCD "RTN","XUMF04Q",125,0) S XUMFCD="DMIS" "RTN","XUMF04Q",126,0) D MAIN^XUMF04Q "RTN","XUMF04Q",127,0) D MAIN^XUMF04H "RTN","XUMF04Q",128,0) ; "RTN","XUMF04Q",129,0) Q "RTN","XUMF04Q",130,0) ; "VER") 8.0^22.2 "BLD",9900,6) ^531 **END** **END**