BARUFRP2 ; IHS/SD/TPF - UFMS DS,NS, TRANSACTION REPORTS ; 02/29/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,6,14,18**;OCT 22,2008
;
;NEW ROUTINE ;;BAR*1.8*4 DD ITEM
;IHS/SD/TMM ;;BAR*1.8*14 M1 09/02/09 IGNORE FLAG was still printing on NS Report
;--------------------------------------------------------------------------------
Q
;THIS ROUTINE IS CALLED BY OPTION [BAR UFMS RPT 'NOT SENT' REPORT
;
NOTSENT ;EP;
N BARTRDT,BARLINE,BARNOW,BARDELDT,BARCRDEB,BARBILL,BARBIEN,BARENTBY,BARTPIEN,BARTRNTP,BARADJC
N BARREAS
;
ASKFROM ;EP - ASK FROM DATE
K %DT
S %DT="AET"
S %DT("A")="Enter beginning transaction date: "
W !
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
K %DT
S %DT="AET"
S %DT("A")="Enter ending transaction date: "
W !
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
;
ASKDEV ;EP - ASK DEVICE
S %ZIS="MQ"
W !
D ^%ZIS
Q:POP
I $D(IO("Q")) D QUE Q
U IO
D PRINT
D ^%ZISC
Q
QUE ; EP - QUE 'NOT SENT' OR 'DELAY SEND' REPORT
S ZTRTN="PRINT^BARUFRP2"
S ZTDESC="NOT SENT TRANSACTION REPORT"
S ZTSAVE("XREF")=""
S ZTSAVE("BARTO")=""
S ZTSAVE("BARFROM")=""
D ^%ZTLOAD
I $D(ZTSK)[0 W !!?5,"Report Cancelled!"
E W !!?5,"Report task #: ",$G(ZTSK)
D HOME^%ZIS
Q
PRINT ;EP - ENTRY POINT FOR REPORT
K BAR("CNT")
K BAR("AMT")
S $P(BARLINE,"-",81)=""
D NOW^%DTC
S Y=% X ^DD("DD") S BARNOW=Y
S BARNOW=Y
D NOTDET
S BARESC=0
S BARTO=BARTO_"."_999999
S BARTRDT=BARFROM-.000001
F S BARTRDT=$O(^BARSESS(DUZ(2),"NS",BARTRDT)) Q:'BARTRDT!(BARESC)!(BARTRDT>BARTO) D
.S BARSESID=$O(^BARSESS(DUZ(2),"NS",BARTRDT,""))
.S BARUDUZ=$O(^BARSESS(DUZ(2),"NS",BARTRDT,BARSESID,""))
.; ***BEGIN M1*** ;TMM M1 09/02/09
.; Quit if IGNORE FLAG="I" ;TMM M1 09/02/09
.S BARIFLG=$P($G(^BARTR(DUZ(2),BARTRDT,1)),U,12) ;TMM M1 09/02/09
.Q:(BARIFLG="I")!(BARIFLG="-I") ;TMM M1 09/02/09
.; ***END M1*** ;TMM M1 09/02/09
.S BARAPPTO=$P($G(^BARSESS(DUZ(2),BARUDUZ,11,BARSESID,2,BARTRDT,0)),U,5)
.S BARBIEN=$P($G(^BARTR(DUZ(2),BARTRDT,0)),U,4)
.Q:BARBIEN=""
.S BARBILL=$P($G(^BARBL(DUZ(2),BARBIEN,0)),U)
.S BARCBTCH=$P($G(^BARTR(DUZ(2),BARTRDT,0)),U,14)
.S BARCITEM=$P($G(^BARTR(DUZ(2),BARTRDT,0)),U,15)
.S BARIPAC=""
.I BARCBTCH'="",(BARCITEM'="") D
..;S BARIPAC=$P($G(^BARCOL(DUZ(2),BARCBTCH,1,BARCITEM,0)),U,20) ;bar*1.8*6
..S BARIPAC=$$GET1^DIQ(90051.1101,BARCITEM_","_BARCBTCH_",",20,"E") ;bar*1.8*6
..S BARCBTCH=$P($G(^BARCOL(DUZ(2),BARCBTCH,0)),U)
.S BARENTBY=$$GET1^DIQ(90050.03,BARTRDT_",",13,"E")
.S BARTPIEN=$P($G(^BARBL(DUZ(2),BARBIEN,0)),U,17)
.S BARTPDUZ=$P($G(^BARBL(DUZ(2),BARBIEN,0)),U,22)
.S BARVTYP=$P($G(^BARBL(DUZ(2),BARBIEN,1)),U,14)
.S BARTRNTP=$$GET1^DIQ(90050.03,BARTRDT_",",101,"E")
.S BARADJC=$$GET1^DIQ(90050.03,BARTRDT_",",102,"E")
.S BARREAS=$P($G(^BARSESS(DUZ(2),BARUDUZ,11,BARSESID,2,BARTRDT,0)),U,9)
.S BARCRDEB=$$GET1^DIQ(90050.03,BARTRDT_",",3.5)
.S:BARREAS="" BARREAS="NULL" ;1/29/2007 TPF ADDED BECAUSE OF NULL FOUND
.S BAR("CNT",BARREAS)=+$G(BAR("CNT",BARREAS))+1
.S BAR("AMT",BARREAS)=+$G(BAR("AMT",BARREAS))+BARCRDEB
.S Y=BARTRDT X ^DD("DD") S BAREXDT=Y
.W !,BARBILL_U_BAREXDT_U_BARAPPTO_U_BARREAS_U_BARENTBY_U_BARCRDEB_U_$E(BARTRNTP,1,15)_U_$E(BARADJC,1,10)_U_BARCBTCH_U_BARCITEM_U_BARIPAC_U_BARVTYP
S BARREAS=""
N BAREDESC
;4/10/2010/SD/AR requirement 10021
W !!,"Count of entries in Not Sent bucket:"
F S BARREAS=$O(BAR("CNT",BARREAS)) Q:BARREAS="" D
.W !?5,"Error #",BARREAS," had ",$P($G(BAR("CNT",BARREAS)),U)," entries for ",$J($G(BAR("AMT",BARREAS)),".",2)
W !
F S BARREAS=$O(BAR("CNT",BARREAS)) Q:BARREAS="" D
.S BAREDESC=$$GET1^DIQ(90057.1,BARREAS_",",.04)
.W !,BARREAS," - ",BAREDESC
;4/10/2010/SD/AR requirement 10021
Q
;
NOTDET ;EP -
W "A/R BILL^TRAN. DATE^APPLY TO^REASON NOT SENT^ENTRY BY^CREDIT-DEBIT^TRANTYPE^ADJCAT^COLLECTION BATCH^COLLECTION ITEM^TREASURY DEPOSIT/IPAC^VISIT TYPE"
Q
BARUFRP2 ; IHS/SD/TPF - UFMS DS,NS, TRANSACTION REPORTS ; 02/29/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,6,14,18**;OCT 22,2008
+2 ;
+3 ;NEW ROUTINE ;;BAR*1.8*4 DD ITEM
+4 ;IHS/SD/TMM ;;BAR*1.8*14 M1 09/02/09 IGNORE FLAG was still printing on NS Report
+5 ;--------------------------------------------------------------------------------
+6 QUIT
+7 ;THIS ROUTINE IS CALLED BY OPTION [BAR UFMS RPT 'NOT SENT' REPORT
+8 ;
NOTSENT ;EP;
+1 NEW BARTRDT,BARLINE,BARNOW,BARDELDT,BARCRDEB,BARBILL,BARBIEN,BARENTBY,BARTPIEN,BARTRNTP,BARADJC
+2 NEW BARREAS
+3 ;
ASKFROM ;EP - ASK FROM DATE
+1 KILL %DT
+2 SET %DT="AET"
+3 SET %DT("A")="Enter beginning transaction date: "
+4 WRITE !
+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 KILL %DT
+2 SET %DT="AET"
+3 SET %DT("A")="Enter ending transaction date: "
+4 WRITE !
+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
+10 ;
ASKDEV ;EP - ASK DEVICE
+1 SET %ZIS="MQ"
+2 WRITE !
+3 DO ^%ZIS
+4 IF POP
QUIT
+5 IF $DATA(IO("Q"))
DO QUE
QUIT
+6 USE IO
+7 DO PRINT
+8 DO ^%ZISC
+9 QUIT
QUE ; EP - QUE 'NOT SENT' OR 'DELAY SEND' REPORT
+1 SET ZTRTN="PRINT^BARUFRP2"
+2 SET ZTDESC="NOT SENT TRANSACTION REPORT"
+3 SET ZTSAVE("XREF")=""
+4 SET ZTSAVE("BARTO")=""
+5 SET ZTSAVE("BARFROM")=""
+6 DO ^%ZTLOAD
+7 IF $DATA(ZTSK)[0
WRITE !!?5,"Report Cancelled!"
+8 IF '$TEST
WRITE !!?5,"Report task #: ",$GET(ZTSK)
+9 DO HOME^%ZIS
+10 QUIT
PRINT ;EP - ENTRY POINT FOR REPORT
+1 KILL BAR("CNT")
+2 KILL BAR("AMT")
+3 SET $PIECE(BARLINE,"-",81)=""
+4 DO NOW^%DTC
+5 SET Y=%
XECUTE ^DD("DD")
SET BARNOW=Y
+6 SET BARNOW=Y
+7 DO NOTDET
+8 SET BARESC=0
+9 SET BARTO=BARTO_"."_999999
+10 SET BARTRDT=BARFROM-.000001
+11 FOR
SET BARTRDT=$ORDER(^BARSESS(DUZ(2),"NS",BARTRDT))
IF 'BARTRDT!(BARESC)!(BARTRDT>BARTO)
QUIT
Begin DoDot:1
+12 SET BARSESID=$ORDER(^BARSESS(DUZ(2),"NS",BARTRDT,""))
+13 SET BARUDUZ=$ORDER(^BARSESS(DUZ(2),"NS",BARTRDT,BARSESID,""))
+14 ; ***BEGIN M1*** ;TMM M1 09/02/09
+15 ; Quit if IGNORE FLAG="I" ;TMM M1 09/02/09
+16 ;TMM M1 09/02/09
SET BARIFLG=$PIECE($GET(^BARTR(DUZ(2),BARTRDT,1)),U,12)
+17 ;TMM M1 09/02/09
IF (BARIFLG="I")!(BARIFLG="-I")
QUIT
+18 ; ***END M1*** ;TMM M1 09/02/09
+19 SET BARAPPTO=$PIECE($GET(^BARSESS(DUZ(2),BARUDUZ,11,BARSESID,2,BARTRDT,0)),U,5)
+20 SET BARBIEN=$PIECE($GET(^BARTR(DUZ(2),BARTRDT,0)),U,4)
+21 IF BARBIEN=""
QUIT
+22 SET BARBILL=$PIECE($GET(^BARBL(DUZ(2),BARBIEN,0)),U)
+23 SET BARCBTCH=$PIECE($GET(^BARTR(DUZ(2),BARTRDT,0)),U,14)
+24 SET BARCITEM=$PIECE($GET(^BARTR(DUZ(2),BARTRDT,0)),U,15)
+25 SET BARIPAC=""
+26 IF BARCBTCH'=""
IF (BARCITEM'="")
Begin DoDot:2
+27 ;S BARIPAC=$P($G(^BARCOL(DUZ(2),BARCBTCH,1,BARCITEM,0)),U,20) ;bar*1.8*6
+28 ;bar*1.8*6
SET BARIPAC=$$GET1^DIQ(90051.1101,BARCITEM_","_BARCBTCH_",",20,"E")
+29 SET BARCBTCH=$PIECE($GET(^BARCOL(DUZ(2),BARCBTCH,0)),U)
End DoDot:2
+30 SET BARENTBY=$$GET1^DIQ(90050.03,BARTRDT_",",13,"E")
+31 SET BARTPIEN=$PIECE($GET(^BARBL(DUZ(2),BARBIEN,0)),U,17)
+32 SET BARTPDUZ=$PIECE($GET(^BARBL(DUZ(2),BARBIEN,0)),U,22)
+33 SET BARVTYP=$PIECE($GET(^BARBL(DUZ(2),BARBIEN,1)),U,14)
+34 SET BARTRNTP=$$GET1^DIQ(90050.03,BARTRDT_",",101,"E")
+35 SET BARADJC=$$GET1^DIQ(90050.03,BARTRDT_",",102,"E")
+36 SET BARREAS=$PIECE($GET(^BARSESS(DUZ(2),BARUDUZ,11,BARSESID,2,BARTRDT,0)),U,9)
+37 SET BARCRDEB=$$GET1^DIQ(90050.03,BARTRDT_",",3.5)
+38 ;1/29/2007 TPF ADDED BECAUSE OF NULL FOUND
IF BARREAS=""
SET BARREAS="NULL"
+39 SET BAR("CNT",BARREAS)=+$GET(BAR("CNT",BARREAS))+1
+40 SET BAR("AMT",BARREAS)=+$GET(BAR("AMT",BARREAS))+BARCRDEB
+41 SET Y=BARTRDT
XECUTE ^DD("DD")
SET BAREXDT=Y
+42 WRITE !,BARBILL_U_BAREXDT_U_BARAPPTO_U_BARREAS_U_BARENTBY_U_BARCRDEB_U_$EXTRACT(BARTRNTP,1,15)_U_$EXTRACT(BARADJC,1,10)_U_BARCBTCH_U_BARCITEM_U_BARIPAC_U_BARVTYP
End DoDot:1
+43 SET BARREAS=""
+44 NEW BAREDESC
+45 ;4/10/2010/SD/AR requirement 10021
+46 WRITE !!,"Count of entries in Not Sent bucket:"
+47 FOR
SET BARREAS=$ORDER(BAR("CNT",BARREAS))
IF BARREAS=""
QUIT
Begin DoDot:1
+48 WRITE !?5,"Error #",BARREAS," had ",$PIECE($GET(BAR("CNT",BARREAS)),U)," entries for ",$JUSTIFY($GET(BAR("AMT",BARREAS)),".",2)
End DoDot:1
+49 WRITE !
+50 FOR
SET BARREAS=$ORDER(BAR("CNT",BARREAS))
IF BARREAS=""
QUIT
Begin DoDot:1
+51 SET BAREDESC=$$GET1^DIQ(90057.1,BARREAS_",",.04)
+52 WRITE !,BARREAS," - ",BAREDESC
End DoDot:1
+53 ;4/10/2010/SD/AR requirement 10021
+54 QUIT
+55 ;
NOTDET ;EP -
+1 WRITE "A/R BILL^TRAN. DATE^APPLY TO^REASON NOT SENT^ENTRY BY^CREDIT-DEBIT^TRANTYPE^ADJCAT^COLLECTION BATCH^COLLECTION ITEM^TREASURY DEPOSIT/IPAC^VISIT TYPE"
+2 QUIT
