BARUFVF ; IHS/SD/TPF - UFMS VIEW UFMS FILE REPORT ; 10/20/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,8,23**;OCT 26, 2005
Q
;
ASKFILE ;EP - CHOOSE UFMS FILE TO VIEW
N DIREC,DESTIP,ARGS,BARUFMS
S $P(DASH,"-",81)=""
S DIREC=$P($G(^BAR(90052.06,DUZ(2),DUZ(2),15)),U) ;A/R PARAMETER FILE, UFMS DIRECTORY
I DIREC="" 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 to A/R Site Parameter"
.W !,"field UFMS DIRECTORY using the 'SPE Site Parameter Edit' option"
.D ASKFORRT^BARUFUT
W !!,"CURRENT UFMS DIRECTORY IS ",DIREC
K DIR
S DIR(0)="FO"
S DIR("?",1)="Enter a file name e.g. IHS_AR_RPMS_RCV_398_113510_20070806_0847.DAT,"
S DIR("?",2)="or a partial filename IHS_AR_RPMS_RCV_398*, 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 FILENM=Y
I $E(FILENM,1,16)="IHS_TPB_RPMS_INV" W " ??" H 1 G ASKFILE
I $E(FILENM)="*" S FILENM="*"
I FILENM="*" S FILENM="IHS_AR_RPMS_RCV*"
K FARRAY
D LIST^%ZISH(DIREC,FILENM,.FARRAY)
I '$D(FARRAY) W " ??" H 1 G ASKFILE
W @IOF
W !!!,"FILES FOUND: "
S (KEY,LN,CHOICE)=""
S FIRST=1
F CNT=1:1 S LN=$O(FARRAY(LN)) Q:KEY!(LN="")!$G(CHOICE) D
.W !,LN_"."
.W ?5,FARRAY(LN)
.I '(CNT#10) D
..K DIR
..S DIR(0)="NO^1:"_CNT
..S DIR("A")="Enter item number: "
..D ^DIR
..;I Y="" S FIRST=CNT+1 Q
..S CHOICE=Y
..S KEY=$D(DUOUT)!($D(DTOUT))
Q:KEY
I '$G(CHOICE),LN="" D Q:KEY
.K DIR
.S DIR(0)="NO^1:"_(CNT-1)
.S DIR("A")="Enter item number: "
.D ^DIR
.S CHOICE=Y
.S KEY=$D(DUOUT)!($D(DTOUT))!(Y="")
;
S ITEM=CHOICE
;
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="") ASKFILE
S RPTTYP=Y
;NEW BAR*1.8*4 SCR56,SCR58 ADD SEARCH FOR DEBUGGING
S TARSTRG=$$ASKTAR()
;END
;D FILE(DIREC,FARRAY(ITEM),RPTTYP)
D FILE(DIREC,FARRAY(ITEM),RPTTYP,TARSTRG) ;BAR*1.8*4 SCR56,SCR58
G ASKFILE
Q
;
;NEW BAR*1.8*4
ASKTAR() ;EP - ASK IF A SEARCH IS NEEDED
W !
K DIR
S DIR(0)="Y"
S DIR("A")="WOULD YOU LIKE TO SEARCH FOR A STRING?"
S DIR("B")="N"
D ^DIR
Q:$D(DUOUT)!$D(DTOUT)!('Y) ""
W !
K DIR
S DIR(0)="FO"
S DIR("A")="ENTER TARGET STRING"
D ^DIR
Q:$D(DUOUT)!$D(DTOUT)!(Y="") ""
Q Y
;
;FILE(BARDIR,BARFN,RPTTYP) ; EP
FILE(BARDIR,BARFN,RPTTYP,TARSTRG) ;EP - DISPLAY FILE ;BAR*1.8*4 SCR56,SCR58
; Pull up a file into the TMP global for display
N Y,X,I,BARRNAM
S Y=$$OPEN^%ZISH(BARDIR,BARFN,"R")
I Y W !,"CAN'T OPEN FILE" H 3 Q
S BARRNAM=$P($T(+1)," ")
K ^TMP(BARRNAM,$J)
;F I=1:1 U IO R X:1 Q:$$STATUS^%ZISH=-1 S ^TMP(BARRNAM,$J,I,0)=X
F I=1:1 U IO R X:1 Q:$$STATUS^%ZISH=-1 D ;DIRECT READ OF FLAT FILE
.Q:TARSTRG'=""&(X'[(TARSTRG)) ;SCREEN FOR SEARCH STRING ONLY
.S ^TMP(BARRNAM,$J,I,0)=X
D ^%ZISC
I $D(^TMP(BARRNAM,$J)) D DISPLAY(BARFN,RPTTYP)
K ^TMP(BARRNAM,$J)
Q
;
DISPLAY(FILENAME,RPTTYP) ;EP - DISPLAY UFMS FILE
S (ESC,PAGE)=0
D FNHDR(FILENAME,RPTTYP)
S RECNUM=0
F S RECNUM=$O(^TMP(BARRNAM,$J,RECNUM)) Q:'RECNUM!(ESC) D
.I $Y>(IOSL-4) W ! K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR S ESC=X=U Q:ESC D FNHDR(FILENAME,RPTTYP)
.S RECORD=$G(^TMP(BARRNAM,$J,RECNUM,0))
.I RPTTYP="C" D CAPTIONS(FILENAME,RECORD,RECNUM) Q
.W !,RECNUM
.W ?6,RECORD
Q:ESC
I '$D(ZTQUEUED) D
.K DIR
.S DIR(0)="E"
.D ^DIR
Q
;
FNHDR(FILENAME,RPTTYP) ;EP - DISPLAY DISPLAY HEADER
I IOM=80 D FNHDR80 Q
I IOM=132 D FNHDR132 Q
Q
FNHDR132 ;EP - HEADER FOR 132 COL
W !,"NOT YET IMPLEMENTED" H 3
Q
FNHDR80 ;EP - HEADER FOR 80 COL
S PAGE=$G(PAGE)+1
W @IOF
S X="UFMS FILE VIEW"
S X=$J("",IOM-$L(X)\2-$X)_X
W !,X
W ?70,"PAGE ",PAGE
W !,$$CJ^XLFSTR("FILE: "_FILENAME,IOM)
I RPTTYP="C" W !,$$CJ^XLFSTR("CAPTIONED LAYOUT",IOM),DASH Q
W !!,"REC"
W ?5,"RECORD"
W ?35,"BATCH"
W ?72,"TR DATE"
;SECOND LINE
W !,"#"
W ?5,"TYPE"
W ?16,"AMOUNT"
W ?35,"APPLY TO"
W ?50,"SCHED #"
W !,DASH
Q
;
CAPTIONS(FILENAME,RECORD,RECNUM) ;EP - DO A CAPTION OUTPUT OF THE FILE RECORD
S RECTYP=$TR($E(RECORD,1,1)," ")
S BATCH=$$LEADSP($E(RECORD,2,150))
S TRDATE=$TR($E(RECORD,151,160)," ")
S AMTSIGN=$TR($E(RECORD,161,161)," ")
S AMOUNT=+$TR($E(RECORD,162,181)," ")
S AMOUNT=$E(AMOUNT,1,$L(AMOUNT)-2)_"."_$E(AMOUNT,$L(AMOUNT)-1,$L(AMOUNT))
;Begin changes to length of invoice number;MRS:BAR*1.8*8 HEAT529
S APPLYTO=$TR($E(RECORD,182,221)," ")
S SCHEDNUM=$TR($E(RECORD,222,241)," ")
S UNIQUEID=$TR($E(RECORD,242,391)," ")
N BARP1,BARP2
S BARP1=$P(FILENAME,"_",9) ;PATCH FIELD
S BARP2=$TR($P(BARP1,".",1,3),".")
I BARP2<10808 D
.S APPLYTO=$TR($E(RECORD,182,201)," ")
.S SCHEDNUM=$TR($E(RECORD,202,221)," ")
.S UNIQUEID=$TR($E(RECORD,301,336)," ")
;End changes;MRS:BAR*1.8*8 HEAT529
;
I $Y>(IOSL-8) W ! K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR S ESC=X=U Q:ESC D FNHDR(FILENAME,RPTTYP)
I RECTYP'="T" D Q
.W !!,"RECORD #: ",RECNUM
.W !,"RECORD TYPE: ",RECTYP
.W !,"BATCH: ",BATCH
.W !,"TRANSACTION DATE: ",TRDATE
.W !,"AMOUNT SIGN: ",AMTSIGN
.W !,"AMOUNT: ",AMOUNT
.W !,"APPLY TO: ",APPLYTO
.W !,"SCHEDULE #: ",SCHEDNUM
.W !,"UNIQUE ID: ",UNIQUEID ;BAR*1.8*4 ITEM 3 SCR58
S TOTREC=$E(RECORD,2,11)
S TOTAMT=$E(RECORD,12,31)
I TOTAMT[("-") D
.S TOTAMT="-"_$P(TOTAMT,"-",2)
S TOTAMT=$E(TOTAMT,1,$L(TOTAMT)-2)_"."_$E(TOTAMT,$L(TOTAMT)-1,$L(TOTAMT))
W !,"RECORD TYPE: ",RECTYP
W !,"TOTAL RECORDS: ",+TOTREC
W !,"TOTAL AMOUNT: ",TOTAMT
Q
;
LEADSP(STR) ;EP - STRIP LEADING SPACES
N CHAR,TARGET
Q:$E(STR)'=" " STR
F CHAR=1:1:$L(STR) Q:$E(STR,CHAR,CHAR)'=" "
S STR=$E(STR,CHAR,$L(STR))
Q STR
BARUFVF ; IHS/SD/TPF - UFMS VIEW UFMS FILE REPORT ; 10/20/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,8,23**;OCT 26, 2005
+2 QUIT
+3 ;
ASKFILE ;EP - CHOOSE UFMS FILE TO VIEW
+1 NEW DIREC,DESTIP,ARGS,BARUFMS
+2 SET $PIECE(DASH,"-",81)=""
+3 ;A/R PARAMETER FILE, UFMS DIRECTORY
SET DIREC=$PIECE($GET(^BAR(90052.06,DUZ(2),DUZ(2),15)),U)
+4 IF DIREC=""
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 to A/R Site Parameter"
+7 WRITE !,"field UFMS DIRECTORY using the 'SPE Site Parameter Edit' option"
+8 DO ASKFORRT^BARUFUT
End DoDot:1
QUIT
+9 WRITE !!,"CURRENT UFMS DIRECTORY IS ",DIREC
+10 KILL DIR
+11 SET DIR(0)="FO"
+12 SET DIR("?",1)="Enter a file name e.g. IHS_AR_RPMS_RCV_398_113510_20070806_0847.DAT,"
+13 SET DIR("?",2)="or a partial filename IHS_AR_RPMS_RCV_398*, the * is a wildcard,"
+14 SET DIR("?")="or * to list all UFMS files in the UFMS directory."
+15 SET DIR("A")="Enter filename "
+16 DO ^DIR
+17 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)!(Y="")!(Y=" ")
QUIT
+18 SET FILENM=Y
+19 IF $EXTRACT(FILENM,1,16)="IHS_TPB_RPMS_INV"
WRITE " ??"
HANG 1
GOTO ASKFILE
+20 IF $EXTRACT(FILENM)="*"
SET FILENM="*"
+21 IF FILENM="*"
SET FILENM="IHS_AR_RPMS_RCV*"
+22 KILL FARRAY
+23 DO LIST^%ZISH(DIREC,FILENM,.FARRAY)
+24 IF '$DATA(FARRAY)
WRITE " ??"
HANG 1
GOTO ASKFILE
+25 WRITE @IOF
+26 WRITE !!!,"FILES FOUND: "
+27 SET (KEY,LN,CHOICE)=""
+28 SET FIRST=1
+29 FOR CNT=1:1
SET LN=$ORDER(FARRAY(LN))
IF KEY!(LN="")!$GET(CHOICE)
QUIT
Begin DoDot:1
+30 WRITE !,LN_"."
+31 WRITE ?5,FARRAY(LN)
+32 IF '(CNT#10)
Begin DoDot:2
+33 KILL DIR
+34 SET DIR(0)="NO^1:"_CNT
+35 SET DIR("A")="Enter item number: "
+36 DO ^DIR
+37 ;I Y="" S FIRST=CNT+1 Q
+38 SET CHOICE=Y
+39 SET KEY=$DATA(DUOUT)!($DATA(DTOUT))
End DoDot:2
End DoDot:1
+40 IF KEY
QUIT
+41 IF '$GET(CHOICE)
IF LN=""
Begin DoDot:1
+42 KILL DIR
+43 SET DIR(0)="NO^1:"_(CNT-1)
+44 SET DIR("A")="Enter item number: "
+45 DO ^DIR
+46 SET CHOICE=Y
+47 SET KEY=$DATA(DUOUT)!($DATA(DTOUT))!(Y="")
End DoDot:1
IF KEY
QUIT
+48 ;
+49 SET ITEM=CHOICE
+50 ;
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 ASKFILE
+5 SET RPTTYP=Y
+6 ;NEW BAR*1.8*4 SCR56,SCR58 ADD SEARCH FOR DEBUGGING
+7 SET TARSTRG=$$ASKTAR()
+8 ;END
+9 ;D FILE(DIREC,FARRAY(ITEM),RPTTYP)
+10 ;BAR*1.8*4 SCR56,SCR58
DO FILE(DIREC,FARRAY(ITEM),RPTTYP,TARSTRG)
+11 GOTO ASKFILE
+12 QUIT
+13 ;
+14 ;NEW BAR*1.8*4
ASKTAR() ;EP - ASK IF A SEARCH IS NEEDED
+1 WRITE !
+2 KILL DIR
+3 SET DIR(0)="Y"
+4 SET DIR("A")="WOULD YOU LIKE TO SEARCH FOR A STRING?"
+5 SET DIR("B")="N"
+6 DO ^DIR
+7 IF $DATA(DUOUT)!$DATA(DTOUT)!('Y)
QUIT ""
+8 WRITE !
+9 KILL DIR
+10 SET DIR(0)="FO"
+11 SET DIR("A")="ENTER TARGET STRING"
+12 DO ^DIR
+13 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y="")
QUIT ""
+14 QUIT Y
+15 ;
+16 ;FILE(BARDIR,BARFN,RPTTYP) ; EP
FILE(BARDIR,BARFN,RPTTYP,TARSTRG) ;EP - DISPLAY FILE ;BAR*1.8*4 SCR56,SCR58
+1 ; Pull up a file into the TMP global for display
+2 NEW Y,X,I,BARRNAM
+3 SET Y=$$OPEN^%ZISH(BARDIR,BARFN,"R")
+4 IF Y
WRITE !,"CAN'T OPEN FILE"
HANG 3
QUIT
+5 SET BARRNAM=$PIECE($TEXT(+1)," ")
+6 KILL ^TMP(BARRNAM,$JOB)
+7 ;F I=1:1 U IO R X:1 Q:$$STATUS^%ZISH=-1 S ^TMP(BARRNAM,$J,I,0)=X
+8 ;DIRECT READ OF FLAT FILE
FOR I=1:1
USE IO
READ X:1
IF $$STATUS^%ZISH=-1
QUIT
Begin DoDot:1
+9 ;SCREEN FOR SEARCH STRING ONLY
IF TARSTRG'=""&(X'[(TARSTRG))
QUIT
+10 SET ^TMP(BARRNAM,$JOB,I,0)=X
End DoDot:1
+11 DO ^%ZISC
+12 IF $DATA(^TMP(BARRNAM,$JOB))
DO DISPLAY(BARFN,RPTTYP)
+13 KILL ^TMP(BARRNAM,$JOB)
+14 QUIT
+15 ;
DISPLAY(FILENAME,RPTTYP) ;EP - DISPLAY UFMS FILE
+1 SET (ESC,PAGE)=0
+2 DO FNHDR(FILENAME,RPTTYP)
+3 SET RECNUM=0
+4 FOR
SET RECNUM=$ORDER(^TMP(BARRNAM,$JOB,RECNUM))
IF 'RECNUM!(ESC)
QUIT
Begin DoDot:1
+5 IF $Y>(IOSL-4)
WRITE !
KILL DIR
SET DIR(0)="E"
IF '$DATA(ZTQUEUED)
DO ^DIR
SET ESC=X=U
IF ESC
QUIT
DO FNHDR(FILENAME,RPTTYP)
+6 SET RECORD=$GET(^TMP(BARRNAM,$JOB,RECNUM,0))
+7 IF RPTTYP="C"
DO CAPTIONS(FILENAME,RECORD,RECNUM)
QUIT
+8 WRITE !,RECNUM
+9 WRITE ?6,RECORD
End DoDot:1
+10 IF ESC
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(FILENAME,RPTTYP) ;EP - DISPLAY DISPLAY HEADER
+1 IF IOM=80
DO FNHDR80
QUIT
+2 IF IOM=132
DO FNHDR132
QUIT
+3 QUIT
FNHDR132 ;EP - HEADER FOR 132 COL
+1 WRITE !,"NOT YET IMPLEMENTED"
HANG 3
+2 QUIT
FNHDR80 ;EP - HEADER FOR 80 COL
+1 SET PAGE=$GET(PAGE)+1
+2 WRITE @IOF
+3 SET X="UFMS FILE VIEW"
+4 SET X=$JUSTIFY("",IOM-$LENGTH(X)\2-$X)_X
+5 WRITE !,X
+6 WRITE ?70,"PAGE ",PAGE
+7 WRITE !,$$CJ^XLFSTR("FILE: "_FILENAME,IOM)
+8 IF RPTTYP="C"
WRITE !,$$CJ^XLFSTR("CAPTIONED LAYOUT",IOM),DASH
QUIT
+9 WRITE !!,"REC"
+10 WRITE ?5,"RECORD"
+11 WRITE ?35,"BATCH"
+12 WRITE ?72,"TR DATE"
+13 ;SECOND LINE
+14 WRITE !,"#"
+15 WRITE ?5,"TYPE"
+16 WRITE ?16,"AMOUNT"
+17 WRITE ?35,"APPLY TO"
+18 WRITE ?50,"SCHED #"
+19 WRITE !,DASH
+20 QUIT
+21 ;
CAPTIONS(FILENAME,RECORD,RECNUM) ;EP - DO A CAPTION OUTPUT OF THE FILE RECORD
+1 SET RECTYP=$TRANSLATE($EXTRACT(RECORD,1,1)," ")
+2 SET BATCH=$$LEADSP($EXTRACT(RECORD,2,150))
+3 SET TRDATE=$TRANSLATE($EXTRACT(RECORD,151,160)," ")
+4 SET AMTSIGN=$TRANSLATE($EXTRACT(RECORD,161,161)," ")
+5 SET AMOUNT=+$TRANSLATE($EXTRACT(RECORD,162,181)," ")
+6 SET AMOUNT=$EXTRACT(AMOUNT,1,$LENGTH(AMOUNT)-2)_"."_$EXTRACT(AMOUNT,$LENGTH(AMOUNT)-1,$LENGTH(AMOUNT))
+7 ;Begin changes to length of invoice number;MRS:BAR*1.8*8 HEAT529
+8 SET APPLYTO=$TRANSLATE($EXTRACT(RECORD,182,221)," ")
+9 SET SCHEDNUM=$TRANSLATE($EXTRACT(RECORD,222,241)," ")
+10 SET UNIQUEID=$TRANSLATE($EXTRACT(RECORD,242,391)," ")
+11 NEW BARP1,BARP2
+12 ;PATCH FIELD
SET BARP1=$PIECE(FILENAME,"_",9)
+13 SET BARP2=$TRANSLATE($PIECE(BARP1,".",1,3),".")
+14 IF BARP2<10808
Begin DoDot:1
+15 SET APPLYTO=$TRANSLATE($EXTRACT(RECORD,182,201)," ")
+16 SET SCHEDNUM=$TRANSLATE($EXTRACT(RECORD,202,221)," ")
+17 SET UNIQUEID=$TRANSLATE($EXTRACT(RECORD,301,336)," ")
End DoDot:1
+18 ;End changes;MRS:BAR*1.8*8 HEAT529
+19 ;
+20 IF $Y>(IOSL-8)
WRITE !
KILL DIR
SET DIR(0)="E"
IF '$DATA(ZTQUEUED)
DO ^DIR
SET ESC=X=U
IF ESC
QUIT
DO FNHDR(FILENAME,RPTTYP)
+21 IF RECTYP'="T"
Begin DoDot:1
+22 WRITE !!,"RECORD #: ",RECNUM
+23 WRITE !,"RECORD TYPE: ",RECTYP
+24 WRITE !,"BATCH: ",BATCH
+25 WRITE !,"TRANSACTION DATE: ",TRDATE
+26 WRITE !,"AMOUNT SIGN: ",AMTSIGN
+27 WRITE !,"AMOUNT: ",AMOUNT
+28 WRITE !,"APPLY TO: ",APPLYTO
+29 WRITE !,"SCHEDULE #: ",SCHEDNUM
+30 ;BAR*1.8*4 ITEM 3 SCR58
WRITE !,"UNIQUE ID: ",UNIQUEID
End DoDot:1
QUIT
+31 SET TOTREC=$EXTRACT(RECORD,2,11)
+32 SET TOTAMT=$EXTRACT(RECORD,12,31)
+33 IF TOTAMT[("-")
Begin DoDot:1
+34 SET TOTAMT="-"_$PIECE(TOTAMT,"-",2)
End DoDot:1
+35 SET TOTAMT=$EXTRACT(TOTAMT,1,$LENGTH(TOTAMT)-2)_"."_$EXTRACT(TOTAMT,$LENGTH(TOTAMT)-1,$LENGTH(TOTAMT))
+36 WRITE !,"RECORD TYPE: ",RECTYP
+37 WRITE !,"TOTAL RECORDS: ",+TOTREC
+38 WRITE !,"TOTAL AMOUNT: ",TOTAMT
+39 QUIT
+40 ;
LEADSP(STR) ;EP - STRIP LEADING SPACES
+1 NEW CHAR,TARGET
+2 IF $EXTRACT(STR)'=" "
QUIT STR
+3 FOR CHAR=1:1:$LENGTH(STR)
IF $EXTRACT(STR,CHAR,CHAR)'=" "
QUIT
+4 SET STR=$EXTRACT(STR,CHAR,$LENGTH(STR))
+5 QUIT STR
