- BARUFPRP ; IHS/SD/TPF - REPORT TO WRITE OUT REPORT FILE ;01/26/2009
- ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,10,24**;OCT 26, 2005;Build 69
- EN ;EP;NEW ROUTINE STANDALONE UTILITY TO WRITE OUT BARBOB FILE;MRS:02/04/2008
- ;
- ; ENTERS WITH
- ; BARU = CASHIER WHO CREATED BOB
- ; BARA = DUZ(2)
- ; BARB = BATCH IEN
- ; BARC = BATCH ITEM
- ; BARD = TRANSACTION
- ;
- ;JULY 2013 IHS/SD/POTT HEAT118656 BELCOURT SKIP UNDEF ENTRY IN ^BARCOL BAR*1.8*24
- ;
- N BARA,BARB,BARC,BARD,BARTMP,BARTXT,BARU,BAREND
- S BARU=DUZ
- D OLD(.BARU)
- I '$D(^BARBOB("BARZ",+BARU)) D
- .; Ask user if want to create file
- .W !
- .K DIR
- .S DIR(0)="Y"
- .S DIR("A")="NO DATA IN BOB, DO YOU WANT TO GENERATE THE FILE NOW?"
- .S DIR("B")="N"
- .D ^DIR
- .I Y=1 D
- ..D ASKFROM
- ..Q:BARFROM=""
- ..;W !!,"Please be have patience, this might take a few minutes" ;MRS:BAR*1.8*10 H2437
- ..W !!,"Please have patience, this might take a few minutes" ;MRS:BAR*1.8*10 H2437
- ..D PRE^BARUFEX5(BARFROM,DUZ)
- ..S BARU=DUZ
- Q:'$D(^BARBOB("BARZ",+BARU))
- ;
- BEGIN S %ZIS="MQ"
- W !
- D ^%ZIS
- Q:POP
- I $D(IO("Q")) D QUE Q
- U IO
- D HDR
- S BARA=0 F S BARA=$O(^BARBOB("BARZ",BARU,BARA)) Q:'BARA D
- .S BARB=0 F S BARB=$O(^BARBOB("BARZ",BARU,BARA,BARB)) Q:'BARB D
- . . I '$D(^BARCOL(BARA,BARB)) D Q ;BELCOURT HEAT118656 BAR*1.8*24
- . . . I $P($G(^VA(200,DUZ,0)),U,4)'="@" Q
- . . . W !,"ENTRY IN COLLECTION BATCH FILE MISSING: BARCOL(",BARA,",",BARB
- ..S BARCOLB=$P(^BARCOL(BARA,BARB,0),U,1) ;A/R COLLECTION BATCH NAME
- ..S BARC=0
- ..F S BARC=$O(^BARBOB("BARZ",BARU,BARA,BARB,BARC)) Q:'BARC D
- ...S BARTMP=$G(^BARBOB("BARZ",BARU,BARA,BARB,BARC))
- ...S BARTXT="**REVERSAL BATCH**"
- ...S:BARTMP=1 BARTXT="**PAYMENTS ONLY**"
- ...S:BARTMP=2 BARTXT="**PAYMENT BATCH WITH MINUS CODE"
- ...S:BARTMP=3 BARTXT="**REVERSAL BATCH WITH MINUS CODE**"
- ...W !,BARA,U,BARCOLB,U,BARC,U,BARTXT
- ...S BARD=0
- ...F S BARD=$O(^BARBOB("BARZ",BARU,BARA,BARB,BARC,BARD)) Q:'BARD D
- ....S BARD0=^BARBOB("BARZ",BARU,BARA,BARB,BARC,BARD)
- ....S P1=$P(BARD0,U) ;DOLLAR AMOUNT
- ....S P2=$P(BARD0,U,2) ;SCHEDULE NUMBER
- ....S P3=$P(BARD0,U,3) ;BILL IEN
- ....S P4=$P(BARD0,U,4) ;BILL NUMBER
- ....S P5=$P(BARD0,U,5) ;PAIR FLAG (0,1,2,-3,-4,-6,-7,-25,-I)
- ....S P6=$P(BARD0,U,6) ;PAIRED COLL BATCH IEN
- ....S P7=$P(BARD0,U,7) ;PAIRED ITEM NUMBER
- ....S P8=$P(BARD0,U,8) ;PARIED TRANSACTION
- ....S:P6]"" P6=$P(^BARCOL(BARA,P6,0),U,1) ;A/R COLLECTION BATCH NAME
- ....W !,BARA,U,BARCOLB,U,BARC,U,BARD,U
- ....W P1,U,P2,U,P3,U,P4,U,P5,U,P6,U,P7,U,P8
- D ^%ZISC
- Q
- HDR ;
- W U_"BOB REPORT FOR ENDING DATE "_$G(^BARBOB("BARZ",BARU,"END"))
- W !,"DUZ(2)",U,"COLLECTION BATCH",U,"BATCH ITEM NUMBER",U
- W "TRANSACTION",U,"AMOUNT",U,"TDN/IPAC",U,"BILL IEN",U,"A/R BILL"
- W U_"PAIR FLAG"_U_"PAIRED BATCH"_U_"PAIRED ITEM"_U_"PAIRED TX"
- W !
- Q
- QUE ; EP - QUE 'NOT SENT' OR 'DELAY SEND' REPORT
- S ZTRTN="^BARUFPRP"
- S ZTDESC="BOB PAYMENT REPORT"
- S ZTSAVE("XREF")=""
- D ^%ZTLOAD
- I $D(ZTSK)[0 W !!?5,"Report Cancelled!"
- E W !!?5,"Report task #: ",$G(ZTSK)
- D HOME^%ZIS
- Q
- OLD(OLDDUZ) ;FIND MOST RECENT
- ;^BARBOB("BARZ",1234,"BEGIN")=3080227.100406
- ; "COUNT")=24903
- ; "END")=3080227.100614
- N A,OLDDT,OLDDUZ
- S (OLDDT,OLDDUZ)=""
- S A=0
- F S A=$O(^BARBOB("BARZ",A)) Q:'A D
- .S END=$G(^BARBOB("BARZ",A,"END"))
- .I END>OLDDT S OLDDUZ=A
- Q
- ASKFROM ;EP - ASK FROM DATE
- S BARFROM=""
- K %DT
- S %DT="AET"
- S %DT("A")="Enter beginning session date: "
- W !
- D ^%DT
- Q:X=""!(X[U)
- I Y<0 W !,"INVALID DATE. TRY AGAIN!" H 2 G ASKFROM
- S BARFROM=Y
- Q ;EOR
- BARUFPRP ; IHS/SD/TPF - REPORT TO WRITE OUT REPORT FILE ;01/26/2009
- +1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,10,24**;OCT 26, 2005;Build 69
- EN ;EP;NEW ROUTINE STANDALONE UTILITY TO WRITE OUT BARBOB FILE;MRS:02/04/2008
- +1 ;
- +2 ; ENTERS WITH
- +3 ; BARU = CASHIER WHO CREATED BOB
- +4 ; BARA = DUZ(2)
- +5 ; BARB = BATCH IEN
- +6 ; BARC = BATCH ITEM
- +7 ; BARD = TRANSACTION
- +8 ;
- +9 ;JULY 2013 IHS/SD/POTT HEAT118656 BELCOURT SKIP UNDEF ENTRY IN ^BARCOL BAR*1.8*24
- +10 ;
- +11 NEW BARA,BARB,BARC,BARD,BARTMP,BARTXT,BARU,BAREND
- +12 SET BARU=DUZ
- +13 DO OLD(.BARU)
- +14 IF '$DATA(^BARBOB("BARZ",+BARU))
- Begin DoDot:1
- +15 ; Ask user if want to create file
- +16 WRITE !
- +17 KILL DIR
- +18 SET DIR(0)="Y"
- +19 SET DIR("A")="NO DATA IN BOB, DO YOU WANT TO GENERATE THE FILE NOW?"
- +20 SET DIR("B")="N"
- +21 DO ^DIR
- +22 IF Y=1
- Begin DoDot:2
- +23 DO ASKFROM
- +24 IF BARFROM=""
- QUIT
- +25 ;W !!,"Please be have patience, this might take a few minutes" ;MRS:BAR*1.8*10 H2437
- +26 ;MRS:BAR*1.8*10 H2437
- WRITE !!,"Please have patience, this might take a few minutes"
- +27 DO PRE^BARUFEX5(BARFROM,DUZ)
- +28 SET BARU=DUZ
- End DoDot:2
- End DoDot:1
- +29 IF '$DATA(^BARBOB("BARZ",+BARU))
- QUIT
- +30 ;
- BEGIN SET %ZIS="MQ"
- +1 WRITE !
- +2 DO ^%ZIS
- +3 IF POP
- QUIT
- +4 IF $DATA(IO("Q"))
- DO QUE
- QUIT
- +5 USE IO
- +6 DO HDR
- +7 SET BARA=0
- FOR
- SET BARA=$ORDER(^BARBOB("BARZ",BARU,BARA))
- IF 'BARA
- QUIT
- Begin DoDot:1
- +8 SET BARB=0
- FOR
- SET BARB=$ORDER(^BARBOB("BARZ",BARU,BARA,BARB))
- IF 'BARB
- QUIT
- Begin DoDot:2
- +9 ;BELCOURT HEAT118656 BAR*1.8*24
- IF '$DATA(^BARCOL(BARA,BARB))
- Begin DoDot:3
- +10 IF $PIECE($GET(^VA(200,DUZ,0)),U,4)'="@"
- QUIT
- +11 WRITE !,"ENTRY IN COLLECTION BATCH FILE MISSING: BARCOL(",BARA,",",BARB
- End DoDot:3
- QUIT
- +12 ;A/R COLLECTION BATCH NAME
- SET BARCOLB=$PIECE(^BARCOL(BARA,BARB,0),U,1)
- +13 SET BARC=0
- +14 FOR
- SET BARC=$ORDER(^BARBOB("BARZ",BARU,BARA,BARB,BARC))
- IF 'BARC
- QUIT
- Begin DoDot:3
- +15 SET BARTMP=$GET(^BARBOB("BARZ",BARU,BARA,BARB,BARC))
- +16 SET BARTXT="**REVERSAL BATCH**"
- +17 IF BARTMP=1
- SET BARTXT="**PAYMENTS ONLY**"
- +18 IF BARTMP=2
- SET BARTXT="**PAYMENT BATCH WITH MINUS CODE"
- +19 IF BARTMP=3
- SET BARTXT="**REVERSAL BATCH WITH MINUS CODE**"
- +20 WRITE !,BARA,U,BARCOLB,U,BARC,U,BARTXT
- +21 SET BARD=0
- +22 FOR
- SET BARD=$ORDER(^BARBOB("BARZ",BARU,BARA,BARB,BARC,BARD))
- IF 'BARD
- QUIT
- Begin DoDot:4
- +23 SET BARD0=^BARBOB("BARZ",BARU,BARA,BARB,BARC,BARD)
- +24 ;DOLLAR AMOUNT
- SET P1=$PIECE(BARD0,U)
- +25 ;SCHEDULE NUMBER
- SET P2=$PIECE(BARD0,U,2)
- +26 ;BILL IEN
- SET P3=$PIECE(BARD0,U,3)
- +27 ;BILL NUMBER
- SET P4=$PIECE(BARD0,U,4)
- +28 ;PAIR FLAG (0,1,2,-3,-4,-6,-7,-25,-I)
- SET P5=$PIECE(BARD0,U,5)
- +29 ;PAIRED COLL BATCH IEN
- SET P6=$PIECE(BARD0,U,6)
- +30 ;PAIRED ITEM NUMBER
- SET P7=$PIECE(BARD0,U,7)
- +31 ;PARIED TRANSACTION
- SET P8=$PIECE(BARD0,U,8)
- +32 ;A/R COLLECTION BATCH NAME
- IF P6]""
- SET P6=$PIECE(^BARCOL(BARA,P6,0),U,1)
- +33 WRITE !,BARA,U,BARCOLB,U,BARC,U,BARD,U
- +34 WRITE P1,U,P2,U,P3,U,P4,U,P5,U,P6,U,P7,U,P8
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +35 DO ^%ZISC
- +36 QUIT
- HDR ;
- +1 WRITE U_"BOB REPORT FOR ENDING DATE "_$GET(^BARBOB("BARZ",BARU,"END"))
- +2 WRITE !,"DUZ(2)",U,"COLLECTION BATCH",U,"BATCH ITEM NUMBER",U
- +3 WRITE "TRANSACTION",U,"AMOUNT",U,"TDN/IPAC",U,"BILL IEN",U,"A/R BILL"
- +4 WRITE U_"PAIR FLAG"_U_"PAIRED BATCH"_U_"PAIRED ITEM"_U_"PAIRED TX"
- +5 WRITE !
- +6 QUIT
- QUE ; EP - QUE 'NOT SENT' OR 'DELAY SEND' REPORT
- +1 SET ZTRTN="^BARUFPRP"
- +2 SET ZTDESC="BOB PAYMENT REPORT"
- +3 SET ZTSAVE("XREF")=""
- +4 DO ^%ZTLOAD
- +5 IF $DATA(ZTSK)[0
- WRITE !!?5,"Report Cancelled!"
- +6 IF '$TEST
- WRITE !!?5,"Report task #: ",$GET(ZTSK)
- +7 DO HOME^%ZIS
- +8 QUIT
- OLD(OLDDUZ) ;FIND MOST RECENT
- +1 ;^BARBOB("BARZ",1234,"BEGIN")=3080227.100406
- +2 ; "COUNT")=24903
- +3 ; "END")=3080227.100614
- +4 NEW A,OLDDT,OLDDUZ
- +5 SET (OLDDT,OLDDUZ)=""
- +6 SET A=0
- +7 FOR
- SET A=$ORDER(^BARBOB("BARZ",A))
- IF 'A
- QUIT
- Begin DoDot:1
- +8 SET END=$GET(^BARBOB("BARZ",A,"END"))
- +9 IF END>OLDDT
- SET OLDDUZ=A
- End DoDot:1
- +10 QUIT
- ASKFROM ;EP - ASK FROM DATE
- +1 SET BARFROM=""
- +2 KILL %DT
- +3 SET %DT="AET"
- +4 SET %DT("A")="Enter beginning session date: "
- +5 WRITE !
- +6 DO ^%DT
- +7 IF X=""!(X[U)
- QUIT
- +8 IF Y<0
- WRITE !,"INVALID DATE. TRY AGAIN!"
- HANG 2
- GOTO ASKFROM
- +9 SET BARFROM=Y
- +10 ;EOR
- QUIT
