VAFCTFIN.m

VAFCTFIN ;BIR/DR-TREATING FACILTIY MFU PROCESSING ROUTINE ; 1/21/10 4:26pm

 ;;5.3;PIMS;**428,474,520,639,707,1015,1016**;JUN 30, 2012;Build 20

 ;Reference to EXC, START, and STOP^RGHLLOG supported by IA #2796

 ;

IN ;This entry point is used to process the Treating Facility Master File Update Message.

 ;It is called by the VAFC MFN-M05 CLIENT processing routine when a MFN

 ;message is received.

 ;There are no inputs or outputs

 ;

 ;Initial check whether incoming MFN message is old format or new. If it is old format, go to old routine (VAFCOFIN) to process.  **821

 I HL("MTN")="MFK" D RSP Q

 N VAFC,SG,MSG

 F VAFCI=1:1 X HLNEXT Q:HLQUIT'>0  I $E(HLNODE,1,3)="MFE" S MSG=HLNODE

 I $P($G(MSG),"^",3)'["-" D IN^VAFCOFIN Q

 K VAFCI,HLNODE,SG,HLQUIT,HLDONE,MSG

 S HLQUIT=0

 ;

 N VAFC,STATN,VAFCI,MSG,SG,VAFCARR,PDFN,INST,MFUPT,PDLT,TFIEN

 N ICN,MFI,MFE,MFA,HLCOMP,CNT,X,VAFCERR,VAFCX

 ;quit if Master Patient Index (MPI) is not installed

 S X="MPIF001" X ^%ZOSF("TEST") Q:'$T

 S X="MPIFQ0" X ^%ZOSF("TEST") Q:'$T

 S X="RGRSBUL1" X ^%ZOSF("TEST") Q:'$T

 S X="RGRSBULL" X ^%ZOSF("TEST") Q:'$T

INIT ;Process in the Treating Facility MFN msg

 F VAFCI=1:1 X HLNEXT Q:HLQUIT'>0  S (MSG,VAFC(VAFCI))=HLNODE,SG=$E(HLNODE,1,3) D:SG?2A1(1A,1N) PICK

 ;reconcil the inbound TF list from the MPI to the local TF list

 D RECONCIL

 ;create response message

 S CNT=1

 S HLA("HLA",1)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")_HL("FS") S CNT=CNT+1

 S HLA("HLA",CNT)=MFI S CNT=CNT+1

 ;S VAFCX=0 F  S VAFCX=$O(MFE(VAFCX)) Q:'VAFCX  S HLA("HLA",CNT)=MFE(VAFCX),CNT=CNT+1,HLA("HLA",CNT)=MFA(VAFCX),CNT=CNT+1

 S VAFCX=0 F  S VAFCX=$O(MFE(VAFCX)) Q:'VAFCX  D

 . S VAFCN=0 F  S VAFCN=$O(MFE(VAFCX,VAFCN)) Q:'VAFCN  D

 .. S HLA("HLA",CNT)=MFE(VAFCX,VAFCN),CNT=CNT+1,HLA("HLA",CNT)=MFA(VAFCX,VAFCN),CNT=CNT+1

 ;generate an application level ack (MFK) identifying the status of the adds/edits/deletes of TF's passed in

 D ROUTE

 D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.VAFCERR,"",.HLP)

 Q

PICK ;check routine for segment entry point

 I $T(@SG)]"" D @SG

 I $T(@SG)="" Q

 Q

MSH ;;MSH

 ;process the MSH segment

 S (HLFS,HL("FS"))=$E(MSG,4),(HLECH,HL("ECH"))=$E(MSG,5,8)

 S HLCOMP=$E(HL("ECH"),1)

 S VAFCARR("SENDING SITE")=$P(MSG,HL("FS"),4)

 Q

EVN ;;EVN

 ;process the EVN segment

 S STATN=+$$SITE^VASITE()_"^"_$$FMDATE^HLFNC($P(MSG,HL("FS"),3))

 Q

PID ;;PID

 ;process the PID segment

 S PDFN=+$P(MSG,HL("FS"),4)

 Q

MFI ;;MFI

 ;process the MFI segment

 S MFI=MSG

 S MFUPT=$P(MSG,HL("FS"),4)

 S VAFCARR("CMOR")=$P($P(MSG,HL("FS"),8),$E(HL("ECH"),1))

 Q

MFE ;;MFE

 ;process the MFE segment

 N HLCOMP,NXTSGMT,TYPE,REP,MFE4,DFNATST,IDENSTAT

 S HLCOMP=$E(HL("ECH"),1),REP=$E(HL("ECH"),2)

 S PDLT=$$FMDATE^HLFNC($P(MSG,HL("FS"),4))

 ;S ICN=$P($P(MSG,HL("FS"),5),HLCOMP,4)

 ;S INST=$P($P(MSG,HL("FS"),5),HLCOMP)

 S TYPE=$P(MSG,HL("FS"),2)

 S MFE4=$P(MSG,HL("FS"),5) ;SEQ 4

 S ICN=$P($P(MFE4,REP),HLCOMP)

 S INST=$P($P(MSG,HL("FS"),3),"-")

 S ZCNT=$P($P(MSG,HL("FS"),3),"-",2)

 S DFNATST=$P($P(MFE4,REP,2),HLCOMP)

 S IDENSTAT=$S(TYPE="MDC":"H",1:"A")

 S MFE(INST,ZCNT)=MSG

 S MFI(ICN,INST,ZCNT)=PDLT_"^^"_TYPE_"^^^^"_DFNATST_"^"_IDENSTAT

 Q

ZET ;;ZET

 ;process Patient's Date Last Treated Event Type, ZET segment

 N PDLTET,IPP

 S PDLTET=$P(MSG,HL("FS"),2)

 S $P(MFI(ICN,INST,ZCNT),"^",2)=PDLTET

 ;DG*5.3*800 - Process In-Person Proofed

 S IPP=$P(MSG,HL("FS"),3) ;In-Person Proofed

 S $P(MFI(ICN,INST,ZCNT),"^",6)=IPP

 Q

RSP ;response process logic entry point

 Q

ROUTE ;routing logic entry point

 N MPI

 S MPI=$$MPILINK^MPIFAPI() D

 .I $P($G(MPI),U)'=-1 S HLL("LINKS",1)="VAFC MFN-M05 CLIENT"_"^"_MPI

 .I $P($G(MPI),U)=-1 D

 .. N RGLOG D START^RGHLLOG(HLMTIEN,"","")

 .. D EXC^RGHLLOG(224,"No MPI link identified in CIRN SITE PARAMETER file (#991.8)",$G(PDFN))

 .. D STOP^RGHLLOG(0)

 Q

TEST ;

 W $$REPROC^HLUTIL(39266,"D IN^VAFCTFIN")

 Q

RECONCIL ;

 N DFN,MFIC,VAFCX,VAFCY,TFL,CNFLT,LOCCMOR,VAFCTYPE,VAFCN,IDSTAT,SID

 S CNFLT=0

 S DFN=$$GETDFN^MPIF001(ICN)

 I DFN'>0 S CNFLT=1_"^"_$P($G(DFN),"^",2)

 I MFUPT="REP" I +CNFLT=0 D TFL^VAFCTFU1(.TFL,DFN) S VAFCX=0 F  S VAFCX=$O(TFL(VAFCX)) Q:'VAFCX  D

 . S MFIC($P(TFL(VAFCX),"^"))=TFL(VAFCX) I '$D(MFI(ICN,$P(TFL(VAFCX),"^"))) D DEL(ICN,$P(TFL(VAFCX),"^"))

 ;VAFCX=ICN and VAFCY=INSTITUTION

 S VAFCX=0 F  S VAFCX=$O(MFI(VAFCX)) Q:'VAFCX  D

 . S VAFCY=0 F  S VAFCY=$O(MFI(VAFCX,VAFCY)) Q:'VAFCY  D

 .. S VAFCN=0 F  S VAFCN=$O(MFI(VAFCX,VAFCY,VAFCN)) Q:'VAFCN  D

 ... S VAFCTYPE=$P(MFI(VAFCX,VAFCY,VAFCN),"^",3)

 ... S SID=$P(MFI(VAFCX,VAFCY,VAFCN),"^",7)

 ... S IDSTAT=$P(MFI(VAFCX,VAFCY,VAFCN),"^",8)

 ... I +CNFLT=1 D

 ....S MFA(VAFCY,VAFCN)="MFA"_HL("FS")_VAFCTYPE_HL("FS")_VAFCY_"-"_VAFCN_HL("FS")_$$HLDATE^HLFNC($$NOW^XLFDT)_HL("FS")_"U"_HLCOMP_$S(VAFCTYPE="MDL":"Delete of ",1:"Update of ")

 ....S MFA(VAFCY,VAFCN)=$G(MFA(VAFCY,VAFCN))_VAFCY_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to "_$P(CNFLT,"^",2)

 ... I +CNFLT=0 I VAFCTYPE="MAD"!(VAFCTYPE="MUP")!(VAFCTYPE="MDC") D ADDUPD(DFN,VAFCY,$P(MFI(VAFCX,VAFCY,VAFCN),"^"),$P(MFI(VAFCX,VAFCY,VAFCN),"^",2),$P(MFI(VAFCX,VAFCY,VAFCN),"^",6),$G(SID),$G(IDSTAT),VAFCN,VAFCTYPE)

 ... I +CNFLT=0 I VAFCTYPE="MDL" D DEL(ICN,VAFCY,VAFCN)

 Q

ADDUPD(DFN,INST,PDLT,PDLRTET,IPP,DFNATST,IDENSTAT,ZCNT,VAFCTYPE) ;add or update TF entry

 N ERROR,STA

 S STA=INST

 S INST=$$LKUP^XUAF4(INST)

 I INST=0 S ERROR(STA)="Update of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to unknown Institution IEN "_INST_" passed into TF update."

 I '$D(ERROR(STA)) D FILE^VAFCTFU(DFN,INST_"^"_$G(PDLT)_"^"_$G(PDLRTET),1,1,.ERROR,$G(IPP),DFNATST,IDENSTAT)

 S MFA(STA,ZCNT)="MFA"_HL("FS")_VAFCTYPE_HL("FS")_STA_"-"_ZCNT_HL("FS")_$$HLDATE^HLFNC($$NOW^XLFDT)_HL("FS")

 I '$D(ERROR(STA)) S MFA(STA,ZCNT)=MFA(STA,ZCNT)_"S"

 I $D(ERROR(STA)) S MFA(STA,ZCNT)=MFA(STA,ZCNT)_"U"_HLCOMP_ERROR(STA)_HL("FS")

 Q

DEL(ICN,INST) ;delete a TF entry

 N ERROR,STA

 S STA=INST

 S INST=$$LKUP^XUAF4(INST)

 S ERROR=$$DELETETF^VAFCTFU(ICN,INST)

 ;**821 - No need to send MFA for entries that are deleted locally

 ;S MFA(STA,ZCNT)="MFA"_HL("FS")_"MDL"_HL("FS")_STA_"-"_ZCNT_HL("FS")_$$HLDATE^HLFNC($$NOW^XLFDT)_HL("FS")

 ;I +ERROR'=1 S MFA(STA,ZCNT)=MFA(STA,ZCNT)_"S"

 ;I +ERROR=1 S MFA(STA,ZCNT)=MFA(STA,ZCNT)_"U"_HLCOMP_"Delete Failed: "_$P(ERROR,"^",2)

 Q

VAFCTFIN  ;BIR/DR-TREATING FACILTIY MFU PROCESSING ROUTINE ; 1/21/10 4:26pm

 +1       ;;5.3;PIMS;**428,474,520,639,707,1015,1016**;JUN 30, 2012;Build 20

 +2       ;Reference to EXC, START, and STOP^RGHLLOG supported by IA #2796

 +3       ;

IN        ;This entry point is used to process the Treating Facility Master File Update Message.

 +1       ;It is called by the VAFC MFN-M05 CLIENT processing routine when a MFN

 +2       ;message is received.

 +3       ;There are no inputs or outputs

 +4       ;

 +5       ;Initial check whether incoming MFN message is old format or new. If it is old format, go to old routine (VAFCOFIN) to process.  **821

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

               DO RSP

               QUIT 

 +7        NEW VAFC,SG,MSG

 +8        FOR VAFCI=1:1

               XECUTE HLNEXT

               IF HLQUIT'>0

                   QUIT 

               IF $EXTRACT(HLNODE,1,3)="MFE"

                   SET MSG=HLNODE

 +9        IF $PIECE($GET(MSG),"^",3)'["-"

               DO IN^VAFCOFIN

               QUIT 

 +10       KILL VAFCI,HLNODE,SG,HLQUIT,HLDONE,MSG

 +11       SET HLQUIT=0

 +12      ;

 +13       NEW VAFC,STATN,VAFCI,MSG,SG,VAFCARR,PDFN,INST,MFUPT,PDLT,TFIEN

 +14       NEW ICN,MFI,MFE,MFA,HLCOMP,CNT,X,VAFCERR,VAFCX

 +15      ;quit if Master Patient Index (MPI) is not installed

 +16       SET X="MPIF001"

           XECUTE ^%ZOSF("TEST")

           IF '$TEST

               QUIT 

 +17       SET X="MPIFQ0"

           XECUTE ^%ZOSF("TEST")

           IF '$TEST

               QUIT 

 +18       SET X="RGRSBUL1"

           XECUTE ^%ZOSF("TEST")

           IF '$TEST

               QUIT 

 +19       SET X="RGRSBULL"

           XECUTE ^%ZOSF("TEST")

           IF '$TEST

               QUIT 

INIT      ;Process in the Treating Facility MFN msg

 +1        FOR VAFCI=1:1

               XECUTE HLNEXT

               IF HLQUIT'>0

                   QUIT 

               SET (MSG,VAFC(VAFCI))=HLNODE

               SET SG=$EXTRACT(HLNODE,1,3)

               IF SG?2A1(1A,1N)

                   DO PICK

 +2       ;reconcil the inbound TF list from the MPI to the local TF list

 +3        DO RECONCIL

 +4       ;create response message

 +5        SET CNT=1

 +6        SET HLA("HLA",1)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")_HL("FS")

           SET CNT=CNT+1

 +7        SET HLA("HLA",CNT)=MFI

           SET CNT=CNT+1

 +8       ;S VAFCX=0 F  S VAFCX=$O(MFE(VAFCX)) Q:'VAFCX  S HLA("HLA",CNT)=MFE(VAFCX),CNT=CNT+1,HLA("HLA",CNT)=MFA(VAFCX),CNT=CNT+1

 +9        SET VAFCX=0

           FOR 

               SET VAFCX=$ORDER(MFE(VAFCX))

               IF 'VAFCX

                   QUIT 

               Begin DoDot:1

 +10               SET VAFCN=0

                   FOR 

                       SET VAFCN=$ORDER(MFE(VAFCX,VAFCN))

                       IF 'VAFCN

                           QUIT 

                       Begin DoDot:2

 +11                       SET HLA("HLA",CNT)=MFE(VAFCX,VAFCN)

                           SET CNT=CNT+1

                           SET HLA("HLA",CNT)=MFA(VAFCX,VAFCN)

                           SET CNT=CNT+1

                       End DoDot:2

               End DoDot:1

 +12      ;generate an application level ack (MFK) identifying the status of the adds/edits/deletes of TF's passed in

 +13       DO ROUTE

 +14       DO GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.VAFCERR,"",.HLP)

 +15       QUIT 

PICK      ;check routine for segment entry point

 +1        IF $TEXT(@SG)]""

               DO @SG

 +2        IF $TEXT(@SG)=""

               QUIT 

 +3        QUIT 

MSH       ;;MSH

 +1       ;process the MSH segment

 +2        SET (HLFS,HL("FS"))=$EXTRACT(MSG,4)

           SET (HLECH,HL("ECH"))=$EXTRACT(MSG,5,8)

 +3        SET HLCOMP=$EXTRACT(HL("ECH"),1)

 +4        SET VAFCARR("SENDING SITE")=$PIECE(MSG,HL("FS"),4)

 +5        QUIT 

EVN       ;;EVN

 +1       ;process the EVN segment

 +2        SET STATN=+$$SITE^VASITE()_"^"_$$FMDATE^HLFNC($PIECE(MSG,HL("FS"),3))

 +3        QUIT 

PID       ;;PID

 +1       ;process the PID segment

 +2        SET PDFN=+$PIECE(MSG,HL("FS"),4)

 +3        QUIT 

MFI       ;;MFI

 +1       ;process the MFI segment

 +2        SET MFI=MSG

 +3        SET MFUPT=$PIECE(MSG,HL("FS"),4)

 +4        SET VAFCARR("CMOR")=$PIECE($PIECE(MSG,HL("FS"),8),$EXTRACT(HL("ECH"),1))

 +5        QUIT 

MFE       ;;MFE

 +1       ;process the MFE segment

 +2        NEW HLCOMP,NXTSGMT,TYPE,REP,MFE4,DFNATST,IDENSTAT

 +3        SET HLCOMP=$EXTRACT(HL("ECH"),1)

           SET REP=$EXTRACT(HL("ECH"),2)

 +4        SET PDLT=$$FMDATE^HLFNC($PIECE(MSG,HL("FS"),4))

 +5       ;S ICN=$P($P(MSG,HL("FS"),5),HLCOMP,4)

 +6       ;S INST=$P($P(MSG,HL("FS"),5),HLCOMP)

 +7        SET TYPE=$PIECE(MSG,HL("FS"),2)

 +8       ;SEQ 4

           SET MFE4=$PIECE(MSG,HL("FS"),5)

 +9        SET ICN=$PIECE($PIECE(MFE4,REP),HLCOMP)

 +10       SET INST=$PIECE($PIECE(MSG,HL("FS"),3),"-")

 +11       SET ZCNT=$PIECE($PIECE(MSG,HL("FS"),3),"-",2)

 +12       SET DFNATST=$PIECE($PIECE(MFE4,REP,2),HLCOMP)

 +13       SET IDENSTAT=$SELECT(TYPE="MDC":"H",1:"A")

 +14       SET MFE(INST,ZCNT)=MSG

 +15       SET MFI(ICN,INST,ZCNT)=PDLT_"^^"_TYPE_"^^^^"_DFNATST_"^"_IDENSTAT

 +16       QUIT 

ZET       ;;ZET

 +1       ;process Patient's Date Last Treated Event Type, ZET segment

 +2        NEW PDLTET,IPP

 +3        SET PDLTET=$PIECE(MSG,HL("FS"),2)

 +4        SET $PIECE(MFI(ICN,INST,ZCNT),"^",2)=PDLTET

 +5       ;DG*5.3*800 - Process In-Person Proofed

 +6       ;In-Person Proofed

           SET IPP=$PIECE(MSG,HL("FS"),3)

 +7        SET $PIECE(MFI(ICN,INST,ZCNT),"^",6)=IPP

 +8        QUIT 

RSP       ;response process logic entry point

 +1        QUIT 

ROUTE     ;routing logic entry point

 +1        NEW MPI

 +2        SET MPI=$$MPILINK^MPIFAPI()

           Begin DoDot:1

 +3            IF $PIECE($GET(MPI),U)'=-1

                   SET HLL("LINKS",1)="VAFC MFN-M05 CLIENT"_"^"_MPI

 +4            IF $PIECE($GET(MPI),U)=-1

                   Begin DoDot:2

 +5                    NEW RGLOG

                       DO START^RGHLLOG(HLMTIEN,"","")

 +6                    DO EXC^RGHLLOG(224,"No MPI link identified in CIRN SITE PARAMETER file (#991.8)",$GET(PDFN))

 +7                    DO STOP^RGHLLOG(0)

                   End DoDot:2

           End DoDot:1

 +8        QUIT 

TEST      ;

 +1        WRITE $$REPROC^HLUTIL(39266,"D IN^VAFCTFIN")

 +2        QUIT 

RECONCIL  ;

 +1        NEW DFN,MFIC,VAFCX,VAFCY,TFL,CNFLT,LOCCMOR,VAFCTYPE,VAFCN,IDSTAT,SID

 +2        SET CNFLT=0

 +3        SET DFN=$$GETDFN^MPIF001(ICN)

 +4        IF DFN'>0

               SET CNFLT=1_"^"_$PIECE($GET(DFN),"^",2)

 +5        IF MFUPT="REP"

               IF +CNFLT=0

                   DO TFL^VAFCTFU1(.TFL,DFN)

                   SET VAFCX=0

                   FOR 

                       SET VAFCX=$ORDER(TFL(VAFCX))

                       IF 'VAFCX

                           QUIT 

                       Begin DoDot:1

 +6                        SET MFIC($PIECE(TFL(VAFCX),"^"))=TFL(VAFCX)

                           IF '$DATA(MFI(ICN,$PIECE(TFL(VAFCX),"^")))

                               DO DEL(ICN,$PIECE(TFL(VAFCX),"^"))

                       End DoDot:1

 +7       ;VAFCX=ICN and VAFCY=INSTITUTION

 +8        SET VAFCX=0

           FOR 

               SET VAFCX=$ORDER(MFI(VAFCX))

               IF 'VAFCX

                   QUIT 

               Begin DoDot:1

 +9                SET VAFCY=0

                   FOR 

                       SET VAFCY=$ORDER(MFI(VAFCX,VAFCY))

                       IF 'VAFCY

                           QUIT 

                       Begin DoDot:2

 +10                       SET VAFCN=0

                           FOR 

                               SET VAFCN=$ORDER(MFI(VAFCX,VAFCY,VAFCN))

                               IF 'VAFCN

                                   QUIT 

                               Begin DoDot:3

 +11                               SET VAFCTYPE=$PIECE(MFI(VAFCX,VAFCY,VAFCN),"^",3)

 +12                               SET SID=$PIECE(MFI(VAFCX,VAFCY,VAFCN),"^",7)

 +13                               SET IDSTAT=$PIECE(MFI(VAFCX,VAFCY,VAFCN),"^",8)

 +14                               IF +CNFLT=1

                                       Begin DoDot:4

 +15                                       SET MFA(VAFCY,VAFCN)="MFA"_HL("FS")_VAFCTYPE_HL("FS")_VAFCY_"-"_VAFCN_HL("FS")_$$HLDATE^HLFNC($$NOW^XLFDT)_HL("FS")_"U"_HLCOMP_$SELECT(VAFCTYPE="MDL":"Delete of ",1:"Update of ")

 +16                                       SET MFA(VAFCY,VAFCN)=$GET(MFA(VAFCY,VAFCN))_VAFCY_" Failed at "_$PIECE($$SITE^VASITE,"^",3)_" due to "_$PIECE(CNFLT,"^",2)

                                       End DoDot:4

 +17                               IF +CNFLT=0

                                       IF VAFCTYPE="MAD"!(VAFCTYPE="MUP")!(VAFCTYPE="MDC")

                                           DO ADDUPD(DFN,VAFCY,$PIECE(MFI(VAFCX,VAFCY,VAFCN),"^"),$PIECE(MFI(VAFCX,VAFCY,VAFCN),"^",2),$PIECE(MFI(VAFCX,VAFCY,VAFCN),"^",6),$GET(SID),$GET(IDSTAT),VAFCN,VAFCTYPE)

 +18                               IF +CNFLT=0

                                       IF VAFCTYPE="MDL"

                                           DO DEL(ICN,VAFCY,VAFCN)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +19       QUIT 

ADDUPD(DFN,INST,PDLT,PDLRTET,IPP,DFNATST,IDENSTAT,ZCNT,VAFCTYPE) ;add or update TF entry

 +1        NEW ERROR,STA

 +2        SET STA=INST

 +3        SET INST=$$LKUP^XUAF4(INST)

 +4        IF INST=0

               SET ERROR(STA)="Update of "_STA_" Failed at "_$PIECE($$SITE^VASITE,"^",3)_" due to unknown Institution IEN "_INST_" passed into TF update."

 +5        IF '$DATA(ERROR(STA))

               DO FILE^VAFCTFU(DFN,INST_"^"_$GET(PDLT)_"^"_$GET(PDLRTET),1,1,.ERROR,$GET(IPP),DFNATST,IDENSTAT)

 +6        SET MFA(STA,ZCNT)="MFA"_HL("FS")_VAFCTYPE_HL("FS")_STA_"-"_ZCNT_HL("FS")_$$HLDATE^HLFNC($$NOW^XLFDT)_HL("FS")

 +7        IF '$DATA(ERROR(STA))

               SET MFA(STA,ZCNT)=MFA(STA,ZCNT)_"S"

 +8        IF $DATA(ERROR(STA))

               SET MFA(STA,ZCNT)=MFA(STA,ZCNT)_"U"_HLCOMP_ERROR(STA)_HL("FS")

 +9        QUIT 

DEL(ICN,INST) ;delete a TF entry

 +1        NEW ERROR,STA

 +2        SET STA=INST

 +3        SET INST=$$LKUP^XUAF4(INST)

 +4        SET ERROR=$$DELETETF^VAFCTFU(ICN,INST)

 +5       ;**821 - No need to send MFA for entries that are deleted locally

 +6       ;S MFA(STA,ZCNT)="MFA"_HL("FS")_"MDL"_HL("FS")_STA_"-"_ZCNT_HL("FS")_$$HLDATE^HLFNC($$NOW^XLFDT)_HL("FS")

 +7       ;I +ERROR'=1 S MFA(STA,ZCNT)=MFA(STA,ZCNT)_"S"

 +8       ;I +ERROR=1 S MFA(STA,ZCNT)=MFA(STA,ZCNT)_"U"_HLCOMP_"Delete Failed: "_$P(ERROR,"^",2)

 +9        QUIT