BARUFCNR ; IHS/SD/SDR - TREASURY DEPOSIT NUMBER RECONCILIATION REPORT ; 09/03/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**4,6,7,17,21**;OCT 26, 2005
;
; IHS/SD/SDR - v1.8 p6 - DD 4.1.2
; Added apply to and Dt Tx'ed to UFMS
;
Q
EN ;EP;
W !,"This report will print all PAYMENT transactions for a selected date"
W !,"range and treasury deposit/IPAC and whether it has been sent to UFMS,"
W !,"the Not Sent bucket, or neither."
W !
DT W !!," ============ Transaction Date Range =============",!
S DIR("A")="Enter STARTING DATE for the Report"
S DIR(0)="DO^::EN"
D ^DIR
Q:$D(DIRUT)!$D(DIROUT)
S BARY("DT",1)=Y
W !
S DIR("A")="Enter ENDING DATE for the Report"
D ^DIR
K DIR
G DT:$D(DIRUT)!$D(DIROUT)
S BARY("DT",2)=Y
I BARY("DT",1)>BARY("DT",2) W !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!! G DT
;
TDN ;Treasury Deposit number
W !
S DIR(0)="FO^6:20"
S DIR("A")="Treasury Deposit/IPAC"
S DIR("?")="Must be 6-20 numbers, PRE-UFMS_COLLECTIONS, or NONPAYMENT"
D ^DIR
G DT:$D(DIRUT)!$D(DIROUT)
K DIR
S BARWSCHD=Y
;
;display selection
W !!,"This report will now look for payment transactions with:"
W !?5,"TREASURY DEPOSIT/IPAC ",BARWSCHD
W !?5,"in DATE RANGE ",$$FMTE^XLFDT(BARY("DT",1),"5DZ")," to ",$$FMTE^XLFDT(BARY("DT",2),"5DZ")
S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
Q:$D(DIRUT)!$D(DIROUT)
;
LOOP ;loop through transactions
W !!,"JUST A MINUTE PLEASE WHILE I LOOK..."
K ^TMP($J,"BARUR")
K BARCNT,BARTOT
K BARNSCNT,BARNSTOT
K BARUCNT,BARUTOT
S BARBEGDT=BARY("DT",1)
F S BARBEGDT=$O(^BARTR(DUZ(2),BARBEGDT)) Q:BARBEGDT=""!(BARBEGDT>(BARY("DT",2))) D
.Q:$P($G(^BARTR(DUZ(2),BARBEGDT,1)),U)'=40 ;payments only
.S BARCRDEB=$$GET1^DIQ(90050.03,BARBEGDT,3.5,"E")
.S BARBCH=$P($G(^BARTR(DUZ(2),BARBEGDT,0)),U,14)
.S BARITEM=$P($G(^BARTR(DUZ(2),BARBEGDT,0)),U,15)
.S BARBILL=$TR($P($G(^BARBL(DUZ(2),$P($G(^BARTR(DUZ(2),BARBEGDT,0)),U,4),0)),U),"-")
.Q:BARBCH=""
.Q:BARITEM=""
.Q:($P($G(^BARCOL(DUZ(2),BARBCH,1,BARITEM,0)),U,20)="")
.S BARSCHED=$P($G(^BARCOL(DUZ(2),BARBCH,1,BARITEM,0)),U,20)
.Q:BARSCHED'=BARWSCHD
.S BARBIEN=0
.S:BARBILL'="" BARBIEN=$O(^ABMDBILL(DUZ(2),"B",BARBILL,0))
.;S ^TMP($J,"BARUR",BARBEGDT)=$P(^AUTTLOC(DUZ(2),0),U,2)_U_BARBILL_U_BARBEGDT_U_$P($G(^BARCOL(DUZ(2),BARBCH,0)),U)_U_BARITEM_U_$P($G(^BARCOL(DUZ(2),BARBCH,1,BARITEM,0)),U,20)_U_BARCRDEB ;IHS/SD/SDR bar*1.8*6 DD 4.1.2
.;start new code IHS/SD/SDR bar*1.8*6 DD 4.1.2
.S BARTPDUZ=$P($G(^BARBL(DUZ(2),$P($G(^BARTR(DUZ(2),BARBEGDT,0)),U,4),0)),U,22)
.S BARTPIEN=$P($G(^BARBL(DUZ(2),$P($G(^BARTR(DUZ(2),BARBEGDT,0)),U,4),0)),U,17)
.;S BARINV=$$TRANSMIT^ABMUEAPI(BARTPDUZ,BARTPIEN) ;bar*1.8*6
.;start new code IHS/SD/SDR bar*1.8*6 SCR122
.S BAR08DT=$P($G(^BAR(90052.06,DUZ(2),DUZ(2),15)),U,5)
.I ((BARTPDUZ)&(BARTPIEN)) D
..S TPBAPDT=$$APPRDTTM^ABMUEAPI(BARTPDUZ,BARTPIEN)
..I TPBAPDT>BAR08DT S BARINV=$$TRANSMIT^ABMUEAPI(BARTPDUZ,BARTPIEN) Q
..S BARBLIEN=$P($G(^BARTR(DUZ(2),BARBEGDT,0)),U,4)
..S BARACCT=$$GET1^DIQ(90050.01,BARBLIEN_",",3,"I") ;A/R BILL, A/R ACCOUNT
..S PARNTLOC=$$GET1^DIQ(90050.01,BARBLIEN_",",8,"I") ;A/R BILL, PARENT LOCATION
..S BARAREA=$$GET1^DIQ(9999999.06,PARNTLOC_",",.04,"I") ;LOCATION, AREA PTR
..S D0=BARACCT
..S BARITYP=$$VALI^BARVPM(8) ;GET 'VIP INSURER TYPE' CODE
..S BARINV=$$PRELIVE^BARUFUT1(BARAREA,BARITYP)
.;end new code SCR122
.;
.;S BARTXIEN="" ;MRS:BAR*1.8*7 IM30514
.S (BARTXIEN,BARTXDT)="" ;BAR*1.8*17 PD 2/4/2010
.S BARUSER=$P($G(^BARTR(DUZ(2),BARBEGDT,0)),U,13)
.S BARSESS=$O(^BARSESS(DUZ(2),"G",BARBEGDT,BARUSER,9999999.999999),-1)
.S:+$G(BARSESS) BARTXIEN=$O(^BARSESS(DUZ(2),BARUSER,11,BARSESS,21,9999),-1)
.S:+$G(BARTXIEN) BARTXDT=$P($G(^BARSESS(DUZ(2),BARUSER,11,BARSESS,21,BARTXIEN,0)),U)
.S:+$G(BARTXDT) BARTXDT=$$FMTE^XLFDT(BARTXDT,"5")
.;
.S BARREC=$P(^AUTTLOC(DUZ(2),0),U,2)_U_BARBILL_U_BARBEGDT_U_$P($G(^BARCOL(DUZ(2),BARBCH,0)),U)_U_BARITEM_U_$P($G(^BARCOL(DUZ(2),BARBCH,1,BARITEM,0)),U,20)_U_BARCRDEB_U_U_U_BARINV_U_BARTXDT
.S ^TMP($J,"BARUR",BARBEGDT)=BARREC
.;end new code DD 4.1.2
.S BARCNT=+$G(BARCNT)+1
.S BARTOT=+$G(BARTOT)+BARCRDEB
.;
.D NSCHK ;now check for these trans on NOT SENT list
.D UFMSCHK ;check if in UFMS file
D OUTPUT
Q
NSCHK ;
Q:'$D(^BARSESS(DUZ(2),"NS",BARBEGDT)) ;trans not on NS list
S $P(^TMP($J,"BARUR",BARBEGDT),U,8)="N"
S BARSESS=$O(^BARSESS(DUZ(2),"NS",BARBEGDT,""))
S BARUSER=$O(^BARSESS(DUZ(2),"NS",BARBEGDT,BARSESS,""))
S BARNSR=$P($G(^BARSESS(DUZ(2),BARUSER,11,BARSESS,2,BARBEGDT,0)),U,9) ;reason not sent
S $P(^TMP($J,"BARUR",BARBEGDT),U,9)=BARNSR
S BARNSTOT=+$G(BARNSTOT)+BARCRDEB
S BARNSCNT=+$G(BARNSCNT)+1
Q
UFMSCHK ;
Q:$D(^BARSESS(DUZ(2),"NS",BARBEGDT))
S $P(^TMP($J,"BARUR",BARBEGDT),U,8)="Y"
S BARUCNT=+$G(BARUCNT)+1
S BARUTOT=+$G(BARUTOT)+BARCRDEB
Q
OUTPUT ;
K DIR
S DIR(0)="FO"
S DIR("A")="Enter path"
D ^DIR K DIR
Q:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)!(Y="")
S PATH=Y
S DIR(0)="FO"
S DIR("A")="Enter filename"
D ^DIR K DIR
G:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)!(Y="") EN
S FILENAME=Y
D OPEN^%ZISH("FILE",PATH,FILENAME,"W")
Q:$G(POP)
HDR ;W "LOCATION^A/R BILL^TRANSACTION^COLLECTION BATCH^COLLECTION ITEM^TREASURY DEP/IPAC^DOLLAR AMOUNT^TRANSMITTED?^REASON NOT SENT" ;IHS/SD/SDR bar*1.8*6 DD 4.1.2
U IO ;IHS/SD/SDR 8/11/11 BAR*1.8*21 NOHEAT
W "LOCATION^A/R BILL^TRANSACTION^COLLECTION BATCH^COLLECTION ITEM^TREASURY DEP/IPAC^DOLLAR AMOUNT^TRANSMITTED?^REASON NOT SENT^APPLY TO^DT TX'ED TO UFMS" ;IHS/SD/SDR bar*1.8*6 DD 4.1.2
S BARBEGDT=""
F S BARBEGDT=$O(^TMP($J,"BARUR",BARBEGDT)) Q:BARBEGDT="" D
.W !,$G(^TMP($J,"BARUR",BARBEGDT))
W !,"TOTAL TRANSACTIONS SENT TO UFMS: ",$G(BARUCNT)
W !,"TOTAL DOLLARS SENT TO UFMS: ",$G(BARUTOT)
W !,"TOTAL 'NOT SENT' TRANSACTIONS: ",$G(BARNSCNT)
W !,"TOTAL 'NOT SENT' DOLLARS: ",$G(BARNSTOT)
W !,"TOTAL PAYMENT TRANSACTIONS: ",$G(BARCNT)
W !,"TOTAL PAYMENT DOLLARS: ",$G(BARTOT)
D CLOSE^%ZISH("FILE")
Q
BARUFCNR ; IHS/SD/SDR - TREASURY DEPOSIT NUMBER RECONCILIATION REPORT ; 09/03/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,6,7,17,21**;OCT 26, 2005
+2 ;
+3 ; IHS/SD/SDR - v1.8 p6 - DD 4.1.2
+4 ; Added apply to and Dt Tx'ed to UFMS
+5 ;
+6 QUIT
EN ;EP;
+1 WRITE !,"This report will print all PAYMENT transactions for a selected date"
+2 WRITE !,"range and treasury deposit/IPAC and whether it has been sent to UFMS,"
+3 WRITE !,"the Not Sent bucket, or neither."
+4 WRITE !
DT WRITE !!," ============ Transaction Date Range =============",!
+1 SET DIR("A")="Enter STARTING DATE for the Report"
+2 SET DIR(0)="DO^::EN"
+3 DO ^DIR
+4 IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT
+5 SET BARY("DT",1)=Y
+6 WRITE !
+7 SET DIR("A")="Enter ENDING DATE for the Report"
+8 DO ^DIR
+9 KILL DIR
+10 IF $DATA(DIRUT)!$DATA(DIROUT)
GOTO DT
+11 SET BARY("DT",2)=Y
+12 IF BARY("DT",1)>BARY("DT",2)
WRITE !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!!
GOTO DT
+13 ;
TDN ;Treasury Deposit number
+1 WRITE !
+2 SET DIR(0)="FO^6:20"
+3 SET DIR("A")="Treasury Deposit/IPAC"
+4 SET DIR("?")="Must be 6-20 numbers, PRE-UFMS_COLLECTIONS, or NONPAYMENT"
+5 DO ^DIR
+6 IF $DATA(DIRUT)!$DATA(DIROUT)
GOTO DT
+7 KILL DIR
+8 SET BARWSCHD=Y
+9 ;
+10 ;display selection
+11 WRITE !!,"This report will now look for payment transactions with:"
+12 WRITE !?5,"TREASURY DEPOSIT/IPAC ",BARWSCHD
+13 WRITE !?5,"in DATE RANGE ",$$FMTE^XLFDT(BARY("DT",1),"5DZ")," to ",$$FMTE^XLFDT(BARY("DT",2),"5DZ")
+14 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
+15 IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT
+16 ;
LOOP ;loop through transactions
+1 WRITE !!,"JUST A MINUTE PLEASE WHILE I LOOK..."
+2 KILL ^TMP($JOB,"BARUR")
+3 KILL BARCNT,BARTOT
+4 KILL BARNSCNT,BARNSTOT
+5 KILL BARUCNT,BARUTOT
+6 SET BARBEGDT=BARY("DT",1)
+7 FOR
SET BARBEGDT=$ORDER(^BARTR(DUZ(2),BARBEGDT))
IF BARBEGDT=""!(BARBEGDT>(BARY("DT",2)))
QUIT
Begin DoDot:1
+8 ;payments only
IF $PIECE($GET(^BARTR(DUZ(2),BARBEGDT,1)),U)'=40
QUIT
+9 SET BARCRDEB=$$GET1^DIQ(90050.03,BARBEGDT,3.5,"E")
+10 SET BARBCH=$PIECE($GET(^BARTR(DUZ(2),BARBEGDT,0)),U,14)
+11 SET BARITEM=$PIECE($GET(^BARTR(DUZ(2),BARBEGDT,0)),U,15)
+12 SET BARBILL=$TRANSLATE($PIECE($GET(^BARBL(DUZ(2),$PIECE($GET(^BARTR(DUZ(2),BARBEGDT,0)),U,4),0)),U),"-")
+13 IF BARBCH=""
QUIT
+14 IF BARITEM=""
QUIT
+15 IF ($PIECE($GET(^BARCOL(DUZ(2),BARBCH,1,BARITEM,0)),U,20)="")
QUIT
+16 SET BARSCHED=$PIECE($GET(^BARCOL(DUZ(2),BARBCH,1,BARITEM,0)),U,20)
+17 IF BARSCHED'=BARWSCHD
QUIT
+18 SET BARBIEN=0
+19 IF BARBILL'=""
SET BARBIEN=$ORDER(^ABMDBILL(DUZ(2),"B",BARBILL,0))
+20 ;S ^TMP($J,"BARUR",BARBEGDT)=$P(^AUTTLOC(DUZ(2),0),U,2)_U_BARBILL_U_BARBEGDT_U_$P($G(^BARCOL(DUZ(2),BARBCH,0)),U)_U_BARITEM_U_$P($G(^BARCOL(DUZ(2),BARBCH,1,BARITEM,0)),U,20)_U_BARCRDEB ;IHS/SD/SDR bar*1.8*6 DD 4.1.2
+21 ;start new code IHS/SD/SDR bar*1.8*6 DD 4.1.2
+22 SET BARTPDUZ=$PIECE($GET(^BARBL(DUZ(2),$PIECE($GET(^BARTR(DUZ(2),BARBEGDT,0)),U,4),0)),U,22)
+23 SET BARTPIEN=$PIECE($GET(^BARBL(DUZ(2),$PIECE($GET(^BARTR(DUZ(2),BARBEGDT,0)),U,4),0)),U,17)
+24 ;S BARINV=$$TRANSMIT^ABMUEAPI(BARTPDUZ,BARTPIEN) ;bar*1.8*6
+25 ;start new code IHS/SD/SDR bar*1.8*6 SCR122
+26 SET BAR08DT=$PIECE($GET(^BAR(90052.06,DUZ(2),DUZ(2),15)),U,5)
+27 IF ((BARTPDUZ)&(BARTPIEN))
Begin DoDot:2
+28 SET TPBAPDT=$$APPRDTTM^ABMUEAPI(BARTPDUZ,BARTPIEN)
+29 IF TPBAPDT>BAR08DT
SET BARINV=$$TRANSMIT^ABMUEAPI(BARTPDUZ,BARTPIEN)
QUIT
+30 SET BARBLIEN=$PIECE($GET(^BARTR(DUZ(2),BARBEGDT,0)),U,4)
+31 ;A/R BILL, A/R ACCOUNT
SET BARACCT=$$GET1^DIQ(90050.01,BARBLIEN_",",3,"I")
+32 ;A/R BILL, PARENT LOCATION
SET PARNTLOC=$$GET1^DIQ(90050.01,BARBLIEN_",",8,"I")
+33 ;LOCATION, AREA PTR
SET BARAREA=$$GET1^DIQ(9999999.06,PARNTLOC_",",.04,"I")
+34 SET D0=BARACCT
+35 ;GET 'VIP INSURER TYPE' CODE
SET BARITYP=$$VALI^BARVPM(8)
+36 SET BARINV=$$PRELIVE^BARUFUT1(BARAREA,BARITYP)
End DoDot:2
+37 ;end new code SCR122
+38 ;
+39 ;S BARTXIEN="" ;MRS:BAR*1.8*7 IM30514
+40 ;BAR*1.8*17 PD 2/4/2010
SET (BARTXIEN,BARTXDT)=""
+41 SET BARUSER=$PIECE($GET(^BARTR(DUZ(2),BARBEGDT,0)),U,13)
+42 SET BARSESS=$ORDER(^BARSESS(DUZ(2),"G",BARBEGDT,BARUSER,9999999.999999),-1)
+43 IF +$GET(BARSESS)
SET BARTXIEN=$ORDER(^BARSESS(DUZ(2),BARUSER,11,BARSESS,21,9999),-1)
+44 IF +$GET(BARTXIEN)
SET BARTXDT=$PIECE($GET(^BARSESS(DUZ(2),BARUSER,11,BARSESS,21,BARTXIEN,0)),U)
+45 IF +$GET(BARTXDT)
SET BARTXDT=$$FMTE^XLFDT(BARTXDT,"5")
+46 ;
+47 SET BARREC=$PIECE(^AUTTLOC(DUZ(2),0),U,2)_U_BARBILL_U_BARBEGDT_U_$PIECE($GET(^BARCOL(DUZ(2),BARBCH,0)),U)_U_BARITEM_U_$PIECE($GET(^BARCOL(DUZ(2),BARBCH,1,BARITEM,0)),U,20)_U_BARCRDEB_U_U_U_BARINV_U_BARTXDT
+48 SET ^TMP($JOB,"BARUR",BARBEGDT)=BARREC
+49 ;end new code DD 4.1.2
+50 SET BARCNT=+$GET(BARCNT)+1
+51 SET BARTOT=+$GET(BARTOT)+BARCRDEB
+52 ;
+53 ;now check for these trans on NOT SENT list
DO NSCHK
+54 ;check if in UFMS file
DO UFMSCHK
End DoDot:1
+55 DO OUTPUT
+56 QUIT
NSCHK ;
+1 ;trans not on NS list
IF '$DATA(^BARSESS(DUZ(2),"NS",BARBEGDT))
QUIT
+2 SET $PIECE(^TMP($JOB,"BARUR",BARBEGDT),U,8)="N"
+3 SET BARSESS=$ORDER(^BARSESS(DUZ(2),"NS",BARBEGDT,""))
+4 SET BARUSER=$ORDER(^BARSESS(DUZ(2),"NS",BARBEGDT,BARSESS,""))
+5 ;reason not sent
SET BARNSR=$PIECE($GET(^BARSESS(DUZ(2),BARUSER,11,BARSESS,2,BARBEGDT,0)),U,9)
+6 SET $PIECE(^TMP($JOB,"BARUR",BARBEGDT),U,9)=BARNSR
+7 SET BARNSTOT=+$GET(BARNSTOT)+BARCRDEB
+8 SET BARNSCNT=+$GET(BARNSCNT)+1
+9 QUIT
UFMSCHK ;
+1 IF $DATA(^BARSESS(DUZ(2),"NS",BARBEGDT))
QUIT
+2 SET $PIECE(^TMP($JOB,"BARUR",BARBEGDT),U,8)="Y"
+3 SET BARUCNT=+$GET(BARUCNT)+1
+4 SET BARUTOT=+$GET(BARUTOT)+BARCRDEB
+5 QUIT
OUTPUT ;
+1 KILL DIR
+2 SET DIR(0)="FO"
+3 SET DIR("A")="Enter path"
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)!(Y="")
QUIT
+6 SET PATH=Y
+7 SET DIR(0)="FO"
+8 SET DIR("A")="Enter filename"
+9 DO ^DIR
KILL DIR
+10 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)!(Y="")
GOTO EN
+11 SET FILENAME=Y
+12 DO OPEN^%ZISH("FILE",PATH,FILENAME,"W")
+13 IF $GET(POP)
QUIT
HDR ;W "LOCATION^A/R BILL^TRANSACTION^COLLECTION BATCH^COLLECTION ITEM^TREASURY DEP/IPAC^DOLLAR AMOUNT^TRANSMITTED?^REASON NOT SENT" ;IHS/SD/SDR bar*1.8*6 DD 4.1.2
+1 ;IHS/SD/SDR 8/11/11 BAR*1.8*21 NOHEAT
USE IO
+2 ;IHS/SD/SDR bar*1.8*6 DD 4.1.2
WRITE "LOCATION^A/R BILL^TRANSACTION^COLLECTION BATCH^COLLECTION ITEM^TREASURY DEP/IPAC^DOLLAR AMOUNT^TRANSMITTED?^REASON NOT SENT^APPLY TO^DT TX'ED TO UFMS"
+3 SET BARBEGDT=""
+4 FOR
SET BARBEGDT=$ORDER(^TMP($JOB,"BARUR",BARBEGDT))
IF BARBEGDT=""
QUIT
Begin DoDot:1
+5 WRITE !,$GET(^TMP($JOB,"BARUR",BARBEGDT))
End DoDot:1
+6 WRITE !,"TOTAL TRANSACTIONS SENT TO UFMS: ",$GET(BARUCNT)
+7 WRITE !,"TOTAL DOLLARS SENT TO UFMS: ",$GET(BARUTOT)
+8 WRITE !,"TOTAL 'NOT SENT' TRANSACTIONS: ",$GET(BARNSCNT)
+9 WRITE !,"TOTAL 'NOT SENT' DOLLARS: ",$GET(BARNSTOT)
+10 WRITE !,"TOTAL PAYMENT TRANSACTIONS: ",$GET(BARCNT)
+11 WRITE !,"TOTAL PAYMENT DOLLARS: ",$GET(BARTOT)
+12 DO CLOSE^%ZISH("FILE")
+13 QUIT
