BARBAD3 ; IHS/SD/LSL - PAYMENT COMMAND PROCESSOR ; 12/29/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,6,7,10,19,21,23**;OCT 26, 2005
;** 'Select Command' processor
; ********************************************************************
;P.OTTIS NOV 2012 FIXING GOTO IN DOTTED BLOCK HEAT# 86250
; APR 2013 NOHEAT CONDITIONAL DISPLAY OF TXD AND MESSSAGES
; NOV 2013 BETA P23: added lower to upper conversion after command input
; NOV 2013 BETA P23: added return to line selection if bill bal =0 11/26/2013
Q
EN ;EP - command processor
N BARCAM,BARCOAM ;FROM ASKCOM1
K DIR,^TEMP($J,"BARPOST"),BARTR
S (BARADJ,BARPMT)=0
S BARDFLT=""
W !!
; -------------------------------
EN1 ;
;K BARCOM,BARTYP,BARCAT,BARATYP,BARAMT,BARLIN
K BARCOM,BARTYP,BARCAT,BARATYP,BARAMT,BARLIN,REVERSAL,REVSCHED ;BAR*1.8*4
S BARDSP=1
D HIT1^BARBAD2(BARPASS)
; -------------------------------
EN2 ;
W !!
K BARCOM,BARAMT
D:$D(BARHLP)<10 SETHLP^BARBADU
; -------------------------------
ASKLIN ;
I $D(BARCOM(1)) D
. Q:BARCOM(1)="Q"
I BARCNT=1 S (BARLIN,BARDFLT)=1 G ASKCOM1
D ASKLIN^BARFPST3
I $G(BARLIN)["^" G FINISH
I $G(BARLIN)=0 G FINISH
I BARLIN>0,BARLIN<(BARCNT+1) G ASKCOM1
;
LNHLP ;
ASKCOM ;EP - select command
K BARCOM,BARTYP,BARCAT,BARATYP,BARAMT
S BARDSP=1
D HIT1^BARBAD2(BARPASS)
W !
; -------------------------------
ASKCOM1 ;
I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) Q ;IS SESSION STILL OPEN
;N BARCAM,BARCOAM
K REVERSAL,REVSCHED
W !,"Select Command (Line # "_BARLIN_") : "
;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
R BARCOM:DTIME
I BARCOM="" G EN1
S BARCOM=$$LU(BARCOM) ;11/07/2013
I (BARCOM["?") D COMHLP^BARBADU G ASKCOM1
I $D(BARTR(BARLIN,1))&(($G(BARCOM)="S")!($G(BARCOM)="V")!($G(BARCOM)="1")!($G(BARCOM)="2")) D G ASKCOM1 ;P.OTT
. W !,"A transaction already exists on this bill. You can cancel it."
. W !,"You can also edit the amount or adjustment type."
. D EOP^BARUTL(1)
. Q ;G ASKCOM1 ;
I ("S1V2"[BARCOM) D I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!($G(Y)=0) G ASKCOM
.S BARBLDA=$O(^BARTMP($J,"B",BARLIN,""))
.S BARTPB=$$FIND3PB^BARUTL(DUZ(2),BARBLDA)
.K DIROUT,DIRUT,DTOUT,DUOUT
.K DIR,DIE,DIC,X,Y,DA,DR
.Q:$G(BARTPB)=""
.S BARSTAT=$P($G(^ABMDBILL($P(BARTPB,","),$P(BARTPB,",",2),0)),U,4)
.Q:BARSTAT'="X"
.W !!,"STOP! 3P BILL ",$P($P($G(^BARBL(DUZ(2),BARBLDA,0)),U),"-")," has been cancelled."
.S DIR(0)="Y"
.S DIR("A")="Are you sure you want to post to this invoice"
.S DIR("B")="N"
.D ^DIR K DIR
S Q=0
F J=1:1 D Q:Q
.S BARCOM(J)=$P(BARCOM,",",J)
.Q:$L(BARCOM(J))
.K BARCOM(J)
.S J=J-1
.S Q=1 Q
I 'J!($L($G(BARCOM(1)))=0) G ASKCOM
I BARCOM(1)="1" S BARCOM(1)="S" W *7,*7,*7
I BARCOM(1)="2" S BARCOM(1)="V" W *7,*7,*7
I BARCOM(1)="3" S BARCOM(1)="Q" W *7,*7,*7
I BARCOM(1)="4" S BARCOM(1)="H" W *7,*7,*7
I BARCOM(1)="5" S BARCOM(1)="M" W *7,*7,*7
I BARCOM(1)="6" S BARCOM(1)="T" W *7,*7,*7
I BARCOM(1)="7" S BARCOM(1)="B" W *7,*7,*7
I BARCOM(1)="8" S BARCOM(1)="E" W *7,*7,*7
G:'("SVBHMTQE"[BARCOM(1)) COMHLP
I "SV"[BARCOM(1) D
. S BARCAM=0,BARCOAM=0
. S BARCAM=$$GET1^DIQ(90050.01,BARBLDA,15)
. S BARCOAM=$O(^BARBL(DUZ(2),BARBLDA,9,"AAA"),-1)
. S:$G(BARCOAM) BARCOAM=$P(^BARBL(DUZ(2),BARBLDA,9,BARCOAM,0),U,4)
. S:'$G(BARCOAM) BARCOAM=0
I ($G(BARCOM(1))="S")&($G(BARCAM)'>0) D G ASKLIN ;COM1 ;11/26/2013
. W !,"The current balance on this bill 0. There is nothing to put into collections."
. D EOP^BARUTL(1)
. ;S BARCOM(1)="Q"
I ($G(BARCOM(1))="V")&($G(BARCOAM)'>0) D G ASKLIN ;COM1 ;11/26/2013
. W !,"There isn't an amount in collections to take out of collections."
. D EOP^BARUTL(1)
. ;S BARCOM(1)="Q"
I J=1,BARCOM(1)="T" D G ASKCOM
.S Y=$$DSPLY^BARBAD4(BARLIN)
.D EOP^BARUTL(1)
I J=1,BARCOM(1)="M" D G ASKCOM
.N DA,DIC,BARBLDA,BARACC
.S BARBLDA=$O(^BARTMP($J,"B",BARLIN,""))
.S BARACC=$$GET1^DIQ(90050.01,BARBLDA,3,"I")
.D EN^BARBAD6(BARPAT,BARBLDA,BARACC)
.Q
I J=1,BARCOM(1)="H" D HISTORY G ASKCOM ;P.OTT
;.S BARBLDA=$O(^BARTMP($J,"B",BARLIN,""))
;.D EN^BARBAD5(BARBLDA)
G:"SV"[BARCOM(1) GOSR
; -------------------------------
GOQ ;
I J=1,BARCOM(J)="Q" D G:BARCNT>1 EN1 G FINISH
.D CKNEG(BARLIN)
GOSR ;
I (J=1)&((BARCOM(J)="S")!(BARCOM(J)="V")) S BARTYP="A" G ASKAMT
I J=1,BARCOM(J)="E" G ^BARBAD4
GOB ;
I (J=1)&(BARCOM(1)="B") D G ASKCOM
. S BARBLDA=$O(^BARTMP($J,"B",BARLIN,""))
. D DIQ^XBLM(90050.01,BARBLDA)
W *7,!," Sorry.. ["_BARHLP(BARCOM(1))_"] not active!"
D EOP^BARUTL(1)
G ASKCOM
; *********************************************************************
COMHLP ;
D COMHLP^BARBADU
G ASKCOM1
; *********************************************************************
CKNEG(LIN) ;EP; CHECK FOR NEGATIVE BALANCE ;BAR*1.8*4 DD 4.1.7.2
Q:'$$IHS^BARUFUT(DUZ(2)) ;IGNORE NON-IHS
;;;Q:'$$IHSERA^BARUFUT(DUZ(2)) ;IGNORE NON-IHS AND TRIBAL WITH RESTRICTION FLAG ON
N BARDA,BARB
REDO S BARDA=$O(^BARTMP($J,"B",LIN,""))
S BARB=$P(^BARTMP($J,BARDA,LIN),U,5)
Q
FINISH ;
I '$G(BARPMT)&('$G(BARADJ))&('$D(BARROLL))&'$D(BARTR) D CANCEL Q
; enable posting rollback
FIN ;
S BARQ=$$POST()
I BARQ="M" G EN1
I BARQ="C" D CANCEL Q
I BARQ="P" D POSTTX^BARBADU
;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) Q ;IS SESSION STILL OPEN
I $G(BARSTOP)=1 G FIN
K ^BARTMP($J)
Q
;--------------------------------
ASKAMT ;
S (BARCAT,BARATYP)=""
W:BARCOM(1)="S" !,"Amount is added to Sent to Collections amount and deducted from Current Balance."
W:BARCOM(1)="V" !,"Amount is added to Current Balance and deducted from Sent to Collections amount."
S BARASK=$S(BARCOM(1)="S":"STATUS ",BARCOM(1)="V":"REVERSE STATUS ",1:"")_"Amount: "
;W !,BARASK R X:DTIME
K DIR
S DIR(0)="FAO"
S DIR("A")=BARASK
S DIR("T")=DTIME
D ^DIR
K DIR
S X=$$AMT^BARPSTU(X)
I X="^" G ASKCOM
I X="?" W *7," Must be a valid number!" G ASKAMT
S BARAMT=X
I (BARAMT'>0) D G:BARAMT'>0 ASKAMT
. W !,"You must enter a value larger than 0."
. D EOP^BARUTL(1)
. Q
I ($G(BARCOM(1))="S")&(BARAMT>BARCAM) D G:($G(BARCOM(1))="S")&(BARAMT>BARCAM) ASKAMT
. W !,"You can't place more than the current bill amount in collections."
. D EOP^BARUTL(1)
. Q
I ($G(BARCOM(1))="V")&(BARAMT>BARCOAM) D G:($G(BARCOM(1))="V")&(BARAMT>BARCOAM) ASKAMT
. W !,"You can't reverse from collections more than what's in there."
. D EOP^BARUTL(1)
. Q
S BARCAT=$O(^BAR(90052.01,"B","SENT TO COLLECTIONS",""))
;
;** adjustment category/type dialog
S BARX=0,BARJ=0
K BARATYP
F S BARX=$O(^BARTBL("D",BARCAT,BARX)) Q:'BARX D Q:BARJ>1
.S BARJ=BARJ+1
.Q:BARJ>1
.S BARATYP=BARX
S DIC=90052.02
S DIC(0)="AEMNQZ"
S DIC("A")="Select Adjustment Type: "
S DIC("S")="I $P(^(0),U,2)=BARCAT"
K DD,DO
D ^DIC
K DIC
I +Y<0 K BARAMT W *7,!! G ASKAMT
S BARATYP=+Y
;--------------------------------
S1 ;
D SETTMP^BARBAD3A(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP,0,BARCOM(1))
G ASKCOM
CANCEL ;
K ^BARTMP($J)
K BARPMT,BARADJ,BARTR,BARROLL
Q
;
POST() ;
P1 ;
D HIT1^BARBAD2(BARPASS)
D EOP^BARUTL(2)
PDIR ;
;ENTER CODE TO SHOW USER WHAT IS ABOUT TO HAPPEN
K DIR
S DIR(0)="SAO^P:POST TO A/R;M:MORE;C:CANCEL"
S DIR("A")="Select Action (P/M/C): "
D ^DIR
K DIR
I $D(DUOUT)!(Y="") W *7 G PDIR
Q Y
;***********************************
HISTORY ;P.OTT
S BARFLGRP=$$GETFLGRP() I BARFLGRP=U Q
S BARBLDA=$O(^BARTMP($J,"B",BARLIN,""))
D EN^BARPST5(BARBLDA)
Q
GETFLGRP() ;
;S BARFLGRP="N"
;S Y=$$DIR^XBDIR("S^T:Transaction number;M:Message(s);B:Both;N:None","Enter a viewing option","N","","","",1)
;S BARFLGRP="1"
;S Y=$$DIR^XBDIR("N^1:Transactions only;2:Messages only;3:T+M:Both","Enter a viewing option","1","","","",1)
;K DA
;Q:$D(DIRUT) "^"
;S BARFLGRP=Y
;Q BARFLGRP
;-----------------
K DIR,DA
S DIR(0)="SO^T:Add Transaction number to report;"
S DIR(0)=DIR(0)_"M:Add Bill Messages to report;"
S DIR(0)=DIR(0)_"B:Add both Transaction number and Bill Messages;"
S DIR(0)=DIR(0)_"N:Don't add Transaction number and Bill Messages;"
S DIR(0)=DIR(0)_"O:Show only Bill Messages;"
S DIR("A")="Enter a viewing option"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)!(Y="") U
S BARFLGRP=Y
Q BARFLGRP
;----------------
LU(X) ;
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
;EOR
BARBAD3 ; IHS/SD/LSL - PAYMENT COMMAND PROCESSOR ; 12/29/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,6,7,10,19,21,23**;OCT 26, 2005
+2 ;** 'Select Command' processor
+3 ; ********************************************************************
+4 ;P.OTTIS NOV 2012 FIXING GOTO IN DOTTED BLOCK HEAT# 86250
+5 ; APR 2013 NOHEAT CONDITIONAL DISPLAY OF TXD AND MESSSAGES
+6 ; NOV 2013 BETA P23: added lower to upper conversion after command input
+7 ; NOV 2013 BETA P23: added return to line selection if bill bal =0 11/26/2013
+8 QUIT
EN ;EP - command processor
+1 ;FROM ASKCOM1
NEW BARCAM,BARCOAM
+2 KILL DIR,^TEMP($JOB,"BARPOST"),BARTR
+3 SET (BARADJ,BARPMT)=0
+4 SET BARDFLT=""
+5 WRITE !!
+6 ; -------------------------------
EN1 ;
+1 ;K BARCOM,BARTYP,BARCAT,BARATYP,BARAMT,BARLIN
+2 ;BAR*1.8*4
KILL BARCOM,BARTYP,BARCAT,BARATYP,BARAMT,BARLIN,REVERSAL,REVSCHED
+3 SET BARDSP=1
+4 DO HIT1^BARBAD2(BARPASS)
+5 ; -------------------------------
EN2 ;
+1 WRITE !!
+2 KILL BARCOM,BARAMT
+3 IF $DATA(BARHLP)<10
DO SETHLP^BARBADU
+4 ; -------------------------------
ASKLIN ;
+1 IF $DATA(BARCOM(1))
Begin DoDot:1
+2 IF BARCOM(1)="Q"
QUIT
End DoDot:1
+3 IF BARCNT=1
SET (BARLIN,BARDFLT)=1
GOTO ASKCOM1
+4 DO ASKLIN^BARFPST3
+5 IF $GET(BARLIN)["^"
GOTO FINISH
+6 IF $GET(BARLIN)=0
GOTO FINISH
+7 IF BARLIN>0
IF BARLIN<(BARCNT+1)
GOTO ASKCOM1
+8 ;
LNHLP ;
ASKCOM ;EP - select command
+1 KILL BARCOM,BARTYP,BARCAT,BARATYP,BARAMT
+2 SET BARDSP=1
+3 DO HIT1^BARBAD2(BARPASS)
+4 WRITE !
+5 ; -------------------------------
ASKCOM1 ;
+1 ;IS SESSION STILL OPEN
IF $$NOTOPEN^BARUFUT(.DUZ,$GET(UFMSESID))
QUIT
+2 ;N BARCAM,BARCOAM
+3 KILL REVERSAL,REVSCHED
+4 WRITE !,"Select Command (Line # "_BARLIN_") : "
+5 ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
+6 READ BARCOM:DTIME
+7 IF BARCOM=""
GOTO EN1
+8 ;11/07/2013
SET BARCOM=$$LU(BARCOM)
+9 IF (BARCOM["?")
DO COMHLP^BARBADU
GOTO ASKCOM1
+10 ;P.OTT
IF $DATA(BARTR(BARLIN,1))&(($GET(BARCOM)="S")!($GET(BARCOM)="V")!($GET(BARCOM)="1")!($GET(BARCOM)="2"))
Begin DoDot:1
+11 WRITE !,"A transaction already exists on this bill. You can cancel it."
+12 WRITE !,"You can also edit the amount or adjustment type."
+13 DO EOP^BARUTL(1)
+14 ;G ASKCOM1 ;
QUIT
End DoDot:1
GOTO ASKCOM1
+15 IF ("S1V2"[BARCOM)
Begin DoDot:1
+16 SET BARBLDA=$ORDER(^BARTMP($JOB,"B",BARLIN,""))
+17 SET BARTPB=$$FIND3PB^BARUTL(DUZ(2),BARBLDA)
+18 KILL DIROUT,DIRUT,DTOUT,DUOUT
+19 KILL DIR,DIE,DIC,X,Y,DA,DR
+20 IF $GET(BARTPB)=""
QUIT
+21 SET BARSTAT=$PIECE($GET(^ABMDBILL($PIECE(BARTPB,","),$PIECE(BARTPB,",",2),0)),U,4)
+22 IF BARSTAT'="X"
QUIT
+23 WRITE !!,"STOP! 3P BILL ",$PIECE($PIECE($GET(^BARBL(DUZ(2),BARBLDA,0)),U),"-")," has been cancelled."
+24 SET DIR(0)="Y"
+25 SET DIR("A")="Are you sure you want to post to this invoice"
+26 SET DIR("B")="N"
+27 DO ^DIR
KILL DIR
End DoDot:1
IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!($GET(Y)=0)
GOTO ASKCOM
+28 SET Q=0
+29 FOR J=1:1
Begin DoDot:1
+30 SET BARCOM(J)=$PIECE(BARCOM,",",J)
+31 IF $LENGTH(BARCOM(J))
QUIT
+32 KILL BARCOM(J)
+33 SET J=J-1
+34 SET Q=1
QUIT
End DoDot:1
IF Q
QUIT
+35 IF 'J!($LENGTH($GET(BARCOM(1)))=0)
GOTO ASKCOM
+36 IF BARCOM(1)="1"
SET BARCOM(1)="S"
WRITE *7,*7,*7
+37 IF BARCOM(1)="2"
SET BARCOM(1)="V"
WRITE *7,*7,*7
+38 IF BARCOM(1)="3"
SET BARCOM(1)="Q"
WRITE *7,*7,*7
+39 IF BARCOM(1)="4"
SET BARCOM(1)="H"
WRITE *7,*7,*7
+40 IF BARCOM(1)="5"
SET BARCOM(1)="M"
WRITE *7,*7,*7
+41 IF BARCOM(1)="6"
SET BARCOM(1)="T"
WRITE *7,*7,*7
+42 IF BARCOM(1)="7"
SET BARCOM(1)="B"
WRITE *7,*7,*7
+43 IF BARCOM(1)="8"
SET BARCOM(1)="E"
WRITE *7,*7,*7
+44 IF '("SVBHMTQE"[BARCOM(1))
GOTO COMHLP
+45 IF "SV"[BARCOM(1)
Begin DoDot:1
+46 SET BARCAM=0
SET BARCOAM=0
+47 SET BARCAM=$$GET1^DIQ(90050.01,BARBLDA,15)
+48 SET BARCOAM=$ORDER(^BARBL(DUZ(2),BARBLDA,9,"AAA"),-1)
+49 IF $GET(BARCOAM)
SET BARCOAM=$PIECE(^BARBL(DUZ(2),BARBLDA,9,BARCOAM,0),U,4)
+50 IF '$GET(BARCOAM)
SET BARCOAM=0
End DoDot:1
+51 ;COM1 ;11/26/2013
IF ($GET(BARCOM(1))="S")&($GET(BARCAM)'>0)
Begin DoDot:1
+52 WRITE !,"The current balance on this bill 0. There is nothing to put into collections."
+53 DO EOP^BARUTL(1)
+54 ;S BARCOM(1)="Q"
End DoDot:1
GOTO ASKLIN
+55 ;COM1 ;11/26/2013
IF ($GET(BARCOM(1))="V")&($GET(BARCOAM)'>0)
Begin DoDot:1
+56 WRITE !,"There isn't an amount in collections to take out of collections."
+57 DO EOP^BARUTL(1)
+58 ;S BARCOM(1)="Q"
End DoDot:1
GOTO ASKLIN
+59 IF J=1
IF BARCOM(1)="T"
Begin DoDot:1
+60 SET Y=$$DSPLY^BARBAD4(BARLIN)
+61 DO EOP^BARUTL(1)
End DoDot:1
GOTO ASKCOM
+62 IF J=1
IF BARCOM(1)="M"
Begin DoDot:1
+63 NEW DA,DIC,BARBLDA,BARACC
+64 SET BARBLDA=$ORDER(^BARTMP($JOB,"B",BARLIN,""))
+65 SET BARACC=$$GET1^DIQ(90050.01,BARBLDA,3,"I")
+66 DO EN^BARBAD6(BARPAT,BARBLDA,BARACC)
+67 QUIT
End DoDot:1
GOTO ASKCOM
+68 ;P.OTT
IF J=1
IF BARCOM(1)="H"
DO HISTORY
GOTO ASKCOM
+69 ;.S BARBLDA=$O(^BARTMP($J,"B",BARLIN,""))
+70 ;.D EN^BARBAD5(BARBLDA)
+71 IF "SV"[BARCOM(1)
GOTO GOSR
+72 ; -------------------------------
GOQ ;
+1 IF J=1
IF BARCOM(J)="Q"
Begin DoDot:1
+2 DO CKNEG(BARLIN)
End DoDot:1
IF BARCNT>1
GOTO EN1
GOTO FINISH
GOSR ;
+1 IF (J=1)&((BARCOM(J)="S")!(BARCOM(J)="V"))
SET BARTYP="A"
GOTO ASKAMT
+2 IF J=1
IF BARCOM(J)="E"
GOTO ^BARBAD4
GOB ;
+1 IF (J=1)&(BARCOM(1)="B")
Begin DoDot:1
+2 SET BARBLDA=$ORDER(^BARTMP($JOB,"B",BARLIN,""))
+3 DO DIQ^XBLM(90050.01,BARBLDA)
End DoDot:1
GOTO ASKCOM
+4 WRITE *7,!," Sorry.. ["_BARHLP(BARCOM(1))_"] not active!"
+5 DO EOP^BARUTL(1)
+6 GOTO ASKCOM
+7 ; *********************************************************************
COMHLP ;
+1 DO COMHLP^BARBADU
+2 GOTO ASKCOM1
+3 ; *********************************************************************
CKNEG(LIN) ;EP; CHECK FOR NEGATIVE BALANCE ;BAR*1.8*4 DD 4.1.7.2
+1 ;IGNORE NON-IHS
IF '$$IHS^BARUFUT(DUZ(2))
QUIT
+2 ;;;Q:'$$IHSERA^BARUFUT(DUZ(2)) ;IGNORE NON-IHS AND TRIBAL WITH RESTRICTION FLAG ON
+3 NEW BARDA,BARB
REDO SET BARDA=$ORDER(^BARTMP($JOB,"B",LIN,""))
+1 SET BARB=$PIECE(^BARTMP($JOB,BARDA,LIN),U,5)
+2 QUIT
FINISH ;
+1 IF '$GET(BARPMT)&('$GET(BARADJ))&('$DATA(BARROLL))&'$DATA(BARTR)
DO CANCEL
QUIT
+2 ; enable posting rollback
FIN ;
+1 SET BARQ=$$POST()
+2 IF BARQ="M"
GOTO EN1
+3 IF BARQ="C"
DO CANCEL
QUIT
+4 IF BARQ="P"
DO POSTTX^BARBADU
+5 ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
+6 ;IS SESSION STILL OPEN
IF $$NOTOPEN^BARUFUT(.DUZ,$GET(UFMSESID))
QUIT
+7 IF $GET(BARSTOP)=1
GOTO FIN
+8 KILL ^BARTMP($JOB)
+9 QUIT
+10 ;--------------------------------
ASKAMT ;
+1 SET (BARCAT,BARATYP)=""
+2 IF BARCOM(1)="S"
WRITE !,"Amount is added to Sent to Collections amount and deducted from Current Balance."
+3 IF BARCOM(1)="V"
WRITE !,"Amount is added to Current Balance and deducted from Sent to Collections amount."
+4 SET BARASK=$SELECT(BARCOM(1)="S":"STATUS ",BARCOM(1)="V":"REVERSE STATUS ",1:"")_"Amount: "
+5 ;W !,BARASK R X:DTIME
+6 KILL DIR
+7 SET DIR(0)="FAO"
+8 SET DIR("A")=BARASK
+9 SET DIR("T")=DTIME
+10 DO ^DIR
+11 KILL DIR
+12 SET X=$$AMT^BARPSTU(X)
+13 IF X="^"
GOTO ASKCOM
+14 IF X="?"
WRITE *7," Must be a valid number!"
GOTO ASKAMT
+15 SET BARAMT=X
+16 IF (BARAMT'>0)
Begin DoDot:1
+17 WRITE !,"You must enter a value larger than 0."
+18 DO EOP^BARUTL(1)
+19 QUIT
End DoDot:1
IF BARAMT'>0
GOTO ASKAMT
+20 IF ($GET(BARCOM(1))="S")&(BARAMT>BARCAM)
Begin DoDot:1
+21 WRITE !,"You can't place more than the current bill amount in collections."
+22 DO EOP^BARUTL(1)
+23 QUIT
End DoDot:1
IF ($GET(BARCOM(1))="S")&(BARAMT>BARCAM)
GOTO ASKAMT
+24 IF ($GET(BARCOM(1))="V")&(BARAMT>BARCOAM)
Begin DoDot:1
+25 WRITE !,"You can't reverse from collections more than what's in there."
+26 DO EOP^BARUTL(1)
+27 QUIT
End DoDot:1
IF ($GET(BARCOM(1))="V")&(BARAMT>BARCOAM)
GOTO ASKAMT
+28 SET BARCAT=$ORDER(^BAR(90052.01,"B","SENT TO COLLECTIONS",""))
+29 ;
+30 ;** adjustment category/type dialog
+31 SET BARX=0
SET BARJ=0
+32 KILL BARATYP
+33 FOR
SET BARX=$ORDER(^BARTBL("D",BARCAT,BARX))
IF 'BARX
QUIT
Begin DoDot:1
+34 SET BARJ=BARJ+1
+35 IF BARJ>1
QUIT
+36 SET BARATYP=BARX
End DoDot:1
IF BARJ>1
QUIT
+37 SET DIC=90052.02
+38 SET DIC(0)="AEMNQZ"
+39 SET DIC("A")="Select Adjustment Type: "
+40 SET DIC("S")="I $P(^(0),U,2)=BARCAT"
+41 KILL DD,DO
+42 DO ^DIC
+43 KILL DIC
+44 IF +Y<0
KILL BARAMT
WRITE *7,!!
GOTO ASKAMT
+45 SET BARATYP=+Y
+46 ;--------------------------------
S1 ;
+1 DO SETTMP^BARBAD3A(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP,0,BARCOM(1))
+2 GOTO ASKCOM
CANCEL ;
+1 KILL ^BARTMP($JOB)
+2 KILL BARPMT,BARADJ,BARTR,BARROLL
+3 QUIT
+4 ;
POST() ;
P1 ;
+1 DO HIT1^BARBAD2(BARPASS)
+2 DO EOP^BARUTL(2)
PDIR ;
+1 ;ENTER CODE TO SHOW USER WHAT IS ABOUT TO HAPPEN
+2 KILL DIR
+3 SET DIR(0)="SAO^P:POST TO A/R;M:MORE;C:CANCEL"
+4 SET DIR("A")="Select Action (P/M/C): "
+5 DO ^DIR
+6 KILL DIR
+7 IF $DATA(DUOUT)!(Y="")
WRITE *7
GOTO PDIR
+8 QUIT Y
+9 ;***********************************
HISTORY ;P.OTT
+1 SET BARFLGRP=$$GETFLGRP()
IF BARFLGRP=U
QUIT
+2 SET BARBLDA=$ORDER(^BARTMP($JOB,"B",BARLIN,""))
+3 DO EN^BARPST5(BARBLDA)
+4 QUIT
GETFLGRP() ;
+1 ;S BARFLGRP="N"
+2 ;S Y=$$DIR^XBDIR("S^T:Transaction number;M:Message(s);B:Both;N:None","Enter a viewing option","N","","","",1)
+3 ;S BARFLGRP="1"
+4 ;S Y=$$DIR^XBDIR("N^1:Transactions only;2:Messages only;3:T+M:Both","Enter a viewing option","1","","","",1)
+5 ;K DA
+6 ;Q:$D(DIRUT) "^"
+7 ;S BARFLGRP=Y
+8 ;Q BARFLGRP
+9 ;-----------------
+10 KILL DIR,DA
+11 SET DIR(0)="SO^T:Add Transaction number to report;"
+12 SET DIR(0)=DIR(0)_"M:Add Bill Messages to report;"
+13 SET DIR(0)=DIR(0)_"B:Add both Transaction number and Bill Messages;"
+14 SET DIR(0)=DIR(0)_"N:Don't add Transaction number and Bill Messages;"
+15 SET DIR(0)=DIR(0)_"O:Show only Bill Messages;"
+16 SET DIR("A")="Enter a viewing option"
+17 DO ^DIR
+18 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)!(Y="")
QUIT U
+19 SET BARFLGRP=Y
+20 QUIT BARFLGRP
+21 ;----------------
LU(X) ;
+1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+2 ;EOR
