- BARUFEX ; IHS/SD/TPF - MAIN EXTRACT RTN FOR UFMS ; 09/19/2008
- ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,6,7**;OCT 26, 2005
- ;Heavily modified to prevent duplicate records ;MRS:BAR*1.8*7 IM30562
- ;GETDATA MOVED TO NEW ROUTINE BARUFEX1 created to meet SAC size requirements ;MRS:BAR*1.8*7
- ;New functionality only enters through single PULLSESS EP ;MRS:BAR*1.8*7 IM30562
- Q
- ;
- PULLSESS(UDUZ,SESSID) ;EP - PULL TRANSACTIONS LOGGED UNDER THIS SESSION
- N TRDATE,TRAILER,NOTSENT,BAROLD,BARNOW
- K ^BARUFEX($J)
- S RC=$$ASKFNAME^BARUFUT1(.BARFILE)
- I 'RC W !!,"SESSION NOT TRANSMITTED" D ASKFORRT^BARUFUT Q 0
- S (RECORD,TOTAMT)=0
- I $D(SESSID)'=1 D Q $D(^BARUFEX($J))_U_BARFILE
- .S BAROLD=$$OLD(.SESSID) ;CAPTURE OLDEST DATE BAR*1.8*4
- .S REC=""
- .F S REC=$O(SESSID(REC)) Q:REC="" D
- ..S UDUZ=$P(SESSID(REC),U)
- ..S SESSID=$P(SESSID(REC),U,2)
- ..I '$$LCK(UDUZ,SESSID) Q ;MRS:BAR*1.8*7 IM30562
- ..I SESSID<BAROLD S BAROLD=SESSID ;CAPTURE OLDEST DATE
- ..D DT(UDUZ,SESSID,BAROLD)
- .S:$D(^BARUFEX($J)) TRAILER=$$TRAILER()
- E D Q $D(^BARUFEX($J))_U_BARFILE
- .I '$$LCK(UDUZ,SESSID) Q ;MRS:BAR*1.8*7 IM30562
- .D DT(UDUZ,SESSID,SESSID)
- .S:$D(^BARUFEX($J)) TRAILER=$$TRAILER()
- Q $D(^BARUFEX($J))_U_BARFILE
- ;
- DT(UDUZ,SESSID,BAROLD) ;EP - HEAVILY MODIFIED FOR BAR*1.8*4 SCR80 1.4.1
- ;CHECK FOR TRANSACTIONS NOT SENT
- ;D NOTSENT(.RECORD,.TOTAMT) ;ONLY CHECK ONCE
- S CURSTAT=$$CURSTAT^BARUFUT(UDUZ,SESSID) ;MRS:BAR*1.8*6 IM29616
- Q:CURSTAT'="REVIEWED/APPROVED" ;MRS:BAR*1.8*6 IM29616
- D NOW^%DTC
- S BARNOW=%
- S BARB=$P(SESSID,".")-.0001
- S BARDUZ=DUZ ;CASHIER
- I '$G(NOTSENT) D
- .D PRE^BARUFEX5(BAROLD,BARDUZ) ;CREATE ^BARBOB GLOBAL ONCE
- .D NOTSENT(.RECORD,.TOTAMT) S NOTSENT=1 ;ONLY CHECK ONCE
- .W !,"FINISHED CHECKING 'NOT SENT' TRANSACTIONS"
- W !!,"PROCESSING SESSION TRANSACTIONS FOR "_$P(^VA(200,UDUZ,0),U)_": "_SESSID
- S TRDATE=0
- F S TRDATE=$O(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE)) Q:'TRDATE D
- .D GETDATA^BARUFEX1(TRDATE,.RECORD,.TOTAMT,UDUZ,SESSID)
- Q
- ;
- TRAILER() ;EP -
- ;DO THE TRAILER
- S RECTYPE="T"
- S RECORDS=$$FILLSTR^BARUFUT1(RECORD,10,"R","0")
- S TOTAMT=$$FILLSTR^BARUFUT1(TOTAMT,20,"R","0")
- S ^BARUFEX($J,RECORD)=RECTYPE_RECORDS_TOTAMT
- D SENDFILE^BARUFUT2("BARUFEX(",BARFILE)
- ;
- ;SET TRANSMISSION DATE/TIME MULTIPLE
- ;S RC=$$SETTRANS^BARUFUT(UDUZ,SESSID,BARFILE,CURSTAT)
- Q 1_U_BARFILE
- ;
- NOTSENT(RECORD,TOTAMT) ;EP - CHECK THE NOT SENT CROSS REFERENCE
- N TRDATE,SESSID,UDUZ
- W !!,"CHECKING PREVIOUSLY 'NOT SENT' TRANSACTIONS"
- S TRDATE=""
- F S TRDATE=$O(^BARSESS(DUZ(2),"NS",TRDATE)) Q:TRDATE="" D
- .S SESSID=$O(^BARSESS(DUZ(2),"NS",TRDATE,""))
- .S UDUZ=$O(^BARSESS(DUZ(2),"NS",TRDATE,SESSID,""))
- .;D GETDATA(TRDATE,.RECORD,.TOTAMT)
- .D GETDATA^BARUFEX1(TRDATE,.RECORD,.TOTAMT,UDUZ,SESSID)
- Q
- ;
- OLD(SESSID) ;FIND OLDEST SESSION DATE BAR*1.8*4 DD 4.1.1
- N DATE,OLD,REC
- S OLD=$G(SESSID)
- S REC=""
- F S REC=$O(SESSID(REC)) Q:REC="" D
- .S DATE=$P(SESSID(REC),U,2)
- .I OLD="" S OLD=DATE
- .I OLD>DATE S OLD=DATE ;CAPTURE OLDEST DATE
- Q OLD-2 ;MAKE A LITTLE OLDER
- ;
- LCK(UDUZ,SESSID) ;EP; LOCK A/R SESSION FILE ;MRS:BAR*1.8*7 IM30562
- ;
- N X
- F I=1:1:5 LOCK +^BARSESS(DUZ(2),UDUZ,11,SESSID):2 S X=$T Q:X
- I 'X D Q X
- .W *7,!!,"A/R UFMS CASHIER SESSION FILE IS LOCKED for SESSION "_SESSID
- .W !," SOMEONE ELSE MAY BE EXPORTING, TRY THIS SESSION AGAIN LATER "
- .H 3
- Q X
- ;
- ;OLD SUBROUTINES DISABLED AND MOVED TO BOTTOM OF ROUTINE;MRS:BAR*1.8*7 IM30562
- ASKDATE ;EP - ASK DATE RANGE
- ASKFROM ;EP - ASK FROM DATE
- Q ;DISABLED MRS:BAR*1.8*7 IM30562
- K %DT
- S %DT="AET"
- S %DT("A")="Enter beginning transaction date: "
- D ^%DT
- Q:X=""!(X[U)
- I Y<0 W !,"INVALID DATE. TRY AGAIN!" H 2 G ASKFROM
- S BARFROM=Y
- ASKTO ;EP - ASK TO DATE
- Q ;DISABLED MRS:BAR*1.8*7 IM30562
- K %DT
- S %DT="AET"
- S %DT("A")="Enter ending transaction date: "
- D ^%DT
- G:X=""!(X[U) ASKFROM
- I Y<0 W !,"INVALID DATE. TRY AGAIN!" H 2 G ASKTO
- S BARTO=Y
- I BARTO<BARFROM W !!,"END DATE MUST BE GREATER THAN BEGINING DATE" H 2 G ASKFROM
- ASKFILE ;EP - ASK FILENAME
- Q ;DISABLED MRS:BAR*1.8*7 IM30562
- S RC=$$ASKFNAME^BARUFUT1(.BARFILE)
- I 'RC W !!,"FILE NOT TRANSMITTED" D ASKFORRT^BARUFUT Q
- D EN(BARFROM,BARTO)
- I '$D(^BARUFEX($J)) D
- .W !,"THERE WERE NO TRANSACTIONS FOUND ELIGIBLE FOR TRANSMISSION!"
- .D ASKFORRT^BARUFUT
- D SENDFILE^BARUFUT2("BARUFEX(",BARFILE)
- Q
- ONETRAN(TRDATE,SESSID) ;EP - CREATE FILE FOR ONE/MANY A/R TRANSACTION
- Q ;DISABLED;MRS:BAR*1.8*7 IM30562
- N REC
- K ^BARUFEX($J)
- S ARFROM=TRDATE-.01
- S ARFROM=ARFROM-.00001
- D PRE^BARUFEX5(ARFROM,DUZ) ;CREATE ^BARBOB GLOBAL
- S RC=$$ASKFNAME^BARUFUT1(.BARFILE)
- I 'RC W !!,"TRANSACTIONS NOT TRANSMITTED" D ASKFORRT^BARUFUT Q
- S (RECORD,TOTAMT)=0
- ;
- S REC=""
- F S REC=$O(TRDATE(REC)) Q:REC="" D
- .S TRDATE=TRDATE(REC)
- .;D GETDATA(TRDATE,.RECORD,.TOTAMT)
- .D GETDATA^BARUFEX1(TRDATE,.RECORD,.TOTAMT,UDUZ,SESSID)
- I '$D(^BARUFEX($J)) D Q
- .W !,"THERE WERE NO TRANSACTIONS FOUND ELIGIBLE FOR TRANSMISSION!"
- .D ASKFORRT^BARUFUT
- ;DO THE TRAILER
- S RECTYPE="T"
- S RECORDS=$$FILLSTR^BARUFUT1(RECORD,10,"R","0")
- S TOTAMT=$$FILLSTR^BARUFUT1(TOTAMT,20,"R","0")
- S ^BARUFEX($J,RECORD)=RECTYPE_RECORDS_TOTAMT
- D SENDFILE^BARUFUT2("BARUFEX(",BARFILE)
- Q
- EN(ARFROM,ARTO) ;EP - ENTRY TO MAIN UFMS EXTRACT. PULL ALL TRANSACTIONS W/IN DATE RANGE
- Q ;DISABLED MRS:BAR*1.8*7 IM30562
- N TRDATE,ENDDATE,TODATE
- N IENS,UFMSTRDT,ARCREDIT,ARDEBIT,ARBILL,UFMSBILL,TPBIEN,TPBLOC,BARACCT,TPBSTAT
- N ARCOL,ARCOLIN,ARASUFAC,ARCOLDT,TRANTYPE,UFMSTYPE,UFMSAMT,APPLYTO,BARAREA,PARNTLOC
- K ^BARUFEX($J)
- S:$G(ARFROM)="" ARFROM=DT-.01
- S:$G(ARTO)="" ARTO=DT
- S ENDDATE=ARTO_.999999
- D PRE^BARUFEX5(ARFROM,DUZ) ;CREATE ^BARBOB GLOBAL ;BAR*1.8*4 UFMS ;bar*1.8*4 SDR
- S TRDATE=ARFROM-.00001
- S RECORD=1,TOTAMT=0
- F S TRDATE=$O(^BARTR(DUZ(2),TRDATE)) Q:'TRDATE!(TRDATE>ENDDATE) D
- .;D GETDATA(TRDATE,.RECORD,.TOTAMT) ;MRS:BAR*1.8*7 IM30562
- .D GETDATA^BARUFEX1(TRDATE,.RECORD,.TOTAMT)
- ;
- ;DO THE TRAILER
- S RECTYPE="T"
- S RECORDS=$$FILLSTR^BARUFUT1(RECORD,10,"R","0")
- S TOTAMT=$$FILLSTR^BARUFUT1(TOTAMT,20,"R","0")
- S ^BARUFEX($J,RECORD)=RECTYPE_RECORDS_TOTAMT
- Q
- BARUFEX ; IHS/SD/TPF - MAIN EXTRACT RTN FOR UFMS ; 09/19/2008
- +1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,6,7**;OCT 26, 2005
- +2 ;Heavily modified to prevent duplicate records ;MRS:BAR*1.8*7 IM30562
- +3 ;GETDATA MOVED TO NEW ROUTINE BARUFEX1 created to meet SAC size requirements ;MRS:BAR*1.8*7
- +4 ;New functionality only enters through single PULLSESS EP ;MRS:BAR*1.8*7 IM30562
- +5 QUIT
- +6 ;
- PULLSESS(UDUZ,SESSID) ;EP - PULL TRANSACTIONS LOGGED UNDER THIS SESSION
- +1 NEW TRDATE,TRAILER,NOTSENT,BAROLD,BARNOW
- +2 KILL ^BARUFEX($JOB)
- +3 SET RC=$$ASKFNAME^BARUFUT1(.BARFILE)
- +4 IF 'RC
- WRITE !!,"SESSION NOT TRANSMITTED"
- DO ASKFORRT^BARUFUT
- QUIT 0
- +5 SET (RECORD,TOTAMT)=0
- +6 IF $DATA(SESSID)'=1
- Begin DoDot:1
- +7 ;CAPTURE OLDEST DATE BAR*1.8*4
- SET BAROLD=$$OLD(.SESSID)
- +8 SET REC=""
- +9 FOR
- SET REC=$ORDER(SESSID(REC))
- IF REC=""
- QUIT
- Begin DoDot:2
- +10 SET UDUZ=$PIECE(SESSID(REC),U)
- +11 SET SESSID=$PIECE(SESSID(REC),U,2)
- +12 ;MRS:BAR*1.8*7 IM30562
- IF '$$LCK(UDUZ,SESSID)
- QUIT
- +13 ;CAPTURE OLDEST DATE
- IF SESSID<BAROLD
- SET BAROLD=SESSID
- +14 DO DT(UDUZ,SESSID,BAROLD)
- End DoDot:2
- +15 IF $DATA(^BARUFEX($JOB))
- SET TRAILER=$$TRAILER()
- End DoDot:1
- QUIT $DATA(^BARUFEX($JOB))_U_BARFILE
- +16 IF '$TEST
- Begin DoDot:1
- +17 ;MRS:BAR*1.8*7 IM30562
- IF '$$LCK(UDUZ,SESSID)
- QUIT
- +18 DO DT(UDUZ,SESSID,SESSID)
- +19 IF $DATA(^BARUFEX($JOB))
- SET TRAILER=$$TRAILER()
- End DoDot:1
- QUIT $DATA(^BARUFEX($JOB))_U_BARFILE
- +20 QUIT $DATA(^BARUFEX($JOB))_U_BARFILE
- +21 ;
- DT(UDUZ,SESSID,BAROLD) ;EP - HEAVILY MODIFIED FOR BAR*1.8*4 SCR80 1.4.1
- +1 ;CHECK FOR TRANSACTIONS NOT SENT
- +2 ;D NOTSENT(.RECORD,.TOTAMT) ;ONLY CHECK ONCE
- +3 ;MRS:BAR*1.8*6 IM29616
- SET CURSTAT=$$CURSTAT^BARUFUT(UDUZ,SESSID)
- +4 ;MRS:BAR*1.8*6 IM29616
- IF CURSTAT'="REVIEWED/APPROVED"
- QUIT
- +5 DO NOW^%DTC
- +6 SET BARNOW=%
- +7 SET BARB=$PIECE(SESSID,".")-.0001
- +8 ;CASHIER
- SET BARDUZ=DUZ
- +9 IF '$GET(NOTSENT)
- Begin DoDot:1
- +10 ;CREATE ^BARBOB GLOBAL ONCE
- DO PRE^BARUFEX5(BAROLD,BARDUZ)
- +11 ;ONLY CHECK ONCE
- DO NOTSENT(.RECORD,.TOTAMT)
- SET NOTSENT=1
- +12 WRITE !,"FINISHED CHECKING 'NOT SENT' TRANSACTIONS"
- End DoDot:1
- +13 WRITE !!,"PROCESSING SESSION TRANSACTIONS FOR "_$PIECE(^VA(200,UDUZ,0),U)_": "_SESSID
- +14 SET TRDATE=0
- +15 FOR
- SET TRDATE=$ORDER(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE))
- IF 'TRDATE
- QUIT
- Begin DoDot:1
- +16 DO GETDATA^BARUFEX1(TRDATE,.RECORD,.TOTAMT,UDUZ,SESSID)
- End DoDot:1
- +17 QUIT
- +18 ;
- TRAILER() ;EP -
- +1 ;DO THE TRAILER
- +2 SET RECTYPE="T"
- +3 SET RECORDS=$$FILLSTR^BARUFUT1(RECORD,10,"R","0")
- +4 SET TOTAMT=$$FILLSTR^BARUFUT1(TOTAMT,20,"R","0")
- +5 SET ^BARUFEX($JOB,RECORD)=RECTYPE_RECORDS_TOTAMT
- +6 DO SENDFILE^BARUFUT2("BARUFEX(",BARFILE)
- +7 ;
- +8 ;SET TRANSMISSION DATE/TIME MULTIPLE
- +9 ;S RC=$$SETTRANS^BARUFUT(UDUZ,SESSID,BARFILE,CURSTAT)
- +10 QUIT 1_U_BARFILE
- +11 ;
- NOTSENT(RECORD,TOTAMT) ;EP - CHECK THE NOT SENT CROSS REFERENCE
- +1 NEW TRDATE,SESSID,UDUZ
- +2 WRITE !!,"CHECKING PREVIOUSLY 'NOT SENT' TRANSACTIONS"
- +3 SET TRDATE=""
- +4 FOR
- SET TRDATE=$ORDER(^BARSESS(DUZ(2),"NS",TRDATE))
- IF TRDATE=""
- QUIT
- Begin DoDot:1
- +5 SET SESSID=$ORDER(^BARSESS(DUZ(2),"NS",TRDATE,""))
- +6 SET UDUZ=$ORDER(^BARSESS(DUZ(2),"NS",TRDATE,SESSID,""))
- +7 ;D GETDATA(TRDATE,.RECORD,.TOTAMT)
- +8 DO GETDATA^BARUFEX1(TRDATE,.RECORD,.TOTAMT,UDUZ,SESSID)
- End DoDot:1
- +9 QUIT
- +10 ;
- OLD(SESSID) ;FIND OLDEST SESSION DATE BAR*1.8*4 DD 4.1.1
- +1 NEW DATE,OLD,REC
- +2 SET OLD=$GET(SESSID)
- +3 SET REC=""
- +4 FOR
- SET REC=$ORDER(SESSID(REC))
- IF REC=""
- QUIT
- Begin DoDot:1
- +5 SET DATE=$PIECE(SESSID(REC),U,2)
- +6 IF OLD=""
- SET OLD=DATE
- +7 ;CAPTURE OLDEST DATE
- IF OLD>DATE
- SET OLD=DATE
- End DoDot:1
- +8 ;MAKE A LITTLE OLDER
- QUIT OLD-2
- +9 ;
- LCK(UDUZ,SESSID) ;EP; LOCK A/R SESSION FILE ;MRS:BAR*1.8*7 IM30562
- +1 ;
- +2 NEW X
- +3 FOR I=1:1:5
- LOCK +^BARSESS(DUZ(2),UDUZ,11,SESSID):2
- SET X=$TEST
- IF X
- QUIT
- +4 IF 'X
- Begin DoDot:1
- +5 WRITE *7,!!,"A/R UFMS CASHIER SESSION FILE IS LOCKED for SESSION "_SESSID
- +6 WRITE !," SOMEONE ELSE MAY BE EXPORTING, TRY THIS SESSION AGAIN LATER "
- +7 HANG 3
- End DoDot:1
- QUIT X
- +8 QUIT X
- +9 ;
- +10 ;OLD SUBROUTINES DISABLED AND MOVED TO BOTTOM OF ROUTINE;MRS:BAR*1.8*7 IM30562
- ASKDATE ;EP - ASK DATE RANGE
- ASKFROM ;EP - ASK FROM DATE
- +1 ;DISABLED MRS:BAR*1.8*7 IM30562
- QUIT
- +2 KILL %DT
- +3 SET %DT="AET"
- +4 SET %DT("A")="Enter beginning transaction date: "
- +5 DO ^%DT
- +6 IF X=""!(X[U)
- QUIT
- +7 IF Y<0
- WRITE !,"INVALID DATE. TRY AGAIN!"
- HANG 2
- GOTO ASKFROM
- +8 SET BARFROM=Y
- ASKTO ;EP - ASK TO DATE
- +1 ;DISABLED MRS:BAR*1.8*7 IM30562
- QUIT
- +2 KILL %DT
- +3 SET %DT="AET"
- +4 SET %DT("A")="Enter ending transaction date: "
- +5 DO ^%DT
- +6 IF X=""!(X[U)
- GOTO ASKFROM
- +7 IF Y<0
- WRITE !,"INVALID DATE. TRY AGAIN!"
- HANG 2
- GOTO ASKTO
- +8 SET BARTO=Y
- +9 IF BARTO<BARFROM
- WRITE !!,"END DATE MUST BE GREATER THAN BEGINING DATE"
- HANG 2
- GOTO ASKFROM
- ASKFILE ;EP - ASK FILENAME
- +1 ;DISABLED MRS:BAR*1.8*7 IM30562
- QUIT
- +2 SET RC=$$ASKFNAME^BARUFUT1(.BARFILE)
- +3 IF 'RC
- WRITE !!,"FILE NOT TRANSMITTED"
- DO ASKFORRT^BARUFUT
- QUIT
- +4 DO EN(BARFROM,BARTO)
- +5 IF '$DATA(^BARUFEX($JOB))
- Begin DoDot:1
- +6 WRITE !,"THERE WERE NO TRANSACTIONS FOUND ELIGIBLE FOR TRANSMISSION!"
- +7 DO ASKFORRT^BARUFUT
- End DoDot:1
- +8 DO SENDFILE^BARUFUT2("BARUFEX(",BARFILE)
- +9 QUIT
- ONETRAN(TRDATE,SESSID) ;EP - CREATE FILE FOR ONE/MANY A/R TRANSACTION
- +1 ;DISABLED;MRS:BAR*1.8*7 IM30562
- QUIT
- +2 NEW REC
- +3 KILL ^BARUFEX($JOB)
- +4 SET ARFROM=TRDATE-.01
- +5 SET ARFROM=ARFROM-.00001
- +6 ;CREATE ^BARBOB GLOBAL
- DO PRE^BARUFEX5(ARFROM,DUZ)
- +7 SET RC=$$ASKFNAME^BARUFUT1(.BARFILE)
- +8 IF 'RC
- WRITE !!,"TRANSACTIONS NOT TRANSMITTED"
- DO ASKFORRT^BARUFUT
- QUIT
- +9 SET (RECORD,TOTAMT)=0
- +10 ;
- +11 SET REC=""
- +12 FOR
- SET REC=$ORDER(TRDATE(REC))
- IF REC=""
- QUIT
- Begin DoDot:1
- +13 SET TRDATE=TRDATE(REC)
- +14 ;D GETDATA(TRDATE,.RECORD,.TOTAMT)
- +15 DO GETDATA^BARUFEX1(TRDATE,.RECORD,.TOTAMT,UDUZ,SESSID)
- End DoDot:1
- +16 IF '$DATA(^BARUFEX($JOB))
- Begin DoDot:1
- +17 WRITE !,"THERE WERE NO TRANSACTIONS FOUND ELIGIBLE FOR TRANSMISSION!"
- +18 DO ASKFORRT^BARUFUT
- End DoDot:1
- QUIT
- +19 ;DO THE TRAILER
- +20 SET RECTYPE="T"
- +21 SET RECORDS=$$FILLSTR^BARUFUT1(RECORD,10,"R","0")
- +22 SET TOTAMT=$$FILLSTR^BARUFUT1(TOTAMT,20,"R","0")
- +23 SET ^BARUFEX($JOB,RECORD)=RECTYPE_RECORDS_TOTAMT
- +24 DO SENDFILE^BARUFUT2("BARUFEX(",BARFILE)
- +25 QUIT
- EN(ARFROM,ARTO) ;EP - ENTRY TO MAIN UFMS EXTRACT. PULL ALL TRANSACTIONS W/IN DATE RANGE
- +1 ;DISABLED MRS:BAR*1.8*7 IM30562
- QUIT
- +2 NEW TRDATE,ENDDATE,TODATE
- +3 NEW IENS,UFMSTRDT,ARCREDIT,ARDEBIT,ARBILL,UFMSBILL,TPBIEN,TPBLOC,BARACCT,TPBSTAT
- +4 NEW ARCOL,ARCOLIN,ARASUFAC,ARCOLDT,TRANTYPE,UFMSTYPE,UFMSAMT,APPLYTO,BARAREA,PARNTLOC
- +5 KILL ^BARUFEX($JOB)
- +6 IF $GET(ARFROM)=""
- SET ARFROM=DT-.01
- +7 IF $GET(ARTO)=""
- SET ARTO=DT
- +8 SET ENDDATE=ARTO_.999999
- +9 ;CREATE ^BARBOB GLOBAL ;BAR*1.8*4 UFMS ;bar*1.8*4 SDR
- DO PRE^BARUFEX5(ARFROM,DUZ)
- +10 SET TRDATE=ARFROM-.00001
- +11 SET RECORD=1
- SET TOTAMT=0
- +12 FOR
- SET TRDATE=$ORDER(^BARTR(DUZ(2),TRDATE))
- IF 'TRDATE!(TRDATE>ENDDATE)
- QUIT
- Begin DoDot:1
- +13 ;D GETDATA(TRDATE,.RECORD,.TOTAMT) ;MRS:BAR*1.8*7 IM30562
- +14 DO GETDATA^BARUFEX1(TRDATE,.RECORD,.TOTAMT)
- End DoDot:1
- +15 ;
- +16 ;DO THE TRAILER
- +17 SET RECTYPE="T"
- +18 SET RECORDS=$$FILLSTR^BARUFUT1(RECORD,10,"R","0")
- +19 SET TOTAMT=$$FILLSTR^BARUFUT1(TOTAMT,20,"R","0")
- +20 SET ^BARUFEX($JOB,RECORD)=RECTYPE_RECORDS_TOTAMT
- +21 QUIT
