source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPUDEP.m

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
 ;