source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPUDEP.m@ 1306

RCDPUDEP ;WISC/RFJ-deposit utilities ;1 Jun 99

 ;;4.5;Accounts Receivable;**114,173**;Mar 20, 1995

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 Q

 ;

 ;

ADDDEPT(DEPOSIT,DEPDATE) ;  if the deposit is not entered, add it

 ;

 ;  if deposit date is missing, do not add the deposit

 I 'DEPDATE Q 0

 ;

 ;  already in file, deposit number and deposit date match

 N DA,RCDPFLAG

 S DA=0 F  S DA=$O(^RCY(344.1,"B",DEPOSIT,DA)) Q:'DA  I $P($G(^RCY(344.1,DA,0)),"^",3)=DEPDATE S RCDPFLAG=1 Q

 I $G(RCDPFLAG) Q DA

 ;

 ;  add it

 N %,%DT,D0,DA,DD,DI,DIC,DIE,DLAYGO,DO,DQ,DR,X,Y

 S DIC="^RCY(344.1,",DIC(0)="L",DLAYGO=344.1

 ;  .03 = deposit date               .06 = opened by

 ;  .07 = date/time opened           .12 = status (set to 1:open)

 S DIC("DR")=".03////"_DEPDATE_";.06////"_DUZ_";.07///NOW;.12////1;"

 S X=DEPOSIT

 D FILE^DICN

 I Y>0 Q +Y

 Q 0

 ;

 ;

SELDEPT(ADDNEW) ;  select a deposit

 ;  if $g(addnew) allow adding a new deposit

 ;  returns -1 for timeout or ^, 0 for no selection, or ien of deposit

 N %,%T,%Y,C,D0,DA,DIC,DIE,DLAYGO,DQ,DR,DTOUT,DUOUT,RCDEFLUP,X,Y

 S DIC="^RCY(344.1,",DIC(0)="QEAM",DIC("A")="Select DEPOSIT: "

 S DIC("W")="D DICW^RCDPUDEP"

 ;  use special lookup on input

 S RCDEFLUP=1

 I $G(ADDNEW) S DIC(0)="QEALM",DLAYGO=344.1,DIC("DR")=".03///TODAY;.06////"_DUZ_";.07///NOW;.12////1;"

 D ^DIC

 I Y<0,'$G(DUOUT),'$G(DTOUT) S Y=0

 Q +Y

 ;

 ;

DICW ;  write identifier code for receipt lookup

 N DATA

 S DATA=$G(^RCY(344.1,Y,0)) I DATA="" Q

 ;  opened by

 W ?13,"by: ",$E($P($G(^VA(200,+$P(DATA,"^",6),0)),"^"),1,15)

 ;  date opened

 I '$P(DATA,"^",7) S $P(DATA,"^",7)="???????"

 W ?35," on: ",$E($P(DATA,"^",7),4,5),"/",$E($P(DATA,"^",7),6,7),"/",$E($P(DATA,"^",7),2,3)

 ;  total dollars

 W ?50," amt: $",$J($P(DATA,"^",4),9,2)

 ;  status

 W ?69," ",$P("N/A^OPEN^DEPOSITED^CONFIRMED^PROCESSED^VOID","^",+$P(DATA,"^",12)+1)

 Q

 ;

 ;

LOOKUP ;  special lookup on deposits, called from ^dd(344.1,.01,7.5)

 ;  if rcdeflup flag not set, do not use special lookup

 I '$D(RCDEFLUP) Q

 ;  1:OPEN;3:CONFIRMED

 ;  user entered O.? for lookup on open deposits

 I X["O."!(X["o.") S DIC("S")="I $P(^(0),U,12)=1" S X="?" Q

 ;  user entered C.? for lookup on confirmed deposits

 I X["C."!(X["c.") S DIC("S")="I $P(^(0),U,12)=3" S X="?" Q

 ;  deposit ticket # manually entered is for electronic ticket only

 I $G(DIC(0))["L",$$AUTODEP(X) D EN^DDIOL(" ** Deposit #'s starting with "_$E(X,1,3)_" can only be used by automatic deposits",,"!") S X=""

 K DIC("S")

 Q

 ;

 ;

EDITDEP(DA,ASKDATE) ;  edit the deposit

 ;  if $g(askdate) ask only the deposit date

 N %,D,D0,DI,DIC,DIE,DQ,DR,J,X,Y

 S (DIC,DIE)="^RCY(344.1,",DR=""

 ;  deposit date(.03), do not allow edit if closed or either lockbox

 I $$CHECKDEP^RCDPDPLU(DA) S DR=".03BANK DEPOSIT DATE//TODAY;"

 ;  bank(.13)

 S DR=DR_".13//"_$P($G(^RC(342.1,+$O(^RC(342.1,"AC",9,0)),0)),"^")_";"

 ;  bank trace(.05)

 S DR=DR_".05;"

 ;  agency title(.17)

 S DR=DR_".17//"_$P($G(^RC(342.1,+$O(^RC(342.1,"AC",10,0)),0)),"^")_";"

 ;  agency location code(.14), comments(1)

 S DR=DR_".14//"_$P(^RC(342,1,0),"^",7)_";1;"

 ;

 ;  only ask deposit date

 I $G(ASKDATE) S DR=".03BANK DEPOSIT DATE//TODAY;"

 D ^DIE

 Q

 ;

 ;

CONFIRM(DA) ;  confirm the deposit

 N %DT,D,D0,DI,DIC,DIE,DQ,DR,X,Y

 S (DIC,DIE)="^RCY(344.1,"

 S DR=".04///"_$$TOTAL(DA)_";.12////3;.1////"_DUZ_";.11///NOW;"

 D ^DIE

 Q

 ;

 ;

TOTAL(RCDEPTDA) ;  compute total dollars for all receipts on the deposit

 N RCRECTDA,RCTRANDA,TOTAL

 S RCRECTDA=0

 F  S RCRECTDA=$O(^RCY(344,"AD",RCDEPTDA,RCRECTDA)) Q:'RCRECTDA  D

 .   S RCTRANDA=0

 .   F  S RCTRANDA=$O(^RCY(344,RCRECTDA,1,RCTRANDA)) Q:'RCTRANDA  D

 .   .   S TOTAL=$G(TOTAL)+$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,0)),"^",4)

 Q +$G(TOTAL)

 ;

AUTODEP(X) ; Function returns 1 if the deposit ticket # in X is in the auto

 ; deposit number space 269xxx, 369xxx, 469xxx, 569xxx

 N Y

 S Y=0

 I $L(X)=6,$E(X,2,3)="69","2345"[$E(X),'$D(^RCY(344.1,"B",X)) S Y=1

 Q Y

 ;