Routine: ABMUVHF

ABMUVHF ; IHS/SD/SDR - UFMS View Host File

 ;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009

 ;IHS/SD/SDR - abm*2.6*1 - Updated display for new fields.  Fixes:

 ;  3PMS10019

 ;  FIXPMS10001

 ;  FIXPMS10011

 ;  FIXPMS10026

 ;  FIXPMS10027

EP ;EP - choose file to view

 N ABMDIR,DESTIP,ARGS,ABMUFMS

 S $P(ABMDASH,"-",81)=""

 S ABMDIR=$P($G(^ABMDPARM(DUZ(2),1,4)),U,13)  ;UFMS directory

 I ABMDIR="" D  Q

 .W !!,"Before UFMS files can be created a non-public directory must be created"

 .W !,"on the Host File System. This directory must be entered in UFMS DIRECTORY"

 .W !,"using option SET  UFMS SETUP"

 .W !

 .K DIR S DIR(0)="E" D ^DIR K DIR

 W !!,"CURRENT UFMS DIRECTORY IS ",ABMDIR

 K DIR

 S DIR(0)="FO"

 S DIR("?",1)="Enter a file name e.g. IHS_TPB_RPMS_113510_20070806_084701.DAT,"

 S DIR("?",2)="or a partial filename IHS_TPB_RPMS*, the * is a wildcard,"

 S DIR("?")="or * to list all UFMS files in the UFMS directory."

 S DIR("A")="Enter filename "

 D ^DIR

 Q:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)!(Y="")!(Y=" ")

 S ABMFILE=Y

 I $E(ABMFILE,1,15)="IHS_AR_RPMS_REC" W "   ??" H 1 G EP

 I ABMFILE="*" S ABMFILE="IHS_TPB_RPMS_INV*"

 K ABMARRAY

 D LIST^%ZISH(ABMDIR,ABMFILE,.ABMARRAY)

 I '$D(ABMARRAY) W "    ??" H 1 G EP

 W @IOF

 W !!!,"FILES FOUND: "

 S (ABMKEY,ABMLN,ABMSEL)=""

 S ABMF=1

 F ABMCNT=1:1 S ABMLN=$O(ABMARRAY(ABMLN)) Q:ABMKEY!(ABMLN="")!$G(ABMSEL)  D

 .W !,ABMLN_"."

 .W ?5,ABMARRAY(ABMLN)

 .I '(ABMCNT#10) D

 ..K DIR

 ..S DIR(0)="NO^1:"_ABMCNT

 ..S DIR("A")="Enter item number: "

 ..D ^DIR

 ..S ABMSEL=Y

 ..S ABMKEY=$D(DUOUT)!($D(DTOUT))

 Q:ABMKEY

 I '$G(ABMSEL),ABMLN="" D  Q:ABMKEY

 .K DIR

 .S DIR(0)="NO^1:"_(ABMCNT-1)

 .S DIR("A")="Enter item number: "

 .D ^DIR

 .S ABMSEL=Y

 .S ABMKEY=$D(DUOUT)!($D(DTOUT))!(Y="")

 S ABMITEM=ABMSEL

ASKTYP ;EP - ask for type of report--file layout or captioned

 K DIR

 S DIR(0)="SO^F:FILE LAYOUT;C:CAPTIONED"

 D ^DIR

 G:$D(DUOUT)!$D(DTOUT)!(Y="") EP

 S ABMRTYP=Y

 D FILE(ABMDIR,ABMARRAY(ABMITEM),ABMRTYP)

 G EP

FILE(ABMDIR,ABMFN,ABMRTYP) ;EP

 ; Pull up a file into the TMP global for display

 N Y,X,I,ABMRTNAM

 S Y=$$OPEN^%ZISH(ABMDIR,ABMFN,"R")

 I Y W !,"CAN'T OPEN FILE" H 3 Q

 S ABMRTNAM=$P($T(+1)," ")

 K ^TMP(ABMRTNAM,$J)

 F I=1:1 U IO R X:1 Q:$$STATUS^%ZISH=-1  S ^TMP(ABMRTNAM,$J,I,0)=X

 D ^%ZISC

 I $D(^TMP(ABMRTNAM,$J)) D DISPLAY(ABMFN,ABMRTYP)

 K ^TMP(ABMRTNAM,$J)

DISPLAY(ABMFNAME,ABMRTYP) ;EP - display file

 S (ABMESC,ABMPG)=0

 D FNHDR(ABMFNAME,ABMRTYP)

 S ABMRNUM=0

 F  S ABMRNUM=$O(^TMP(ABMRTNAM,$J,ABMRNUM)) Q:'ABMRNUM!(ABMESC)  D

 .I $Y>(IOSL-4) W ! K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR S ABMESC=X=U Q:ABMESC  D FNHDR(ABMFNAME,ABMRTYP)

 .S ABMREC=$G(^TMP(ABMRTNAM,$J,ABMRNUM,0))

 .I ABMRTYP="C" D CAPTIONS(ABMFNAME,ABMREC,ABMRNUM) Q

 .W !,ABMRNUM

 .W ?6,ABMREC

 Q:ABMESC

 I '$D(ZTQUEUED) D

 .K DIR

 .S DIR(0)="E"

 .D ^DIR

FNHDR(ABMFNAME,ABMRTYP) ;EP - header display

 I IOM=80 D FNHDR80 Q

 I IOM=132 D FNHDR132 Q

FNHDR132 ;EP - 132 column header

 W !,"NOT YET IMPLEMENTED" H 3

FNHDR80 ;EP - 80 column header

 S ABMPG=$G(ABMPG)+1

 W @IOF

 S X="UFMS HOST FILE VIEW"

 S X=$J("",IOM-$L(X)\2-$X)_X

 W !,X

 W ?70,"PAGE ",ABMPG

 W !,$$CJ^XLFSTR("FILE: "_ABMFNAME,IOM)

 I ABMRTYP="C" W !,$$CJ^XLFSTR("CAPTIONED LAYOUT",IOM),ABMDASH Q

 W !!?7,"INVOICE#"

 W ?27,"DT/TM APP."

 W ?37,"TAX ID"

 W ?47,"DESCRIPTION"

 W !?67,"BILL AMT"

 W !?7,"CAN"

 W ?17,"HHS T-CD"

 W ?27,"OBJCL"

 W ?32,"BUDG. ACT"

 W ?42,"CC"

 W ?45,"MASTER TIN"

 W ?75,"DOS"  ;abm*2.6*2 FIXPMS10011

 W !?5,"VISIT TYPE"  ;abm*2.6*2 FIXPMS10026

 W ?55,"INSURER TYPE"  ;abm*2.6*2 FIXPMS10027

 W !,ABMDASH

CAPTIONS(ABMFNAME,ABMREC,ABMRNUM) ;EP - captioned records

 S ABMRECT=$TR($E(ABMREC,1,1)," ")

 ;start old code abm*2.6*2 NO HEAT

 ;S ABMINV=$TR($E(ABMREC,2,21)," ")

 ;S ABMDTTMA=$TR($E(ABMREC,22,31)," ")

 ;S ABMTAXID=$TR($E(ABMREC,32,41)," ")

 ;S ABMDESC=$TR($E(ABMREC,42,141)," ")

 ;S ABMAMT=+$TR($E(ABMREC,142,161)," ")

 ;S ABMAMT=$E(ABMAMT,1,$L(ABMAMT)-2)_"."_$E(ABMAMT,$L(ABMAMT)-1,$L(ABMAMT))

 ;S ABMAMT=$E(ABMAMT,1,$L(ABMAMT)-2)_"."_$E(ABMAMT,$L(ABMAMT)-1,$L(ABMAMT))

 ;S ABMCAN=$TR($E(ABMREC,162,171)," ")

 ;S ABMTCODE=$TR($E(ABMREC,172,181)," ")

 ;S ABMCL=$TR($E(ABMREC,182,186)," ")

 ;S ABMCC=$TR($E(ABMREC,197,199)," ")

 ;end old code start new code NO HEAT

 S ABMINV=$TR($E(ABMREC,2,41)," ")

 S ABMDTTMA=$TR($E(ABMREC,42,51)," ")

 S ABMTAXID=$TR($E(ABMREC,52,61)," ")

 S ABMDESC=$TR($E(ABMREC,62,161)," ")

 S ABMAMT=+$TR($E(ABMREC,162,181)," ")

 S ABMAMT=$E(ABMAMT,1,$L(ABMAMT)-2)_"."_$E(ABMAMT,$L(ABMAMT)-1,$L(ABMAMT))

 S ABMCAN=$TR($E(ABMREC,192,201)," ")

 S ABMTCODE=$TR($E(ABMREC,202,206)," ")

 S ABMCL=$TR($E(ABMREC,182,186)," ")

 S ABMCC=$TR($E(ABMREC,207,209)," ")

 ;end new code NO HEAT

 S ABMBUDG=$TR($E(ABMREC,187,196)," ")

 S ABMCC=$TR($E(ABMREC,197,199)," ")

 S ABMPTIN=$TR($E(ABMREC,200,209)," ")

 S ABMDOS=$TR($E(ABMREC,230,239)," ")  ;abm*2.6*2 FIXPMS10011

 S ABMVTYP=$TR($E(ABMREC,240,289)," ")  ;abm*2.6*2 FIXPMS10026

 S ABMITYP=$TR($E(ABMREC,290,299)," ")  ;abm*2.6*2 FIXPMS10027

 I $Y>(IOSL-8) W ! K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR S ABMESC=X=U Q:ABMESC  D FNHDR(ABMFNAME,ABMRTYP)

 I ABMRECT'="T" D  Q

 .W !!,"RECORD #: ",ABMRNUM

 .W !,"RECORD TYPE: ",ABMRECT

 .W !,"INV#: ",ABMINV

 .W !,"DT/TM APPROVED: ",ABMDTTMA

 .W !,"TAX ID: ",ABMTAXID

 .W !,"DESC: ",ABMDESC

 .W !,"BILL AMT: ",ABMAMT

 .W !,"CAN: ",ABMCAN

 .W !,"HHS T-CODE: ",ABMTCODE

 .W !,"OBJECT CLASS: ",ABMCL

 .W !,"BUDGET ACTIVITY: ",ABMBUDG

 .W !,"COST CENTER: ",ABMCC

 .W !,"MASTER TIN: ",ABMPTIN

 .W !,"DATE OF SERVICE: ",ABMDOS  ;abm*2.6*2 FIXPMS10011

 .W !,"VISIT TYPE: ",ABMVTYP  ;abm*2.6*2 FIXPMS10026

 .W !,"INSURER TYPE: ",ABMITYP  ;abm*2.6*2 FIXPMS10027

 S ABMTREC=$E(ABMREC,2,11)

 S ABMTAMT=$E(ABMREC,12,31)

 I ABMTAMT[("-") D

 .S ABMTAMT="-"_$P(ABMTAMT,"-",2)

 S ABMTAMT=$E(ABMTAMT,1,$L(ABMTAMT)-2)_"."_$E(ABMTAMT,$L(ABMTAMT)-1,$L(ABMTAMT))

 W !,"RECORD TYPE: ",ABMRECT

 W !,"TOTAL RECORDS: ",ABMTREC

 W !,"TOTAL AMOUNT: ",ABMTAMT

ABMUVHF   ; IHS/SD/SDR - UFMS View Host File

 +1       ;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009

 +2       ;IHS/SD/SDR - abm*2.6*1 - Updated display for new fields.  Fixes:

 +3       ;  3PMS10019

 +4       ;  FIXPMS10001

 +5       ;  FIXPMS10011

 +6       ;  FIXPMS10026

 +7       ;  FIXPMS10027

 +8        QUIT

 +9       ;

EP        ;EP - choose file to view

 +1        NEW ABMDIR,DESTIP,ARGS,ABMUFMS

 +2        SET $PIECE(ABMDASH,"-",81)=""

 +3       ;UFMS directory

           SET ABMDIR=$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,13)

 +4        IF ABMDIR=""

               Begin DoDot:1

 +5                WRITE !!,"Before UFMS files can be created a non-public directory must be created"

 +6                WRITE !,"on the Host File System. This directory must be entered in UFMS DIRECTORY"

 +7                WRITE !,"using option SET  UFMS SETUP"

 +8                WRITE !

 +9                KILL DIR

                   SET DIR(0)="E"

                   DO ^DIR

                   KILL DIR

               End DoDot:1

               QUIT

 +10       WRITE !!,"CURRENT UFMS DIRECTORY IS ",ABMDIR

 +11       KILL DIR

 +12       SET DIR(0)="FO"

 +13       SET DIR("?",1)="Enter a file name e.g. IHS_TPB_RPMS_113510_20070806_084701.DAT,"

 +14       SET DIR("?",2)="or a partial filename IHS_TPB_RPMS*, the * is a wildcard,"

 +15       SET DIR("?")="or * to list all UFMS files in the UFMS directory."

 +16       SET DIR("A")="Enter filename "

 +17       DO ^DIR

 +18       IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)!(Y="")!(Y=" ")

               QUIT

 +19       SET ABMFILE=Y

 +20       IF $EXTRACT(ABMFILE,1,15)="IHS_AR_RPMS_REC"

               WRITE "   ??"

               HANG 1

               GOTO EP

 +21       IF ABMFILE="*"

               SET ABMFILE="IHS_TPB_RPMS_INV*"

 +22       KILL ABMARRAY

 +23       DO LIST^%ZISH(ABMDIR,ABMFILE,.ABMARRAY)

 +24       IF '$DATA(ABMARRAY)

               WRITE "    ??"

               HANG 1

               GOTO EP

 +25       WRITE @IOF

 +26       WRITE !!!,"FILES FOUND: "

 +27       SET (ABMKEY,ABMLN,ABMSEL)=""

 +28       SET ABMF=1

 +29       FOR ABMCNT=1:1

               SET ABMLN=$ORDER(ABMARRAY(ABMLN))

               IF ABMKEY!(ABMLN="")!$GET(ABMSEL)

                   QUIT

               Begin DoDot:1

 +30               WRITE !,ABMLN_"."

 +31               WRITE ?5,ABMARRAY(ABMLN)

 +32               IF '(ABMCNT#10)

                       Begin DoDot:2

 +33                       KILL DIR

 +34                       SET DIR(0)="NO^1:"_ABMCNT

 +35                       SET DIR("A")="Enter item number: "

 +36                       DO ^DIR

 +37                       SET ABMSEL=Y

 +38                       SET ABMKEY=$DATA(DUOUT)!($DATA(DTOUT))

                       End DoDot:2

               End DoDot:1

 +39       IF ABMKEY

               QUIT

 +40       IF '$GET(ABMSEL)

               IF ABMLN=""

                   Begin DoDot:1

 +41                   KILL DIR

 +42                   SET DIR(0)="NO^1:"_(ABMCNT-1)

 +43                   SET DIR("A")="Enter item number: "

 +44                   DO ^DIR

 +45                   SET ABMSEL=Y

 +46                   SET ABMKEY=$DATA(DUOUT)!($DATA(DTOUT))!(Y="")

                   End DoDot:1

                   IF ABMKEY

                       QUIT

 +47      ;

 +48       SET ABMITEM=ABMSEL

 +49      ;

ASKTYP    ;EP - ask for type of report--file layout or captioned

 +1        KILL DIR

 +2        SET DIR(0)="SO^F:FILE LAYOUT;C:CAPTIONED"

 +3        DO ^DIR

 +4        IF $DATA(DUOUT)!$DATA(DTOUT)!(Y="")

               GOTO EP

 +5        SET ABMRTYP=Y

 +6        DO FILE(ABMDIR,ABMARRAY(ABMITEM),ABMRTYP)

 +7        GOTO EP

 +8        QUIT

 +9       ;

FILE(ABMDIR,ABMFN,ABMRTYP) ;EP

 +1       ; Pull up a file into the TMP global for display

 +2        NEW Y,X,I,ABMRTNAM

 +3        SET Y=$$OPEN^%ZISH(ABMDIR,ABMFN,"R")

 +4        IF Y

               WRITE !,"CAN'T OPEN FILE"

               HANG 3

               QUIT

 +5        SET ABMRTNAM=$PIECE($TEXT(+1)," ")

 +6        KILL ^TMP(ABMRTNAM,$JOB)

 +7        FOR I=1:1

               USE IO

               READ X:1

               IF $$STATUS^%ZISH=-1

                   QUIT

               SET ^TMP(ABMRTNAM,$JOB,I,0)=X

 +8        DO ^%ZISC

 +9        IF $DATA(^TMP(ABMRTNAM,$JOB))

               DO DISPLAY(ABMFN,ABMRTYP)

 +10       KILL ^TMP(ABMRTNAM,$JOB)

 +11       QUIT

 +12      ;

DISPLAY(ABMFNAME,ABMRTYP) ;EP - display file

 +1        SET (ABMESC,ABMPG)=0

 +2        DO FNHDR(ABMFNAME,ABMRTYP)

 +3        SET ABMRNUM=0

 +4        FOR

               SET ABMRNUM=$ORDER(^TMP(ABMRTNAM,$JOB,ABMRNUM))

               IF 'ABMRNUM!(ABMESC)

                   QUIT

               Begin DoDot:1

 +5                IF $Y>(IOSL-4)

                       WRITE !

                       KILL DIR

                       SET DIR(0)="E"

                       IF '$DATA(ZTQUEUED)

                           DO ^DIR

                       SET ABMESC=X=U

                       IF ABMESC

                           QUIT

                       DO FNHDR(ABMFNAME,ABMRTYP)

 +6                SET ABMREC=$GET(^TMP(ABMRTNAM,$JOB,ABMRNUM,0))

 +7                IF ABMRTYP="C"

                       DO CAPTIONS(ABMFNAME,ABMREC,ABMRNUM)

                       QUIT

 +8                WRITE !,ABMRNUM

 +9                WRITE ?6,ABMREC

               End DoDot:1

 +10       IF ABMESC

               QUIT

 +11       IF '$DATA(ZTQUEUED)

               Begin DoDot:1

 +12               KILL DIR

 +13               SET DIR(0)="E"

 +14               DO ^DIR

               End DoDot:1

 +15       QUIT

 +16      ;

FNHDR(ABMFNAME,ABMRTYP) ;EP - header display

 +1        IF IOM=80

               DO FNHDR80

               QUIT

 +2        IF IOM=132

               DO FNHDR132

               QUIT

 +3        QUIT

FNHDR132  ;EP - 132 column header

 +1        WRITE !,"NOT YET IMPLEMENTED"

           HANG 3

 +2        QUIT

FNHDR80   ;EP - 80 column header

 +1        SET ABMPG=$GET(ABMPG)+1

 +2        WRITE @IOF

 +3        SET X="UFMS HOST FILE VIEW"

 +4        SET X=$JUSTIFY("",IOM-$LENGTH(X)\2-$X)_X

 +5        WRITE !,X

 +6        WRITE ?70,"PAGE ",ABMPG

 +7        WRITE !,$$CJ^XLFSTR("FILE: "_ABMFNAME,IOM)

 +8        IF ABMRTYP="C"

               WRITE !,$$CJ^XLFSTR("CAPTIONED LAYOUT",IOM),ABMDASH

               QUIT

 +9        WRITE !!?7,"INVOICE#"

 +10       WRITE ?27,"DT/TM APP."

 +11       WRITE ?37,"TAX ID"

 +12       WRITE ?47,"DESCRIPTION"

 +13       WRITE !?67,"BILL AMT"

 +14       WRITE !?7,"CAN"

 +15       WRITE ?17,"HHS T-CD"

 +16       WRITE ?27,"OBJCL"

 +17       WRITE ?32,"BUDG. ACT"

 +18       WRITE ?42,"CC"

 +19       WRITE ?45,"MASTER TIN"

 +20      ;abm*2.6*2 FIXPMS10011

           WRITE ?75,"DOS"

 +21      ;abm*2.6*2 FIXPMS10026

           WRITE !?5,"VISIT TYPE"

 +22      ;abm*2.6*2 FIXPMS10027

           WRITE ?55,"INSURER TYPE"

 +23       WRITE !,ABMDASH

 +24       QUIT

 +25      ;

CAPTIONS(ABMFNAME,ABMREC,ABMRNUM) ;EP - captioned records

 +1        SET ABMRECT=$TRANSLATE($EXTRACT(ABMREC,1,1)," ")

 +2       ;start old code abm*2.6*2 NO HEAT

 +3       ;S ABMINV=$TR($E(ABMREC,2,21)," ")

 +4       ;S ABMDTTMA=$TR($E(ABMREC,22,31)," ")

 +5       ;S ABMTAXID=$TR($E(ABMREC,32,41)," ")

 +6       ;S ABMDESC=$TR($E(ABMREC,42,141)," ")

 +7       ;S ABMAMT=+$TR($E(ABMREC,142,161)," ")

 +8       ;S ABMAMT=$E(ABMAMT,1,$L(ABMAMT)-2)_"."_$E(ABMAMT,$L(ABMAMT)-1,$L(ABMAMT))

 +9       ;S ABMAMT=$E(ABMAMT,1,$L(ABMAMT)-2)_"."_$E(ABMAMT,$L(ABMAMT)-1,$L(ABMAMT))

 +10      ;S ABMCAN=$TR($E(ABMREC,162,171)," ")

 +11      ;S ABMTCODE=$TR($E(ABMREC,172,181)," ")

 +12      ;S ABMCL=$TR($E(ABMREC,182,186)," ")

 +13      ;S ABMCC=$TR($E(ABMREC,197,199)," ")

 +14      ;end old code start new code NO HEAT

 +15       SET ABMINV=$TRANSLATE($EXTRACT(ABMREC,2,41)," ")

 +16       SET ABMDTTMA=$TRANSLATE($EXTRACT(ABMREC,42,51)," ")

 +17       SET ABMTAXID=$TRANSLATE($EXTRACT(ABMREC,52,61)," ")

 +18       SET ABMDESC=$TRANSLATE($EXTRACT(ABMREC,62,161)," ")

 +19       SET ABMAMT=+$TRANSLATE($EXTRACT(ABMREC,162,181)," ")

 +20       SET ABMAMT=$EXTRACT(ABMAMT,1,$LENGTH(ABMAMT)-2)_"."_$EXTRACT(ABMAMT,$LENGTH(ABMAMT)-1,$LENGTH(ABMAMT))

 +21       SET ABMCAN=$TRANSLATE($EXTRACT(ABMREC,192,201)," ")

 +22       SET ABMTCODE=$TRANSLATE($EXTRACT(ABMREC,202,206)," ")

 +23       SET ABMCL=$TRANSLATE($EXTRACT(ABMREC,182,186)," ")

 +24       SET ABMCC=$TRANSLATE($EXTRACT(ABMREC,207,209)," ")

 +25      ;end new code NO HEAT

 +26       SET ABMBUDG=$TRANSLATE($EXTRACT(ABMREC,187,196)," ")

 +27       SET ABMCC=$TRANSLATE($EXTRACT(ABMREC,197,199)," ")

 +28       SET ABMPTIN=$TRANSLATE($EXTRACT(ABMREC,200,209)," ")

 +29      ;abm*2.6*2 FIXPMS10011

           SET ABMDOS=$TRANSLATE($EXTRACT(ABMREC,230,239)," ")

 +30      ;abm*2.6*2 FIXPMS10026

           SET ABMVTYP=$TRANSLATE($EXTRACT(ABMREC,240,289)," ")

 +31      ;abm*2.6*2 FIXPMS10027

           SET ABMITYP=$TRANSLATE($EXTRACT(ABMREC,290,299)," ")

 +32      ;

 +33       IF $Y>(IOSL-8)

               WRITE !

               KILL DIR

               SET DIR(0)="E"

               IF '$DATA(ZTQUEUED)

                   DO ^DIR

               SET ABMESC=X=U

               IF ABMESC

                   QUIT

               DO FNHDR(ABMFNAME,ABMRTYP)

 +34       IF ABMRECT'="T"

               Begin DoDot:1

 +35               WRITE !!,"RECORD #: ",ABMRNUM

 +36               WRITE !,"RECORD TYPE: ",ABMRECT

 +37               WRITE !,"INV#: ",ABMINV

 +38               WRITE !,"DT/TM APPROVED: ",ABMDTTMA

 +39               WRITE !,"TAX ID: ",ABMTAXID

 +40               WRITE !,"DESC: ",ABMDESC

 +41               WRITE !,"BILL AMT: ",ABMAMT

 +42               WRITE !,"CAN: ",ABMCAN

 +43               WRITE !,"HHS T-CODE: ",ABMTCODE

 +44               WRITE !,"OBJECT CLASS: ",ABMCL

 +45               WRITE !,"BUDGET ACTIVITY: ",ABMBUDG

 +46               WRITE !,"COST CENTER: ",ABMCC

 +47               WRITE !,"MASTER TIN: ",ABMPTIN

 +48      ;abm*2.6*2 FIXPMS10011

                   WRITE !,"DATE OF SERVICE: ",ABMDOS

 +49      ;abm*2.6*2 FIXPMS10026

                   WRITE !,"VISIT TYPE: ",ABMVTYP

 +50      ;abm*2.6*2 FIXPMS10027

                   WRITE !,"INSURER TYPE: ",ABMITYP

               End DoDot:1

               QUIT

 +51       SET ABMTREC=$EXTRACT(ABMREC,2,11)

 +52       SET ABMTAMT=$EXTRACT(ABMREC,12,31)

 +53       IF ABMTAMT[("-")

               Begin DoDot:1

 +54               SET ABMTAMT="-"_$PIECE(ABMTAMT,"-",2)

               End DoDot:1

 +55       SET ABMTAMT=$EXTRACT(ABMTAMT,1,$LENGTH(ABMTAMT)-2)_"."_$EXTRACT(ABMTAMT,$LENGTH(ABMTAMT)-1,$LENGTH(ABMTAMT))

 +56       WRITE !,"RECORD TYPE: ",ABMRECT

 +57       WRITE !,"TOTAL RECORDS: ",ABMTREC

 +58       WRITE !,"TOTAL AMOUNT: ",ABMTAMT

 +59       QUIT

ABMUVHF.m