BARCLRG ; IHS/SD/LSL - COLLECTION REGISTERS RPTS MAY 30,1996 ; 04/11/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**4,20**;OCT 26, 2005
;
; IHS/SD/LSL - 05/08/2002 - V1.6 Patch 2 - NOIS HQW-0302-100189
; Modified code to use new header template for REPRINT.
;
; IHS/SD/LSL - 10/15/02 - V1.7 - HQW-0302-100169
; Modified so that cannot reprint a batch that has not been finalized,
; and that reprinting the batch won't automatically finalize.
;
; IHS/SD/AML - 12/09/10 - V1.8 P20
; Modified to allow the batch Date Finalized (.25) and User
; Finalized (.26) to be stored when batch is finalized.
; *********************************************************************
;
START ;**EP-Collections report using FM print
;
DT ;EP - DETAIL REPORT
W $$EN^BARVDF("IOF")
D ^BARBAN
W !!
S BARSEL="D"
D D
G:$D(BAREFLG) END
D PRINT
D EOP^BARUTL(1)
Q
; *********************************************************************
;
EX ;EP - EXCEPTIONS
S BARFINS="E"
D E
G:$D(BAREFLG) END
D PRINT
D EOP^BARUTL(1)
Q
; *********************************************************************
;
FL ;EP - FINAL REPORT
S BARREPRT=0
S BARSEL="F"
D F
G:$D(BAREFLG) END
D PRINT
D EOP^BARUTL(1)
Q
; *********************************************************************
;
REP ;EP - REPRINT FINAL REPORT
S BARSEL="F"
S BARREPRT=1
D R
G:$D(BAREFLG) END
D PRINT
D EOP^BARUTL(1)
Q
; *********************************************************************
;
END Q
; *********************************************************************
;
LOOKUP ;
; **Collection Register name lookup
K DUOUT,DTOUT,BAREFLG
S DIC="90051.01"
S DIC(0)="AEMQZ"
D ^DIC
K DIC
S:Y<0 BAREFLG=1
S:$D(DUOUT) BAREFLG=1
S:$D(DTOUT) BAREFLG=1
I $D(BAREFLG) Q
I Y>0 D
. S BARBATCH=+Y
. S BARBEX=$P(Y(0),U)
Q
; *********************************************************************
;
PRINT ;EP **Print
;
S DIC="90051.01"
S L=0
I $D(BARBEX) D
. S FR=BARBEX
. S TO=BARBEX
S FR=FR_",,"
S TO=TO_",,"
D EN1^DIP
D ^%ZISC,HOME^%ZIS
Q
; *********************************************************************
;
D ;**Detail
S DIC("S")="I $$VAL^XBDIQ1(90051.01,+Y,3)'[""POST"""
D LOOKUP
Q:$D(BAREFLG)
D2 ;EP ;IHS/SD/SDR bar*1.8*4 DD item 4.1.5.1 added line tag
D DTEND
S DHD="[BAR CRH DET]"
S FLDS="[BAR CR DET]"
S BY="[BAR CRS DT]"
S DIOEND="I $E(IOST)=""C"" D DTEND^BARCLRG"
Q
; *********************************************************************
;
F ;**Final
I BARREPRT=0 S DIC("S")="I $$VAL^XBDIQ1(90051.01,+Y,3)'[""POST"""
D LOOKUP
Q:$D(BAREFLG)
;start new code IHS/SD/SDR bar*1.8*4 DD item 4.1.5.3
;get total of items
S BARITDA=0,BARITTOT=0
F S BARITDA=$O(^BARCOL(DUZ(2),BARBATCH,1,BARITDA)) Q:+BARITDA=0 D
.;no cancelled or rolled up items
.Q:$P($G(^BARCOL(DUZ(2),BARBATCH,1,BARITDA,0)),U,17)="R"
.Q:$P($G(^BARCOL(DUZ(2),BARBATCH,1,BARITDA,0)),U,17)="C"
.S BARITTOT=+$G(BARITTOT)+$P($G(^BARCOL(DUZ(2),BARBATCH,1,BARITDA,1)),U)
S BARATDN=$P($G(^BAR(90051.02,DUZ(2),$P($G(^BARCOL(DUZ(2),BARBATCH,0)),U,2),0)),U,22)
I $G(BARATDN)=1,(+$P($G(^BARCOL(DUZ(2),BARBATCH,0)),U,29)'=(+BARITTOT)) D Q
.W !!,"The batch total of $",$FN($P($G(^BARCOL(DUZ(2),BARBATCH,0)),U,29),",",2)," doesn't equal the items total of $",$FN(BARITTOT,",",2),"."
.W !,"Either add item(s) or edit the batch amount to balance. Batch can not be"
.W !,"finalized until these balance."
.S BAREFLG=1
.W ! K DIR S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
I $G(BARATDN)=1,(+$P($G(^BARCOL(DUZ(2),BARBATCH,0)),U,29)=(+BARITTOT)) W !!,"The batch total and the items total balance at $",$FN(BARITTOT,",",2)," for TDN ",$P($G(^BARCOL(DUZ(2),BARBATCH,0)),U,28),".",!
;end new code IHS/SD/SDR bar*1.8*4 DD item 4.1.5.3
I BARREPRT=0 D
.K DIR S DIR(0)="Y"
.S DIR("A")="ARE YOU SURE YOU WANT TO FINALIZE THIS BATCH"
.S DIR("B")="NO"
.D ^DIR
.K DIR
.I Y="0" S BAREFLG=1 Q
I $G(BAREFLG)=1 Q
S DHD="[BAR CRH FIN]"
S:BARREPRT=1 DHD="[BAR CRH RPRNT FIN]"
S BY="[BAR CRS FIN]"
S FLDS="[BAR CR FIN]"
S DIOEND="D FLEND^BARCLRG"
Q
; *********************************************************************
;
R ;**Reprint Final
S DIC("S")="I $$VAL^XBDIQ1(90051.01,+Y,3)[""POST"""
D LOOKUP
Q:$D(BAREFLG)
S DHD="[BAR CRH RPRNT FIN]"
S BY="[BAR CRS FIN]"
S FLDS="[BAR CR FIN]"
S DIOEND="D FLEND^BARCLRG"
Q
; *********************************************************************
;
E ;**Exceptions
D LOOKUP
Q:$D(BAREFLG)
S DHD="[BAR CRH EXC]"
S BY="[BAR CRS EXC]"
S FLDS="[BAR CR EXC]"
Q
; *********************************************************************
;
FLEND ;**End of Final Report -- Summary Page and Postable Batch Status
D EOP^BARUTL(1)
I $Y+20>IOSL W $$EN^BARVDF("IOF")
W !!,"DATE:"
I BARREPRT=1 W ?25,"COLLECTIONS REPORT -- FINAL (REPRINT)"
E W ?25,"COLLECTIONS REPORT -- FINAL"
W ?70,"SUMMARY"
W !,$$MDT2^BARDUTL(DT)
W !!!,"Collections listed above for Batch: "
W $$VAL^XBDIQ1(90051.01,BARBATCH,.01),!,"totaling: "
W $J($FN($$GET1^DIQ(90051.01,BARBATCH,15),",",2),10)
W " are transmitted herewith for appropriate action."
W !!,?50,$P(^VA(200,DUZ,0),U)
W !,?50,$$VAL^XBDIQ1(200,DUZ,29)
W !,?50,$P(^DIC(4,DUZ(2),0),U)
W !!!,"RECEIPT FOR $ ________________ IS HEREBY ACKNOWLEDGED."
W !!!,?55,"___________________",!,?55,"FINANCIAL MANAGEMENT"
I BARREPRT=0 D
. S DIE="90051.01"
. S DA=BARBATCH
. ;S DR="3///POSTABLE" ;IHS/SD/AML 12/9/2010 bar*1.8*20 - Populates the Finalized Date & User
. S DR="3///POSTABLE;25///NOW;26///^S X=DUZ" ;IHS/SD/AML bar*1.8*20 - Populates the Finalized Date & User
. S DIDEL=90050
. D ^DIE
. K DIDEL
I BARREPRT=0 D EN^BARCBTR(BARBATCH)
Q
; *********************************************************************
;
DTEND ;
;**Detail end -- ask if batch is to be made Postable
S BARSTAT=$$VAL^XBDIQ1(90051.01,BARBATCH,3)
I BARSTAT="POSTABLE" W !,"This Batch already in Postable Status!"
I BARSTAT="REVIEW" W !,"This Batch already in Review Status!"
I BARSTAT="OPEN" D STATUS
Q
; *********************************************************************
;
STATUS ;
K DIR
S DIR(0)="Y"
S DIR("A")="DO YOU WISH TO PUT THIS BATCH IN REVIEW STATUS"
S DIR("B")="NO"
D ^DIR
K DIR
I Y="1" D
.S DIE="90051.01"
.S DA=BARBATCH
.S DR="3///REVIEW"
.S DIDEL=90050
.D ^DIE
.K DIDEL
Q
BARCLRG ; IHS/SD/LSL - COLLECTION REGISTERS RPTS MAY 30,1996 ; 04/11/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,20**;OCT 26, 2005
+2 ;
+3 ; IHS/SD/LSL - 05/08/2002 - V1.6 Patch 2 - NOIS HQW-0302-100189
+4 ; Modified code to use new header template for REPRINT.
+5 ;
+6 ; IHS/SD/LSL - 10/15/02 - V1.7 - HQW-0302-100169
+7 ; Modified so that cannot reprint a batch that has not been finalized,
+8 ; and that reprinting the batch won't automatically finalize.
+9 ;
+10 ; IHS/SD/AML - 12/09/10 - V1.8 P20
+11 ; Modified to allow the batch Date Finalized (.25) and User
+12 ; Finalized (.26) to be stored when batch is finalized.
+13 ; *********************************************************************
+14 ;
START ;**EP-Collections report using FM print
+1 ;
DT ;EP - DETAIL REPORT
+1 WRITE $$EN^BARVDF("IOF")
+2 DO ^BARBAN
+3 WRITE !!
+4 SET BARSEL="D"
+5 DO D
+6 IF $DATA(BAREFLG)
GOTO END
+7 DO PRINT
+8 DO EOP^BARUTL(1)
+9 QUIT
+10 ; *********************************************************************
+11 ;
EX ;EP - EXCEPTIONS
+1 SET BARFINS="E"
+2 DO E
+3 IF $DATA(BAREFLG)
GOTO END
+4 DO PRINT
+5 DO EOP^BARUTL(1)
+6 QUIT
+7 ; *********************************************************************
+8 ;
FL ;EP - FINAL REPORT
+1 SET BARREPRT=0
+2 SET BARSEL="F"
+3 DO F
+4 IF $DATA(BAREFLG)
GOTO END
+5 DO PRINT
+6 DO EOP^BARUTL(1)
+7 QUIT
+8 ; *********************************************************************
+9 ;
REP ;EP - REPRINT FINAL REPORT
+1 SET BARSEL="F"
+2 SET BARREPRT=1
+3 DO R
+4 IF $DATA(BAREFLG)
GOTO END
+5 DO PRINT
+6 DO EOP^BARUTL(1)
+7 QUIT
+8 ; *********************************************************************
+9 ;
END QUIT
+1 ; *********************************************************************
+2 ;
LOOKUP ;
+1 ; **Collection Register name lookup
+2 KILL DUOUT,DTOUT,BAREFLG
+3 SET DIC="90051.01"
+4 SET DIC(0)="AEMQZ"
+5 DO ^DIC
+6 KILL DIC
+7 IF Y<0
SET BAREFLG=1
+8 IF $DATA(DUOUT)
SET BAREFLG=1
+9 IF $DATA(DTOUT)
SET BAREFLG=1
+10 IF $DATA(BAREFLG)
QUIT
+11 IF Y>0
Begin DoDot:1
+12 SET BARBATCH=+Y
+13 SET BARBEX=$PIECE(Y(0),U)
End DoDot:1
+14 QUIT
+15 ; *********************************************************************
+16 ;
PRINT ;EP **Print
+1 ;
+2 SET DIC="90051.01"
+3 SET L=0
+4 IF $DATA(BARBEX)
Begin DoDot:1
+5 SET FR=BARBEX
+6 SET TO=BARBEX
End DoDot:1
+7 SET FR=FR_",,"
+8 SET TO=TO_",,"
+9 DO EN1^DIP
+10 DO ^%ZISC
DO HOME^%ZIS
+11 QUIT
+12 ; *********************************************************************
+13 ;
D ;**Detail
+1 SET DIC("S")="I $$VAL^XBDIQ1(90051.01,+Y,3)'[""POST"""
+2 DO LOOKUP
+3 IF $DATA(BAREFLG)
QUIT
D2 ;EP ;IHS/SD/SDR bar*1.8*4 DD item 4.1.5.1 added line tag
+1 DO DTEND
+2 SET DHD="[BAR CRH DET]"
+3 SET FLDS="[BAR CR DET]"
+4 SET BY="[BAR CRS DT]"
+5 SET DIOEND="I $E(IOST)=""C"" D DTEND^BARCLRG"
+6 QUIT
+7 ; *********************************************************************
+8 ;
F ;**Final
+1 IF BARREPRT=0
SET DIC("S")="I $$VAL^XBDIQ1(90051.01,+Y,3)'[""POST"""
+2 DO LOOKUP
+3 IF $DATA(BAREFLG)
QUIT
+4 ;start new code IHS/SD/SDR bar*1.8*4 DD item 4.1.5.3
+5 ;get total of items
+6 SET BARITDA=0
SET BARITTOT=0
+7 FOR
SET BARITDA=$ORDER(^BARCOL(DUZ(2),BARBATCH,1,BARITDA))
IF +BARITDA=0
QUIT
Begin DoDot:1
+8 ;no cancelled or rolled up items
+9 IF $PIECE($GET(^BARCOL(DUZ(2),BARBATCH,1,BARITDA,0)),U,17)="R"
QUIT
+10 IF $PIECE($GET(^BARCOL(DUZ(2),BARBATCH,1,BARITDA,0)),U,17)="C"
QUIT
+11 SET BARITTOT=+$GET(BARITTOT)+$PIECE($GET(^BARCOL(DUZ(2),BARBATCH,1,BARITDA,1)),U)
End DoDot:1
+12 SET BARATDN=$PIECE($GET(^BAR(90051.02,DUZ(2),$PIECE($GET(^BARCOL(DUZ(2),BARBATCH,0)),U,2),0)),U,22)
+13 IF $GET(BARATDN)=1
IF (+$PIECE($GET(^BARCOL(DUZ(2),BARBATCH,0)),U,29)'=(+BARITTOT))
Begin DoDot:1
+14 WRITE !!,"The batch total of $",$FNUMBER($PIECE($GET(^BARCOL(DUZ(2),BARBATCH,0)),U,29),",",2)," doesn't equal the items total of $",$FNUMBER(BARITTOT,",",2),"."
+15 WRITE !,"Either add item(s) or edit the batch amount to balance. Batch can not be"
+16 WRITE !,"finalized until these balance."
+17 SET BAREFLG=1
+18 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+19 IF $GET(BARATDN)=1
IF (+$PIECE($GET(^BARCOL(DUZ(2),BARBATCH,0)),U,29)=(+BARITTOT))
WRITE !!,"The batch total and the items total balance at $",$FNUMBER(BARITTOT,",",2)," for TDN ",$PIECE($GET(^BARCOL(DUZ(2),BARBATCH,0)),U,28),".",!
+20 ;end new code IHS/SD/SDR bar*1.8*4 DD item 4.1.5.3
+21 IF BARREPRT=0
Begin DoDot:1
+22 KILL DIR
SET DIR(0)="Y"
+23 SET DIR("A")="ARE YOU SURE YOU WANT TO FINALIZE THIS BATCH"
+24 SET DIR("B")="NO"
+25 DO ^DIR
+26 KILL DIR
+27 IF Y="0"
SET BAREFLG=1
QUIT
End DoDot:1
+28 IF $GET(BAREFLG)=1
QUIT
+29 SET DHD="[BAR CRH FIN]"
+30 IF BARREPRT=1
SET DHD="[BAR CRH RPRNT FIN]"
+31 SET BY="[BAR CRS FIN]"
+32 SET FLDS="[BAR CR FIN]"
+33 SET DIOEND="D FLEND^BARCLRG"
+34 QUIT
+35 ; *********************************************************************
+36 ;
R ;**Reprint Final
+1 SET DIC("S")="I $$VAL^XBDIQ1(90051.01,+Y,3)[""POST"""
+2 DO LOOKUP
+3 IF $DATA(BAREFLG)
QUIT
+4 SET DHD="[BAR CRH RPRNT FIN]"
+5 SET BY="[BAR CRS FIN]"
+6 SET FLDS="[BAR CR FIN]"
+7 SET DIOEND="D FLEND^BARCLRG"
+8 QUIT
+9 ; *********************************************************************
+10 ;
E ;**Exceptions
+1 DO LOOKUP
+2 IF $DATA(BAREFLG)
QUIT
+3 SET DHD="[BAR CRH EXC]"
+4 SET BY="[BAR CRS EXC]"
+5 SET FLDS="[BAR CR EXC]"
+6 QUIT
+7 ; *********************************************************************
+8 ;
FLEND ;**End of Final Report -- Summary Page and Postable Batch Status
+1 DO EOP^BARUTL(1)
+2 IF $Y+20>IOSL
WRITE $$EN^BARVDF("IOF")
+3 WRITE !!,"DATE:"
+4 IF BARREPRT=1
WRITE ?25,"COLLECTIONS REPORT -- FINAL (REPRINT)"
+5 IF '$TEST
WRITE ?25,"COLLECTIONS REPORT -- FINAL"
+6 WRITE ?70,"SUMMARY"
+7 WRITE !,$$MDT2^BARDUTL(DT)
+8 WRITE !!!,"Collections listed above for Batch: "
+9 WRITE $$VAL^XBDIQ1(90051.01,BARBATCH,.01),!,"totaling: "
+10 WRITE $JUSTIFY($FNUMBER($$GET1^DIQ(90051.01,BARBATCH,15),",",2),10)
+11 WRITE " are transmitted herewith for appropriate action."
+12 WRITE !!,?50,$PIECE(^VA(200,DUZ,0),U)
+13 WRITE !,?50,$$VAL^XBDIQ1(200,DUZ,29)
+14 WRITE !,?50,$PIECE(^DIC(4,DUZ(2),0),U)
+15 WRITE !!!,"RECEIPT FOR $ ________________ IS HEREBY ACKNOWLEDGED."
+16 WRITE !!!,?55,"___________________",!,?55,"FINANCIAL MANAGEMENT"
+17 IF BARREPRT=0
Begin DoDot:1
+18 SET DIE="90051.01"
+19 SET DA=BARBATCH
+20 ;S DR="3///POSTABLE" ;IHS/SD/AML 12/9/2010 bar*1.8*20 - Populates the Finalized Date & User
+21 ;IHS/SD/AML bar*1.8*20 - Populates the Finalized Date & User
SET DR="3///POSTABLE;25///NOW;26///^S X=DUZ"
+22 SET DIDEL=90050
+23 DO ^DIE
+24 KILL DIDEL
End DoDot:1
+25 IF BARREPRT=0
DO EN^BARCBTR(BARBATCH)
+26 QUIT
+27 ; *********************************************************************
+28 ;
DTEND ;
+1 ;**Detail end -- ask if batch is to be made Postable
+2 SET BARSTAT=$$VAL^XBDIQ1(90051.01,BARBATCH,3)
+3 IF BARSTAT="POSTABLE"
WRITE !,"This Batch already in Postable Status!"
+4 IF BARSTAT="REVIEW"
WRITE !,"This Batch already in Review Status!"
+5 IF BARSTAT="OPEN"
DO STATUS
+6 QUIT
+7 ; *********************************************************************
+8 ;
STATUS ;
+1 KILL DIR
+2 SET DIR(0)="Y"
+3 SET DIR("A")="DO YOU WISH TO PUT THIS BATCH IN REVIEW STATUS"
+4 SET DIR("B")="NO"
+5 DO ^DIR
+6 KILL DIR
+7 IF Y="1"
Begin DoDot:1
+8 SET DIE="90051.01"
+9 SET DA=BARBATCH
+10 SET DR="3///REVIEW"
+11 SET DIDEL=90050
+12 DO ^DIE
+13 KILL DIDEL
End DoDot:1
+14 QUIT
