Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BARBAD3

BARBAD3.m

Go to the documentation of this file. 
  1. 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
  1.  ;** 'Select Command' processor
  1.  ; ********************************************************************
  1.  ;P.OTTIS NOV 2012 FIXING GOTO IN DOTTED BLOCK HEAT# 86250
  1.  ;        APR 2013 NOHEAT CONDITIONAL DISPLAY OF TXD AND MESSSAGES 
  1.  ;        NOV 2013 BETA P23: added lower to upper conversion after command input
  1.  ;        NOV 2013 BETA P23: added return to line selection if bill bal =0 11/26/2013
  1.  Q
  1. EN ;EP - command processor
  1.  N BARCAM,BARCOAM ;FROM ASKCOM1
  1.  K DIR,^TEMP($J,"BARPOST"),BARTR
  1.  S (BARADJ,BARPMT)=0
  1.  S BARDFLT=""
  1.  W !!
  1.  ; -------------------------------
  1. EN1 ;
  1.  ;K BARCOM,BARTYP,BARCAT,BARATYP,BARAMT,BARLIN
  1.  K BARCOM,BARTYP,BARCAT,BARATYP,BARAMT,BARLIN,REVERSAL,REVSCHED  ;BAR*1.8*4
  1.  S BARDSP=1
  1.  D HIT1^BARBAD2(BARPASS)
  1.  ; -------------------------------
  1. EN2 ;
  1.  W !!
  1.  K BARCOM,BARAMT
  1.  D:$D(BARHLP)<10 SETHLP^BARBADU
  1.  ; -------------------------------
  1. ASKLIN ;
  1.  I $D(BARCOM(1)) D
  1.  . Q:BARCOM(1)="Q"
  1.  I BARCNT=1 S (BARLIN,BARDFLT)=1 G ASKCOM1
  1.  D ASKLIN^BARFPST3
  1.  I $G(BARLIN)["^" G FINISH
  1.  I $G(BARLIN)=0 G FINISH
  1.  I BARLIN>0,BARLIN<(BARCNT+1) G ASKCOM1
  1.  ;
  1. LNHLP ;
  1. ASKCOM ;EP - select command
  1.  K BARCOM,BARTYP,BARCAT,BARATYP,BARAMT
  1.  S BARDSP=1
  1.  D HIT1^BARBAD2(BARPASS)
  1.  W !
  1.  ; -------------------------------
  1. ASKCOM1 ;
  1.  I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) Q  ;IS SESSION STILL OPEN
  1.  ;N BARCAM,BARCOAM
  1.  K REVERSAL,REVSCHED
  1.  W !,"Select Command (Line # "_BARLIN_") : "
  1.  ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
  1.  R BARCOM:DTIME
  1.  I BARCOM="" G EN1
  1.  S BARCOM=$$LU(BARCOM) ;11/07/2013
  1.  I (BARCOM["?") D COMHLP^BARBADU G ASKCOM1
  1.  I $D(BARTR(BARLIN,1))&(($G(BARCOM)="S")!($G(BARCOM)="V")!($G(BARCOM)="1")!($G(BARCOM)="2")) D  G ASKCOM1 ;P.OTT
  1.  . W !,"A transaction already exists on this bill.  You can cancel it."
  1.  . W !,"You can also edit the amount or adjustment type."
  1.  . D EOP^BARUTL(1)
  1.  . Q  ;G ASKCOM1 ;
  1.  I ("S1V2"[BARCOM) D  I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!($G(Y)=0) G ASKCOM
  1.  .S BARBLDA=$O(^BARTMP($J,"B",BARLIN,""))
  1.  .S BARTPB=$$FIND3PB^BARUTL(DUZ(2),BARBLDA)
  1.  .K DIROUT,DIRUT,DTOUT,DUOUT
  1.  .K DIR,DIE,DIC,X,Y,DA,DR
  1.  .Q:$G(BARTPB)=""
  1.  .S BARSTAT=$P($G(^ABMDBILL($P(BARTPB,","),$P(BARTPB,",",2),0)),U,4)
  1.  .Q:BARSTAT'="X"
  1.  .W !!,"STOP!  3P BILL ",$P($P($G(^BARBL(DUZ(2),BARBLDA,0)),U),"-")," has been cancelled."
  1.  .S DIR(0)="Y"
  1.  .S DIR("A")="Are you sure you want to post to this invoice"
  1.  .S DIR("B")="N"
  1.  .D ^DIR K DIR
  1.  S Q=0
  1.  F J=1:1 D  Q:Q
  1.  .S BARCOM(J)=$P(BARCOM,",",J)
  1.  .Q:$L(BARCOM(J))
  1.  .K BARCOM(J)
  1.  .S J=J-1
  1.  .S Q=1 Q
  1.  I 'J!($L($G(BARCOM(1)))=0) G ASKCOM
  1.  I BARCOM(1)="1" S BARCOM(1)="S" W *7,*7,*7
  1.  I BARCOM(1)="2" S BARCOM(1)="V" W *7,*7,*7
  1.  I BARCOM(1)="3" S BARCOM(1)="Q" W *7,*7,*7
  1.  I BARCOM(1)="4" S BARCOM(1)="H" W *7,*7,*7
  1.  I BARCOM(1)="5" S BARCOM(1)="M" W *7,*7,*7
  1.  I BARCOM(1)="6" S BARCOM(1)="T" W *7,*7,*7
  1.  I BARCOM(1)="7" S BARCOM(1)="B" W *7,*7,*7
  1.  I BARCOM(1)="8" S BARCOM(1)="E" W *7,*7,*7
  1.  G:'("SVBHMTQE"[BARCOM(1)) COMHLP
  1.  I "SV"[BARCOM(1) D
  1.  . S BARCAM=0,BARCOAM=0
  1.  . S BARCAM=$$GET1^DIQ(90050.01,BARBLDA,15)
  1.  . S BARCOAM=$O(^BARBL(DUZ(2),BARBLDA,9,"AAA"),-1)
  1.  . S:$G(BARCOAM) BARCOAM=$P(^BARBL(DUZ(2),BARBLDA,9,BARCOAM,0),U,4)
  1.  . S:'$G(BARCOAM) BARCOAM=0
  1.  I ($G(BARCOM(1))="S")&($G(BARCAM)'>0) D  G ASKLIN ;COM1 ;11/26/2013
  1.  . W !,"The current balance on this bill 0.  There is nothing to put into collections."
  1.  . D EOP^BARUTL(1)
  1.  . ;S BARCOM(1)="Q"
  1.  I ($G(BARCOM(1))="V")&($G(BARCOAM)'>0) D  G ASKLIN ;COM1 ;11/26/2013
  1.  . W !,"There isn't an amount in collections to take out of collections."
  1.  . D EOP^BARUTL(1)
  1.  . ;S BARCOM(1)="Q"
  1.  I J=1,BARCOM(1)="T" D  G ASKCOM
  1.  .S Y=$$DSPLY^BARBAD4(BARLIN)
  1.  .D EOP^BARUTL(1)
  1.  I J=1,BARCOM(1)="M" D  G ASKCOM
  1.  .N DA,DIC,BARBLDA,BARACC
  1.  .S BARBLDA=$O(^BARTMP($J,"B",BARLIN,""))
  1.  .S BARACC=$$GET1^DIQ(90050.01,BARBLDA,3,"I")
  1.  .D EN^BARBAD6(BARPAT,BARBLDA,BARACC)
  1.  .Q
  1.  I J=1,BARCOM(1)="H" D HISTORY G ASKCOM ;P.OTT
  1.  ;.S BARBLDA=$O(^BARTMP($J,"B",BARLIN,""))
  1.  ;.D EN^BARBAD5(BARBLDA)
  1.  G:"SV"[BARCOM(1) GOSR
  1.  ; -------------------------------
  1. GOQ  ;
  1.  I J=1,BARCOM(J)="Q" D  G:BARCNT>1 EN1 G FINISH
  1.  .D CKNEG(BARLIN)
  1. GOSR ;
  1.  I (J=1)&((BARCOM(J)="S")!(BARCOM(J)="V")) S BARTYP="A" G ASKAMT
  1.  I J=1,BARCOM(J)="E" G ^BARBAD4
  1. GOB ;
  1.  I (J=1)&(BARCOM(1)="B") D  G ASKCOM
  1.  . S BARBLDA=$O(^BARTMP($J,"B",BARLIN,""))
  1.  . D DIQ^XBLM(90050.01,BARBLDA)
  1.  W *7,!,"   Sorry.. ["_BARHLP(BARCOM(1))_"] not active!"
  1.  D EOP^BARUTL(1)
  1.  G ASKCOM
  1.  ; *********************************************************************
  1. COMHLP ;
  1.  D COMHLP^BARBADU
  1.  G ASKCOM1
  1.  ; *********************************************************************
  1. CKNEG(LIN) ;EP; CHECK FOR NEGATIVE BALANCE  ;BAR*1.8*4 DD 4.1.7.2
  1.  Q:'$$IHS^BARUFUT(DUZ(2))              ;IGNORE NON-IHS
  1.  ;;;Q:'$$IHSERA^BARUFUT(DUZ(2))              ;IGNORE NON-IHS AND TRIBAL WITH RESTRICTION FLAG ON
  1.  N BARDA,BARB
  1. REDO S BARDA=$O(^BARTMP($J,"B",LIN,""))
  1.  S BARB=$P(^BARTMP($J,BARDA,LIN),U,5)
  1.  Q
  1. FINISH ;
  1.  I '$G(BARPMT)&('$G(BARADJ))&('$D(BARROLL))&'$D(BARTR) D CANCEL Q
  1.  ; enable posting rollback
  1. FIN ;
  1.  S BARQ=$$POST()
  1.  I BARQ="M" G EN1
  1.  I BARQ="C" D CANCEL Q
  1.  I BARQ="P" D POSTTX^BARBADU
  1.  ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
  1.  I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) Q  ;IS SESSION STILL OPEN
  1.  I $G(BARSTOP)=1 G FIN
  1.  K ^BARTMP($J)
  1.  Q
  1.  ;--------------------------------
  1. ASKAMT ;
  1.  S (BARCAT,BARATYP)=""
  1.  W:BARCOM(1)="S" !,"Amount is added to Sent to Collections amount and deducted from Current Balance."
  1.  W:BARCOM(1)="V" !,"Amount is added to Current Balance and deducted from Sent to Collections amount."
  1.  S BARASK=$S(BARCOM(1)="S":"STATUS ",BARCOM(1)="V":"REVERSE STATUS ",1:"")_"Amount: "
  1.  ;W !,BARASK R X:DTIME
  1.  K DIR
  1.  S DIR(0)="FAO"
  1.  S DIR("A")=BARASK
  1.  S DIR("T")=DTIME
  1.  D ^DIR
  1.  K DIR
  1.  S X=$$AMT^BARPSTU(X)
  1.  I X="^" G ASKCOM
  1.  I X="?" W *7,"  Must be a valid number!" G ASKAMT
  1.  S BARAMT=X
  1.  I (BARAMT'>0) D  G:BARAMT'>0 ASKAMT
  1.  . W !,"You must enter a value larger than 0."
  1.  . D EOP^BARUTL(1)
  1.  . Q
  1.  I ($G(BARCOM(1))="S")&(BARAMT>BARCAM) D  G:($G(BARCOM(1))="S")&(BARAMT>BARCAM) ASKAMT
  1.  . W !,"You can't place more than the current bill amount in collections."
  1.  . D EOP^BARUTL(1)
  1.  . Q
  1.  I ($G(BARCOM(1))="V")&(BARAMT>BARCOAM) D  G:($G(BARCOM(1))="V")&(BARAMT>BARCOAM) ASKAMT
  1.  . W !,"You can't reverse from collections more than what's in there."
  1.  . D EOP^BARUTL(1)
  1.  . Q
  1.  S BARCAT=$O(^BAR(90052.01,"B","SENT TO COLLECTIONS",""))
  1.  ;
  1.  ;** adjustment category/type dialog
  1.  S BARX=0,BARJ=0
  1.  K BARATYP
  1.  F  S BARX=$O(^BARTBL("D",BARCAT,BARX)) Q:'BARX  D  Q:BARJ>1
  1.  .S BARJ=BARJ+1
  1.  .Q:BARJ>1
  1.  .S BARATYP=BARX
  1.  S DIC=90052.02
  1.  S DIC(0)="AEMNQZ"
  1.  S DIC("A")="Select Adjustment Type: "
  1.  S DIC("S")="I $P(^(0),U,2)=BARCAT"
  1.  K DD,DO
  1.  D ^DIC
  1.  K DIC
  1.  I +Y<0 K BARAMT W *7,!! G ASKAMT
  1.  S BARATYP=+Y
  1.  ;--------------------------------
  1. S1 ;
  1.  D SETTMP^BARBAD3A(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP,0,BARCOM(1))
  1.  G ASKCOM
  1. CANCEL ;
  1.  K ^BARTMP($J)
  1.  K BARPMT,BARADJ,BARTR,BARROLL
  1.  Q
  1.  ;
  1. POST() ;
  1. P1 ;
  1.  D HIT1^BARBAD2(BARPASS)
  1.  D EOP^BARUTL(2)
  1. PDIR ;
  1.  ;ENTER CODE TO SHOW USER WHAT IS ABOUT TO HAPPEN
  1.  K DIR
  1.  S DIR(0)="SAO^P:POST TO A/R;M:MORE;C:CANCEL"
  1.  S DIR("A")="Select Action (P/M/C): "
  1.  D ^DIR
  1.  K DIR
  1.  I $D(DUOUT)!(Y="") W *7 G PDIR
  1.  Q Y
  1.  ;***********************************
  1. HISTORY ;P.OTT
  1.  S BARFLGRP=$$GETFLGRP() I BARFLGRP=U Q
  1.  S BARBLDA=$O(^BARTMP($J,"B",BARLIN,""))
  1.  D EN^BARPST5(BARBLDA)
  1.  Q
  1. GETFLGRP() ;
  1.  ;S BARFLGRP="N" 
  1.  ;S Y=$$DIR^XBDIR("S^T:Transaction number;M:Message(s);B:Both;N:None","Enter a viewing option","N","","","",1)
  1.  ;S BARFLGRP="1" 
  1.  ;S Y=$$DIR^XBDIR("N^1:Transactions only;2:Messages only;3:T+M:Both","Enter a viewing option","1","","","",1)
  1.  ;K DA
  1.  ;Q:$D(DIRUT) "^"
  1.  ;S BARFLGRP=Y
  1.  ;Q BARFLGRP
  1.  ;-----------------
  1.  K DIR,DA
  1.  S DIR(0)="SO^T:Add Transaction number to report;"
  1.  S DIR(0)=DIR(0)_"M:Add Bill Messages to report;"
  1.  S DIR(0)=DIR(0)_"B:Add both Transaction number and Bill Messages;"
  1.  S DIR(0)=DIR(0)_"N:Don't add Transaction number and Bill Messages;"
  1.  S DIR(0)=DIR(0)_"O:Show only Bill Messages;"
  1.  S DIR("A")="Enter a viewing option"
  1.  D ^DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)!(Y="") U
  1.  S BARFLGRP=Y
  1.  Q BARFLGRP
  1.  ;----------------
  1. LU(X) ;
  1.  Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1.  ;EOR