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

BARBAD4.m

Go to the documentation of this file.
  1. BARBAD4 ; IHS/SD/LSL - POSTING AND ADJUSTMENTS CONTINUED ; 12/29/2008
  1. ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,6,10,19,23**;OCT 26, 2005
  1. ;
  1. ; *********************************************************************
  1. Q
  1. EN ;EP
  1. I '$D(BARTR(BARLIN)) D G ASKCOM^BARBAD3
  1. .W *7,!!,"No transactions to Edit."
  1. .D EOP^BARUTL(1)
  1. N BARSEL
  1. S (BARSEL,BARJ)=0
  1. S BARSEL=$$DSPLY(BARLIN)
  1. W !
  1. K DIR
  1. S DIR(0)="N^1:"_BARSEL
  1. D ^DIR
  1. I $D(DUOUT)!$D(DTOUT) G ASKCOM^BARBAD3 ;IHS/SD/TPF BAR*1.8*3 FOUND DURING BETA TESTING
  1. S BARSEL=Y
  1. ; -------------------------------
  1. PARSE ;
  1. S BARLIN=$O(BARSEL(BARSEL,""))
  1. Q:'BARLIN
  1. S BARV=$O(BARSEL(BARSEL,BARLIN,""))
  1. Q:'BARV
  1. N BARREC
  1. S BARREC=BARTR(BARLIN,BARV)
  1. S BARTYP=$P(BARREC,U,1)
  1. S (BAROAMT,BARAMT)=$P(BARREC,U,2)
  1. S BARCAT=$P(BARREC,U,3)
  1. S BARATYP=$P(BARREC,U,4)
  1. ; -------------------------------
  1. ;
  1. ASKAMT ;
  1. ;S BARASK=$S(BARTYP="P":"Payment ",BARTYP="A":"Adjustment ",1:"")_"Amount: "
  1. ;W !!,BARASK_$J(BARAMT,0,2)_"// " R X:DTIME
  1. K DIR
  1. S DIR(0)="NAO^::2"
  1. S BARASK=$S(BARTYP="P":"Payment ",BARTYP="A":"Adjustment ",1:"")_"Amount: "
  1. S DIR("A")=BARASK_$J(BARAMT,0,2)_"// "
  1. S DIR("T")=DTIME
  1. D ^DIR
  1. K DIR
  1. I X="" S X=BARAMT
  1. S X=$$AMT^BARBADU(X)
  1. I X="^" G ASKCOM^BARBAD3
  1. I X="?" W *7," Must be a valid number!" G ASKAMT
  1. I BARTYP="P",X<0,$$IHS^BARUFUT(DUZ(2)) D STOP^BARFPST1 G ASKAMT ;MRS:BAR*1.8*10 D158-3
  1. ;;;I BARTYP="P",X<0,$$IHSERA^BARUFUT(DUZ(2)) D STOP^BARFPST1 G ASKAMT ;MRS:BAR*1.8*10 D158-3
  1. S BARDA=$O(^BARTMP($J,"B",BARLIN,""))
  1. S BARCAM=0,BARCOAM=0
  1. S BARCAM=$$GET1^DIQ(90050.01,BARDA,15)
  1. S BARCOAM=$O(^BARBL(DUZ(2),BARDA,9,"AAA"),-1)
  1. S:$G(BARCOAM) BARCOAM=$P(^BARBL(DUZ(2),BARDA,9,BARCOAM,0),U,4)
  1. S:'$G(BARCOAM) BARCOAM=0
  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 ($P(BARTR(BARLIN,1),U,5)="S")&(BARAMT>BARCAM) D G:($P(BARTR(BARLIN,1),U,5)="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 ($P(BARTR(BARLIN,1),U,5)="V")&(BARAMT>BARCOAM) D G:($P(BARTR(BARLIN,1),U,5)="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. ;
  1. I BARTYP="P" G S1
  1. ;
  1. ;** adjustment category/type dialog
  1. S DIC("B")=BARCAT
  1. S DIC=90052.01
  1. S DIC(0)="AEMNQZ"
  1. S DIC("A")="Adjustment Category: "
  1. S DIC("S")="I Y=3!(Y=4)!(Y=13)!(Y=14)!(Y=15)!(Y=16)!(Y=20)!(Y=21)!(Y=22)!(Y=25)"
  1. K DD,DO
  1. D ^DIC
  1. K DIC
  1. I +Y<0 W *7 W !! G ASKAMT
  1. S BARCAT=+Y
  1. S:BARCAT=16 BARAMT=-BARAMT
  1. S BARX=0,BARJ=0
  1. K BARK
  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 BARK=BARX
  1. I BARJ=1,$G(BARK) S BARATYP=BARK G S1
  1. S DIC("B")=BARATYP
  1. S DIC=90052.02
  1. S DIC(0)="AEMNQZ"
  1. S DIC("A")="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 W *7,!! G ASKAMT
  1. S BARATYP=+Y
  1. ;--------------------------------
  1. ;
  1. S1 ;
  1. D SETTMP(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP,BAROAMT)
  1. G ASKCOM^BARBAD3
  1. ; *********************************************************************
  1. ;
  1. SETTMP(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP,BAROAMT) ;HEAVILY MODIFIED; BAR*1.8*4 DD 4.1.7.2
  1. ;SEE SETTMPO BELOW FOR ORIGINAL CODING
  1. N BARBBAL,BARCLV17,BARITV19,BAREOV4
  1. K BARFLG("BARWARN")
  1. S BARSTOP=0
  1. S BARDA=$O(^BARTMP($J,"B",BARLIN,""))
  1. S BARBBAL=$P(^BARTMP($J,BARDA,BARLIN),U,5)
  1. I BARCAT'=21&(BARCAT'=22) D
  1. .S BARBBAL=BARBBAL+BAROAMT ;ADD BACK TO BAL IF NOT PENDING/GENERAL INFO
  1. .D CKNEG(BARBBAL,BAROAMT,BARAMT) ;CHECK FOR NEGATIVE BALANCES
  1. Q:BARSTOP
  1. S BARBBAL=BARBBAL-BARAMT
  1. I BARTYP="P" D
  1. .Q:BAROAMT=BARAMT
  1. .S BARPMT=BARPMT+BARAMT-BAROAMT
  1. .S $P(^BARTMP($J,BARDA,BARLIN),U,6)=BARPMT
  1. .S $P(^BARTMP($J,BARDA,BARLIN),U,5)=BARBBAL
  1. ;
  1. I BARTYP="A" D
  1. .Q:BAROAMT=BARAMT
  1. .S BARADJ=BARADJ+BARAMT-BAROAMT
  1. .S $P(^BARTMP($J,BARDA,BARLIN),U,7)=BARADJ
  1. ;
  1. S BARTR(BARLIN,BARV)=BARTYP_U_BARAMT_U_BARCAT_U_BARATYP_U_$P(BARTR(BARLIN,BARV),U,5)_U_$P(BARTR(BARLIN,BARV),U,6)
  1. K BAROAMT
  1. Q
  1. ;
  1. CKNEG(BARBBAL,BAROAMT,BARAMT) ;EP;CHECK FOR NEGATIVE BALANCES;BAR*1.8*4 DD 4.1.7.2
  1. ;
  1. Q:$G(BARZZZZ) ;ENTERING FROM PUC;MRS:BAR*1.8*6 DD 4.2.5
  1. Q:BARTYP'="P" ;ONLY PAYMENTS CHECK BATCH/ITEM
  1. N BARCLV17,BARITV19,BAREOV4
  1. I $G(BARCLV(17))]"" D ;COLLECTION BATCH BALANCE
  1. .S BARCLV17=BARCLV(17)+BAROAMT
  1. .;I BARCLV17-BARAMT<0 D WARN(1,(BARCLV17-BARAMT))
  1. I $G(BARITV(19))]"" D ;ITEM BALANCE
  1. .S BARITV19=BARITV(19)+BAROAMT
  1. .;I BARITV19-BARAMT<0 D WARN(2,(BARITV19-BARAMT))
  1. I +$G(BAREOB) D ;VISIT LOCATION BALANCE
  1. .S BAREOV4=BAREOV(4)+BAROAMT
  1. .;I BAREOV4-BARAMT<0 D WARN(3,(BAREOV4-BARAMT))
  1. Q
  1. ;
  1. SURE ;EP; WARNING MESSAGE
  1. Q:$G(BARZZZZ)="P" ;CHECK CALLED FROM PUC ;BAR*1.8*6 DD 4.2.5
  1. Q:'$G(BARFLG("BARWARN"))
  1. W !
  1. K BARFLG("BARWARN")
  1. K DIR
  1. S DIR(0)="Y"
  1. S DIR("A")="ARE YOU SURE"
  1. S DIR("B")="NO"
  1. D ^DIR
  1. K DIR
  1. I Y'=1 S BARSTOP=1
  1. Q
  1. ;
  1. ; *********************************************************************
  1. WARN(BARLVL,BARDIF) ;EP - warner MOVED FROM BARBAD3A ;BAR*1.8*4 DD 4.1.7.2
  1. I BARLVL=4,'$$IHS^BARUFUT(DUZ(2)) K BARFLG("BARWARN") Q ;BAR*1.8*4 DD 4.1.7.2
  1. ;;;I BARLVL=4,'$$IHSERA^BARUFUT(DUZ(2)) K BARFLG("BARWARN") Q ;BAR*1.8*4 DD 4.1.7.2
  1. I '$G(BARFLG("BARWARN")) W !
  1. W *7,!,"Warning - Posted amount exceeds the "
  1. ;W $S(BARLVL=1:"batch",BARLVL=2:"item",1:"location")_" balance." ;BAR*1.8*4 DD 4.1.7.2
  1. W $S(BARLVL=1:"BATCH",BARLVL=2:"ITEM",BARLVL=3:"LOCATION",1:"BILL")_" balance" ;BAR*1.8*4 DD 4.1.7.2
  1. W " by "_BARDIF_" amount" ;BAR*1.8*4 DD 4.1.7.2
  1. S BARFLG("BARWARN")=1
  1. Q
  1. ;
  1. ; *********************************************************************
  1. ;
  1. DSPLY(BARLIN) ;EP - display temporary buffer
  1. N BARPG,BARJ
  1. S BARPG=0
  1. D HEAD
  1. S (BARJ,BARSEL)=0
  1. F S BARJ=$O(BARTR(BARLIN,BARJ)) Q:'BARJ D
  1. .S BARSEL=BARSEL+1
  1. .W !,?1,BARSEL_"."
  1. .W ?8,$P(BARTR(BARLIN,BARJ),U,1)
  1. .W ?13,$J($P(BARTR(BARLIN,BARJ),U,2),8,2)
  1. .S Y=$P(BARTR(BARLIN,BARJ),U,3)
  1. .I Y W ?25,$E($P(^BAR(90052.01,Y,0),U,1),1,23)
  1. .S Y=$P(BARTR(BARLIN,BARJ),U,4)
  1. .I Y W ?50,$E($P(^BARTBL(Y,0),U,1),1,28)
  1. .S BARSEL(BARSEL,BARLIN,BARJ)=""
  1. Q BARSEL
  1. ; *********************************************************************
  1. ;
  1. W $$EN^BARVDF("IOF"),!
  1. S BARPG=BARPG+1
  1. W "Transactions for "_$P(^DPT(+BARPASS,0),U,1)_" from "_$$SDT^BARDUTL($P(BARPASS,U,2))_" to "_$$SDT^BARDUTL($P(BARPASS,U,3))
  1. W ?(IOM-15),"Page: "_BARPG
  1. W !!
  1. W "Trans",?8,"Type",?15,"Amount",?25,"Category",?50,"Adj. Type"
  1. S BARDSH=""
  1. S $P(BARDSH,"-",IOM)=""
  1. W !,BARDSH
  1. Q
  1. ;
  1. SETTMPO(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP) ;OLD SETTMP; BAR*1.8*4 DD 4.1.7.2
  1. K BARFLG("BARWARN")
  1. S BARSTOP=0
  1. S BARDA=$O(^BARTMP($J,"B",BARLIN,""))
  1. B1O ;
  1. I BARTYP="P" D Q:BARSTOP
  1. .I (BARCLV(17)-(BARPMT+BARAMT-BAROAMT))<0 D WARN(1)
  1. .I (BARITV(19)-(BARPMT+BARAMT-BAROAMT))<0 D WARN(2)
  1. .I +$G(BAREOB),(BAREOV(4)-(BARPMT+BARAMT-BAROAMT))<0 D WARN(3)
  1. .I $G(BARFLG("BARWARN")) D Q:BARSTOP
  1. ..K BARFLG("BARWARN")
  1. ..W *7,!!,"Sorry - Exceeding Limits Not Allowed",!!
  1. ..D EOP^BARUTL(1)
  1. ..S BARSTOP=1
  1. .S $P(^BARTMP($J,BARDA,BARLIN),U,6)=$P($G(^BARTMP($J,BARDA,BARLIN)),U,6)+BARAMT-BAROAMT
  1. .S BARPMT=BARPMT+BARAMT-BAROAMT
  1. I BARTYP="A" D
  1. .S $P(^BARTMP($J,BARDA,BARLIN),U,7)=$P($G(^BARTMP($J,BARDA,BARLIN)),U,7)+BARAMT-BAROAMT
  1. .S BARADJ=BARADJ+BARAMT-BAROAMT
  1. S $P(^BARTMP($J,BARDA,BARLIN),U,5)=$P(^BARTMP($J,BARDA,BARLIN),U,5)-BARAMT+BAROAMT
  1. S BARTR(BARLIN,BARV)=BARTYP_U_BARAMT_U_BARCAT_U_BARATYP
  1. K BAROAMT
  1. Q