XUMF04H.m

XUMF04H ;BP/RAM - INSTITUTION Handler ;11/16/05

 ;;8.0;KERNEL;**549**;Jul 10, 1995;Build 12

 ;

 ; This routine handles Institution Master File HL7 messages.

 ;

MAIN ; -- entry point

 ;

 Q:$$KSP^XUPARAM("INST")=12000

 ;

 N X,HLFS,HLCS,ERROR,HLRESLTA,IFN,IEN,KEY,VALUE,ROOT,HLSCS,CDSYS,TEXT,ID

 ;

 D INIT,PROCESS,REPLY,EXIT

 ;

 Q

 ;

INIT ; -- initialize

 ;

 S ERROR=0,IEN=""

 S HLFS=HL("FS"),HLCS=$E(HL("ECH")),HLSCS=$E(HL("ECH"),4)

 ;

 Q

 ;

PROCESS ; -- pull message text

 ;

 F  X HLNEXT Q:HLQUIT'>0  D

 .Q:$P(HLNODE,HLFS)=""

 .D @($P(HLNODE,HLFS))

 ;

 Q

 ;

MSH ; -- MSH segment

 ;

 Q

 ;

MSA ; -- MSA segment

 ;

 Q

 ;

QRD ; -- QRD segment

 ;

 Q

 ;

MFI ; -- MFI segment

 ;

 Q

 ;

MFE ; -- MFE segment

 ;

 S KEY=$P(HLNODE,HLFS,5)

 ;

 S ID=$P(KEY,HLCS)

 S TEXT=$P(KEY,HLCS,2)

 S CDSYS=$P(KEY,HLCS,3)

 ;

 I CDSYS="VASTANUM" D  Q

 .S IEN=$O(^DIC(4,"D",ID,0)) Q:IEN

 .S IEN=$O(^DIC(4,"B",TEXT,0))

 ;

 I CDSYS="NPI" D  Q

 .S IEN=$O(^DIC(4,"ANPI",ID,0)) Q:IEN

 .S IEN=$O(^DIC(4,"B",TEXT,0))

 I CDSYS="DMIS" D  Q

 .S IEN=$O(^DIC(4,"XUMFIDX","DMIS",ID,0)) Q:IEN

 .S IEN=$O(^DIC(4,"B",TEXT,0))

 ;

 Q

 ;

ZIN ; -- VHA Institution segment

 ;

 W "."

 ;

 N NAME,FACTYP,OFNME,INACTIVE,STATE,VISN,PARENT,STREET,STREET2,CITY,ZIP

 N STRT1,STRT2,CITY1,STATE1,STANUM,BILLNAME,IEN1,IENS,ERR,ERROR1

 N ZIP1,AGENCY,NPIDT,NPISTAT,NPI,TAX,TAXPC,TAXSTAT,MAMMO,CLIA,DMIS,XXXX

 ;

 D PARSE^XUMFXHL7("HLNODE","XXXX")

 ;

 S STANUM=XXXX(2)

 ;

 I $G(STANUM),CDSYS'="VASTANUM" Q

 ;

 S XUMF=1,ERROR1=""

 ;

 S NAME=XXXX(1)

 S FACTYP=$P(XXXX(4),"~",1)

 S OFNME=XXXX(5)

 S INACTIVE=XXXX(6)

 S STATE=XXXX(7)

 S VISN=XXXX(8)

 S PARENT=XXXX(9)

 S STREET=$P(XXXX(14),"~",1)

 S STREET2=$P(XXXX(14),"~",2)

 S CITY=$P(XXXX(14),"~",3)

 S ZIP=$P(XXXX(14),"~",5)

 S STRT1=$P(XXXX(15),"~",1)

 S STRT2=$P(XXXX(15),"~",2)

 S CITY1=$P(XXXX(15),"~",3)

 S STATE1=$P(XXXX(15),"~",4)

 S ZIP1=$P(XXXX(15),"~",5)

 S AGENCY=$P(XXXX(16),"~")

 S NPI=XXXX(17)

 S NPISTAT=XXXX(18)

 S NPIDT=$$FMDATE^HLFNC(XXXX(19))

 S TAX=XXXX(20)

 S TAXSTAT=XXXX(21)

 S TAXPC=XXXX(22)

 S CLIA=XXXX(23)

 S MAMMO=XXXX(24)

 S DMIS=XXXX(25)

 S BILLNAME=XXXX(26)

 ;

 ; -- new entry

 I 'IEN D  Q:'IEN

 .N X,Y S X=NAME

 .K DIC S DIC=4,DIC(0)="F"

 .D FILE^DICN K DIC

 .S IEN=$S(Y="-1":0,1:+Y)

 ;

 S IENS=IEN_","

 ;

 K FDA

 S FDA(4,IENS,.01)=NAME

 S FDA(4,IENS,13)=FACTYP

 S FDA(4,IENS,1.01)=STREET

 S FDA(4,IENS,1.02)=STREET2

 S FDA(4,IENS,1.03)=CITY

 S FDA(4,IENS,1.04)=ZIP

 S FDA(4,IENS,.02)=STATE

 S FDA(4,IENS,4.01)=STRT1

 S FDA(4,IENS,4.02)=STRT2

 S FDA(4,IENS,4.03)=CITY1

 S FDA(4,IENS,4.04)=STATE1

 S FDA(4,IENS,4.05)=ZIP1

 S FDA(4,IENS,11)="National"

 S FDA(4,IENS,100)=OFNME

 S FDA(4,IENS,101)=INACTIVE

 S FDA(4,IENS,95)=AGENCY

 S FDA(4,IENS,200)=BILLNAME

 S FDA(4,IENS,99)=STANUM

 D FILE^DIE("E","FDA")

 ;

 I $G(VISN)'="" D

 .K FDA

 .S IENS="?+1,"_IEN_","

 .S FDA(4.014,IENS,.01)="VISN"

 .S FDA(4.014,IENS,1)=VISN

 .D UPDATE^DIE("E","FDA")

 ;

 I $G(PARENT)'="" D

 .K FDA

 .S IENS="?+2,"_IEN_","

 .S FDA(4.014,IENS,.01)="PARENT FACILITY"

 .S FDA(4.014,IENS,1)=PARENT

 .D UPDATE^DIE("E","FDA")

 ;

 I $G(NPIDT)'="",$G(^DIC(4,IEN,"NPI"))'=NPI D

 .S IENS="?+1,"_IEN_","

 .S FDA(4.042,IENS,.01)=NPIDT

 .S FDA(4.042,IENS,.02)=NPISTAT

 .S FDA(4.042,IENS,.03)=NPI

 .D UPDATE^DIE("E","FDA")

 ;

 I $G(TAX)'="",$P($$TAXORG^XUSTAX(IEN),U)'=TAX D

 .K FDA,ROOT,IDX

 .S IENS="?+1,"_IEN_","

 .S FDA(4.043,IENS,.01)=TAX

 .S FDA(4.043,IENS,.02)=TAXPC

 .S FDA(4.043,IENS,.03)=TAXSTAT

 .D UPDATE^DIE("E","FDA")

 ;

 I $G(CLIA)'="" D

 .S IENS="?+2,"_IEN_","

 .K FDA

 .S FDA(4.9999,IENS,.01)="CLIA"

 .S FDA(4.9999,IENS,.02)=CLIA

 .D UPDATE^DIE("E","FDA")

 ;

 I $G(MAMMO)'="" D

 .S IENS="?+2,"_IEN_","

 .K FDA

 .S FDA(4.9999,IENS,.01)="MAMMO"

 .S FDA(4.9999,IENS,.02)=MAMMO

 .D UPDATE^DIE("E","FDA")

 ;

 I $G(DMIS)'="" D

 .S IENS="?+2,"_IEN_","

 .K FDA

 .S FDA(4.9999,IENS,.01)="DMIS"

 .S FDA(4.9999,IENS,.02)=DMIS

 .D UPDATE^DIE("E","FDA")

 ;

 Q

 ;

REPLY ; -- master file response

 ;

 Q:HL("MTN")="MFR"

 Q:HL("MTN")="MFK"

 Q:HL("MTN")="ACK"

 ;

 N X

 S X="MSA"_HLFS_$S(ERROR:"AE",1:"AA")_HLFS_HL("MID")_HLFS_$P(ERROR,U,2)

 S ^TMP("HLA",$J,1)=X

 ;

 S HLP("PRIORITY")="I"

 D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLT)

 ;

 ; check for error

 I ($P($G(HLRESLT),U,3)'="") D  Q

 .S ERROR=1_U_$P(HLRESLT,HLFS,3)_U_$P(HLRESLT,HLFS,2)_U_$P(HLRESLT,U)

 ;

 ; successful call, message ID returned

 S ERROR="0^"_$P($G(HLRESLT),U,1)

 ;

 Q

 ;

EXIT ; -- cleanup, and quit

 ;

 Q

 ;

XUMF04H   ;BP/RAM - INSTITUTION Handler ;11/16/05

 +1       ;;8.0;KERNEL;**549**;Jul 10, 1995;Build 12

 +2       ;

 +3       ; This routine handles Institution Master File HL7 messages.

 +4       ;

MAIN      ; -- entry point

 +1       ;

 +2        IF $$KSP^XUPARAM("INST")=12000

               QUIT 

 +3       ;

 +4        NEW X,HLFS,HLCS,ERROR,HLRESLTA,IFN,IEN,KEY,VALUE,ROOT,HLSCS,CDSYS,TEXT,ID

 +5       ;

 +6        DO INIT

           DO PROCESS

           DO REPLY

           DO EXIT

 +7       ;

 +8        QUIT 

 +9       ;

INIT      ; -- initialize

 +1       ;

 +2        SET ERROR=0

           SET IEN=""

 +3        SET HLFS=HL("FS")

           SET HLCS=$EXTRACT(HL("ECH"))

           SET HLSCS=$EXTRACT(HL("ECH"),4)

 +4       ;

 +5        QUIT 

 +6       ;

PROCESS   ; -- pull message text

 +1       ;

 +2        FOR 

               XECUTE HLNEXT

               IF HLQUIT'>0

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE(HLNODE,HLFS)=""

                       QUIT 

 +4                DO @($PIECE(HLNODE,HLFS))

               End DoDot:1

 +5       ;

 +6        QUIT 

 +7       ;

MSH       ; -- MSH segment

 +1       ;

 +2        QUIT 

 +3       ;

MSA       ; -- MSA segment

 +1       ;

 +2        QUIT 

 +3       ;

QRD       ; -- QRD segment

 +1       ;

 +2        QUIT 

 +3       ;

MFI       ; -- MFI segment

 +1       ;

 +2        QUIT 

 +3       ;

MFE       ; -- MFE segment

 +1       ;

 +2        SET KEY=$PIECE(HLNODE,HLFS,5)

 +3       ;

 +4        SET ID=$PIECE(KEY,HLCS)

 +5        SET TEXT=$PIECE(KEY,HLCS,2)

 +6        SET CDSYS=$PIECE(KEY,HLCS,3)

 +7       ;

 +8        IF CDSYS="VASTANUM"

               Begin DoDot:1

 +9                SET IEN=$ORDER(^DIC(4,"D",ID,0))

                   IF IEN

                       QUIT 

 +10               SET IEN=$ORDER(^DIC(4,"B",TEXT,0))

               End DoDot:1

               QUIT 

 +11      ;

 +12       IF CDSYS="NPI"

               Begin DoDot:1

 +13               SET IEN=$ORDER(^DIC(4,"ANPI",ID,0))

                   IF IEN

                       QUIT 

 +14               SET IEN=$ORDER(^DIC(4,"B",TEXT,0))

               End DoDot:1

               QUIT 

 +15       IF CDSYS="DMIS"

               Begin DoDot:1

 +16               SET IEN=$ORDER(^DIC(4,"XUMFIDX","DMIS",ID,0))

                   IF IEN

                       QUIT 

 +17               SET IEN=$ORDER(^DIC(4,"B",TEXT,0))

               End DoDot:1

               QUIT 

 +18      ;

 +19       QUIT 

 +20      ;

ZIN       ; -- VHA Institution segment

 +1       ;

 +2        WRITE "."

 +3       ;

 +4        NEW NAME,FACTYP,OFNME,INACTIVE,STATE,VISN,PARENT,STREET,STREET2,CITY,ZIP

 +5        NEW STRT1,STRT2,CITY1,STATE1,STANUM,BILLNAME,IEN1,IENS,ERR,ERROR1

 +6        NEW ZIP1,AGENCY,NPIDT,NPISTAT,NPI,TAX,TAXPC,TAXSTAT,MAMMO,CLIA,DMIS,XXXX

 +7       ;

 +8        DO PARSE^XUMFXHL7("HLNODE","XXXX")

 +9       ;

 +10       SET STANUM=XXXX(2)

 +11      ;

 +12       IF $GET(STANUM)

               IF CDSYS'="VASTANUM"

                   QUIT 

 +13      ;

 +14       SET XUMF=1

           SET ERROR1=""

 +15      ;

 +16       SET NAME=XXXX(1)

 +17       SET FACTYP=$PIECE(XXXX(4),"~",1)

 +18       SET OFNME=XXXX(5)

 +19       SET INACTIVE=XXXX(6)

 +20       SET STATE=XXXX(7)

 +21       SET VISN=XXXX(8)

 +22       SET PARENT=XXXX(9)

 +23       SET STREET=$PIECE(XXXX(14),"~",1)

 +24       SET STREET2=$PIECE(XXXX(14),"~",2)

 +25       SET CITY=$PIECE(XXXX(14),"~",3)

 +26       SET ZIP=$PIECE(XXXX(14),"~",5)

 +27       SET STRT1=$PIECE(XXXX(15),"~",1)

 +28       SET STRT2=$PIECE(XXXX(15),"~",2)

 +29       SET CITY1=$PIECE(XXXX(15),"~",3)

 +30       SET STATE1=$PIECE(XXXX(15),"~",4)

 +31       SET ZIP1=$PIECE(XXXX(15),"~",5)

 +32       SET AGENCY=$PIECE(XXXX(16),"~")

 +33       SET NPI=XXXX(17)

 +34       SET NPISTAT=XXXX(18)

 +35       SET NPIDT=$$FMDATE^HLFNC(XXXX(19))

 +36       SET TAX=XXXX(20)

 +37       SET TAXSTAT=XXXX(21)

 +38       SET TAXPC=XXXX(22)

 +39       SET CLIA=XXXX(23)

 +40       SET MAMMO=XXXX(24)

 +41       SET DMIS=XXXX(25)

 +42       SET BILLNAME=XXXX(26)

 +43      ;

 +44      ; -- new entry

 +45       IF 'IEN

               Begin DoDot:1

 +46               NEW X,Y

                   SET X=NAME

 +47               KILL DIC

                   SET DIC=4

                   SET DIC(0)="F"

 +48               DO FILE^DICN

                   KILL DIC

 +49               SET IEN=$SELECT(Y="-1":0,1:+Y)

               End DoDot:1

               IF 'IEN

                   QUIT 

 +50      ;

 +51       SET IENS=IEN_","

 +52      ;

 +53       KILL FDA

 +54       SET FDA(4,IENS,.01)=NAME

 +55       SET FDA(4,IENS,13)=FACTYP

 +56       SET FDA(4,IENS,1.01)=STREET

 +57       SET FDA(4,IENS,1.02)=STREET2

 +58       SET FDA(4,IENS,1.03)=CITY

 +59       SET FDA(4,IENS,1.04)=ZIP

 +60       SET FDA(4,IENS,.02)=STATE

 +61       SET FDA(4,IENS,4.01)=STRT1

 +62       SET FDA(4,IENS,4.02)=STRT2

 +63       SET FDA(4,IENS,4.03)=CITY1

 +64       SET FDA(4,IENS,4.04)=STATE1

 +65       SET FDA(4,IENS,4.05)=ZIP1

 +66       SET FDA(4,IENS,11)="National"

 +67       SET FDA(4,IENS,100)=OFNME

 +68       SET FDA(4,IENS,101)=INACTIVE

 +69       SET FDA(4,IENS,95)=AGENCY

 +70       SET FDA(4,IENS,200)=BILLNAME

 +71       SET FDA(4,IENS,99)=STANUM

 +72       DO FILE^DIE("E","FDA")

 +73      ;

 +74       IF $GET(VISN)'=""

               Begin DoDot:1

 +75               KILL FDA

 +76               SET IENS="?+1,"_IEN_","

 +77               SET FDA(4.014,IENS,.01)="VISN"

 +78               SET FDA(4.014,IENS,1)=VISN

 +79               DO UPDATE^DIE("E","FDA")

               End DoDot:1

 +80      ;

 +81       IF $GET(PARENT)'=""

               Begin DoDot:1

 +82               KILL FDA

 +83               SET IENS="?+2,"_IEN_","

 +84               SET FDA(4.014,IENS,.01)="PARENT FACILITY"

 +85               SET FDA(4.014,IENS,1)=PARENT

 +86               DO UPDATE^DIE("E","FDA")

               End DoDot:1

 +87      ;

 +88       IF $GET(NPIDT)'=""

               IF $GET(^DIC(4,IEN,"NPI"))'=NPI

                   Begin DoDot:1

 +89                   SET IENS="?+1,"_IEN_","

 +90                   SET FDA(4.042,IENS,.01)=NPIDT

 +91                   SET FDA(4.042,IENS,.02)=NPISTAT

 +92                   SET FDA(4.042,IENS,.03)=NPI

 +93                   DO UPDATE^DIE("E","FDA")

                   End DoDot:1

 +94      ;

 +95       IF $GET(TAX)'=""

               IF $PIECE($$TAXORG^XUSTAX(IEN),U)'=TAX

                   Begin DoDot:1

 +96                   KILL FDA,ROOT,IDX

 +97                   SET IENS="?+1,"_IEN_","

 +98                   SET FDA(4.043,IENS,.01)=TAX

 +99                   SET FDA(4.043,IENS,.02)=TAXPC

 +100                  SET FDA(4.043,IENS,.03)=TAXSTAT

 +101                  DO UPDATE^DIE("E","FDA")

                   End DoDot:1

 +102     ;

 +103      IF $GET(CLIA)'=""

               Begin DoDot:1

 +104              SET IENS="?+2,"_IEN_","

 +105              KILL FDA

 +106              SET FDA(4.9999,IENS,.01)="CLIA"

 +107              SET FDA(4.9999,IENS,.02)=CLIA

 +108              DO UPDATE^DIE("E","FDA")

               End DoDot:1

 +109     ;

 +110      IF $GET(MAMMO)'=""

               Begin DoDot:1

 +111              SET IENS="?+2,"_IEN_","

 +112              KILL FDA

 +113              SET FDA(4.9999,IENS,.01)="MAMMO"

 +114              SET FDA(4.9999,IENS,.02)=MAMMO

 +115              DO UPDATE^DIE("E","FDA")

               End DoDot:1

 +116     ;

 +117      IF $GET(DMIS)'=""

               Begin DoDot:1

 +118              SET IENS="?+2,"_IEN_","

 +119              KILL FDA

 +120              SET FDA(4.9999,IENS,.01)="DMIS"

 +121              SET FDA(4.9999,IENS,.02)=DMIS

 +122              DO UPDATE^DIE("E","FDA")

               End DoDot:1

 +123     ;

 +124      QUIT 

 +125     ;

REPLY     ; -- master file response

 +1       ;

 +2        IF HL("MTN")="MFR"

               QUIT 

 +3        IF HL("MTN")="MFK"

               QUIT 

 +4        IF HL("MTN")="ACK"

               QUIT 

 +5       ;

 +6        NEW X

 +7        SET X="MSA"_HLFS_$SELECT(ERROR:"AE",1:"AA")_HLFS_HL("MID")_HLFS_$PIECE(ERROR,U,2)

 +8        SET ^TMP("HLA",$JOB,1)=X

 +9       ;

 +10       SET HLP("PRIORITY")="I"

 +11       DO GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLT)

 +12      ;

 +13      ; check for error

 +14       IF ($PIECE($GET(HLRESLT),U,3)'="")

               Begin DoDot:1

 +15               SET ERROR=1_U_$PIECE(HLRESLT,HLFS,3)_U_$PIECE(HLRESLT,HLFS,2)_U_$PIECE(HLRESLT,U)

               End DoDot:1

               QUIT 

 +16      ;

 +17      ; successful call, message ID returned

 +18       SET ERROR="0^"_$PIECE($GET(HLRESLT),U,1)

 +19      ;

 +20       QUIT 

 +21      ;

EXIT      ; -- cleanup, and quit

 +1       ;

 +2        QUIT 

 +3       ;