- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPUDEP.m
r613 r623 1 RCDPUDEP ;WISC/RFJ-deposit utilities ;29/MAY/2008 2 ;;4.5;Accounts Receivable;**114,173,257**;Mar 20, 1995;Build 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 Q 5 ; 6 ; 7 ADDDEPT(DEPOSIT,DEPDATE) ; if the deposit is not entered, add it 8 ; 9 ; if deposit date is missing, do not add the deposit 10 I 'DEPDATE Q 0 11 ; 12 ; already in file, deposit number and deposit date match 13 N DA,RCDPFLAG 14 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 15 I $G(RCDPFLAG) Q DA 16 ; 17 ; add it 18 N %,%DT,D0,DA,DD,DI,DIC,DIE,DLAYGO,DO,DQ,DR,X,Y 19 S DIC="^RCY(344.1,",DIC(0)="L",DLAYGO=344.1 20 ; .03 = deposit date .06 = opened by 21 ; .07 = date/time opened .12 = status (set to 1:open) 22 S DIC("DR")=".03////"_DEPDATE_";.06////"_DUZ_";.07///NOW;.12////1;" 23 S X=DEPOSIT 24 D FILE^DICN 25 I Y>0 Q +Y 26 Q 0 27 ; 28 ; 29 SELDEPT(ADDNEW) ; select a deposit 30 ; if $g(addnew) allow adding a new deposit 31 ; returns -1 for timeout or ^, 0 for no selection, or ien of deposit 32 N %,%T,%Y,C,D0,DA,DIC,DIE,DLAYGO,DQ,DR,DTOUT,DUOUT,RCDEFLUP,X,Y 33 S DIC="^RCY(344.1,",DIC(0)="QEAM",DIC("A")="Select DEPOSIT: " 34 S DIC("W")="D DICW^RCDPUDEP" 35 ; use special lookup on input 36 S RCDEFLUP=1 37 I $G(ADDNEW) S DIC(0)="QEALM",DLAYGO=344.1,DIC("DR")=".03///TODAY;.06////"_DUZ_";.07///NOW;.12////1;" 38 D ^DIC 39 I Y<0,'$G(DUOUT),'$G(DTOUT) S Y=0 40 Q +Y 41 ; 42 ; 43 DICW ; write identifier code for receipt lookup 44 N DATA 45 S DATA=$G(^RCY(344.1,Y,0)) I DATA="" Q 46 ; opened by 47 W ?13,"by: ",$E($P($G(^VA(200,+$P(DATA,"^",6),0)),"^"),1,15) 48 ; date opened 49 I '$P(DATA,"^",7) S $P(DATA,"^",7)="???????" 50 W ?35," on: ",$E($P(DATA,"^",7),4,5),"/",$E($P(DATA,"^",7),6,7),"/",$E($P(DATA,"^",7),2,3) 51 ; total dollars 52 W ?50," amt: $",$J($P(DATA,"^",4),9,2) 53 ; status 54 W ?69," ",$P("N/A^OPEN^DEPOSITED^CONFIRMED^PROCESSED^VOID","^",+$P(DATA,"^",12)+1) 55 Q 56 ; 57 ; 58 LOOKUP ; special lookup on deposits, called from ^dd(344.1,.01,7.5) 59 ; if rcdeflup flag not set, do not use special lookup 60 I '$D(RCDEFLUP) Q 61 ; 1:OPEN;3:CONFIRMED 62 ; user entered O.? for lookup on open deposits 63 I X["O."!(X["o.") S DIC("S")="I $P(^(0),U,12)=1" S X="?" Q 64 ; user entered C.? for lookup on confirmed deposits 65 I X["C."!(X["c.") S DIC("S")="I $P(^(0),U,12)=3" S X="?" Q 66 ; deposit ticket # manually added is for electronic ticket only 67 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="" Q 68 ; Do not allow for 7-, 8-, or 9-digit electronic ticket to be added. 69 I $G(DIC(0))["L",'$D(^RCY(344.1,"B",X)),$L(X)>6,$L(X)<10 D EN^DDIOL(" ** Deposit # of "_$L(X)_" digits not allowed. "_$S($L(X)=9:"9 digits limited to automatic deposits.",1:""),,"!") S X="" Q 70 K DIC("S") 71 Q 72 ; 73 ; 74 EDITDEP(DA,ASKDATE) ; edit the deposit 75 ; if $g(askdate) ask only the deposit date 76 N %,D,D0,DI,DIC,DIE,DQ,DR,J,X,Y 77 S (DIC,DIE)="^RCY(344.1,",DR="" 78 ; deposit date(.03), do not allow edit if closed or either lockbox 79 I $$CHECKDEP^RCDPDPLU(DA) S DR=".03BANK DEPOSIT DATE//TODAY;" 80 ; bank(.13) 81 S DR=DR_".13//"_$P($G(^RC(342.1,+$O(^RC(342.1,"AC",9,0)),0)),"^")_";" 82 ; bank trace(.05) 83 S DR=DR_".05;" 84 ; agency title(.17) 85 S DR=DR_".17//"_$P($G(^RC(342.1,+$O(^RC(342.1,"AC",10,0)),0)),"^")_";" 86 ; agency location code(.14), comments(1) 87 S DR=DR_".14//"_$P(^RC(342,1,0),"^",7)_";1;" 88 ; 89 ; only ask deposit date 90 I $G(ASKDATE) S DR=".03BANK DEPOSIT DATE//TODAY;" 91 D ^DIE 92 Q 93 ; 94 ; 95 CONFIRM(DA) ; confirm the deposit 96 N %DT,D,D0,DI,DIC,DIE,DQ,DR,X,Y 97 S (DIC,DIE)="^RCY(344.1," 98 S DR=".04///"_$$TOTAL(DA)_";.12////3;.1////"_DUZ_";.11///NOW;" 99 D ^DIE 100 Q 101 ; 102 ; 103 TOTAL(RCDEPTDA) ; compute total dollars for all receipts on the deposit 104 N RCRECTDA,RCTRANDA,TOTAL 105 S RCRECTDA=0 106 F S RCRECTDA=$O(^RCY(344,"AD",RCDEPTDA,RCRECTDA)) Q:'RCRECTDA D 107 . S RCTRANDA=0 108 . F S RCTRANDA=$O(^RCY(344,RCRECTDA,1,RCTRANDA)) Q:'RCTRANDA D 109 . . S TOTAL=$G(TOTAL)+$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,0)),"^",4) 110 Q +$G(TOTAL) 111 ; 112 AUTODEP(X) ; Function returns 1 if the deposit ticket # in X is in the auto 113 ; deposit number space 269xxx, 369xxx, 469xxx, 569xxx, or 669xxx 114 ; and hasn't been previously entered via lockbox interface. 115 ; 116 N Y 117 S Y=0 118 I $L(X)=6,$E(X,2,3)="69","23456"[$E(X),'$D(^RCY(344.1,"B",X)) S Y=1 119 Q Y 120 ; 1 RCDPUDEP ;WISC/RFJ-deposit utilities ;1 Jun 99 2 ;;4.5;Accounts Receivable;**114,173**;Mar 20, 1995 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 Q 5 ; 6 ; 7 ADDDEPT(DEPOSIT,DEPDATE) ; if the deposit is not entered, add it 8 ; 9 ; if deposit date is missing, do not add the deposit 10 I 'DEPDATE Q 0 11 ; 12 ; already in file, deposit number and deposit date match 13 N DA,RCDPFLAG 14 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 15 I $G(RCDPFLAG) Q DA 16 ; 17 ; add it 18 N %,%DT,D0,DA,DD,DI,DIC,DIE,DLAYGO,DO,DQ,DR,X,Y 19 S DIC="^RCY(344.1,",DIC(0)="L",DLAYGO=344.1 20 ; .03 = deposit date .06 = opened by 21 ; .07 = date/time opened .12 = status (set to 1:open) 22 S DIC("DR")=".03////"_DEPDATE_";.06////"_DUZ_";.07///NOW;.12////1;" 23 S X=DEPOSIT 24 D FILE^DICN 25 I Y>0 Q +Y 26 Q 0 27 ; 28 ; 29 SELDEPT(ADDNEW) ; select a deposit 30 ; if $g(addnew) allow adding a new deposit 31 ; returns -1 for timeout or ^, 0 for no selection, or ien of deposit 32 N %,%T,%Y,C,D0,DA,DIC,DIE,DLAYGO,DQ,DR,DTOUT,DUOUT,RCDEFLUP,X,Y 33 S DIC="^RCY(344.1,",DIC(0)="QEAM",DIC("A")="Select DEPOSIT: " 34 S DIC("W")="D DICW^RCDPUDEP" 35 ; use special lookup on input 36 S RCDEFLUP=1 37 I $G(ADDNEW) S DIC(0)="QEALM",DLAYGO=344.1,DIC("DR")=".03///TODAY;.06////"_DUZ_";.07///NOW;.12////1;" 38 D ^DIC 39 I Y<0,'$G(DUOUT),'$G(DTOUT) S Y=0 40 Q +Y 41 ; 42 ; 43 DICW ; write identifier code for receipt lookup 44 N DATA 45 S DATA=$G(^RCY(344.1,Y,0)) I DATA="" Q 46 ; opened by 47 W ?13,"by: ",$E($P($G(^VA(200,+$P(DATA,"^",6),0)),"^"),1,15) 48 ; date opened 49 I '$P(DATA,"^",7) S $P(DATA,"^",7)="???????" 50 W ?35," on: ",$E($P(DATA,"^",7),4,5),"/",$E($P(DATA,"^",7),6,7),"/",$E($P(DATA,"^",7),2,3) 51 ; total dollars 52 W ?50," amt: $",$J($P(DATA,"^",4),9,2) 53 ; status 54 W ?69," ",$P("N/A^OPEN^DEPOSITED^CONFIRMED^PROCESSED^VOID","^",+$P(DATA,"^",12)+1) 55 Q 56 ; 57 ; 58 LOOKUP ; special lookup on deposits, called from ^dd(344.1,.01,7.5) 59 ; if rcdeflup flag not set, do not use special lookup 60 I '$D(RCDEFLUP) Q 61 ; 1:OPEN;3:CONFIRMED 62 ; user entered O.? for lookup on open deposits 63 I X["O."!(X["o.") S DIC("S")="I $P(^(0),U,12)=1" S X="?" Q 64 ; user entered C.? for lookup on confirmed deposits 65 I X["C."!(X["c.") S DIC("S")="I $P(^(0),U,12)=3" S X="?" Q 66 ; deposit ticket # manually entered is for electronic ticket only 67 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="" 68 K DIC("S") 69 Q 70 ; 71 ; 72 EDITDEP(DA,ASKDATE) ; edit the deposit 73 ; if $g(askdate) ask only the deposit date 74 N %,D,D0,DI,DIC,DIE,DQ,DR,J,X,Y 75 S (DIC,DIE)="^RCY(344.1,",DR="" 76 ; deposit date(.03), do not allow edit if closed or either lockbox 77 I $$CHECKDEP^RCDPDPLU(DA) S DR=".03BANK DEPOSIT DATE//TODAY;" 78 ; bank(.13) 79 S DR=DR_".13//"_$P($G(^RC(342.1,+$O(^RC(342.1,"AC",9,0)),0)),"^")_";" 80 ; bank trace(.05) 81 S DR=DR_".05;" 82 ; agency title(.17) 83 S DR=DR_".17//"_$P($G(^RC(342.1,+$O(^RC(342.1,"AC",10,0)),0)),"^")_";" 84 ; agency location code(.14), comments(1) 85 S DR=DR_".14//"_$P(^RC(342,1,0),"^",7)_";1;" 86 ; 87 ; only ask deposit date 88 I $G(ASKDATE) S DR=".03BANK DEPOSIT DATE//TODAY;" 89 D ^DIE 90 Q 91 ; 92 ; 93 CONFIRM(DA) ; confirm the deposit 94 N %DT,D,D0,DI,DIC,DIE,DQ,DR,X,Y 95 S (DIC,DIE)="^RCY(344.1," 96 S DR=".04///"_$$TOTAL(DA)_";.12////3;.1////"_DUZ_";.11///NOW;" 97 D ^DIE 98 Q 99 ; 100 ; 101 TOTAL(RCDEPTDA) ; compute total dollars for all receipts on the deposit 102 N RCRECTDA,RCTRANDA,TOTAL 103 S RCRECTDA=0 104 F S RCRECTDA=$O(^RCY(344,"AD",RCDEPTDA,RCRECTDA)) Q:'RCRECTDA D 105 . S RCTRANDA=0 106 . F S RCTRANDA=$O(^RCY(344,RCRECTDA,1,RCTRANDA)) Q:'RCTRANDA D 107 . . S TOTAL=$G(TOTAL)+$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,0)),"^",4) 108 Q +$G(TOTAL) 109 ; 110 AUTODEP(X) ; Function returns 1 if the deposit ticket # in X is in the auto 111 ; deposit number space 269xxx, 369xxx, 469xxx, 569xxx 112 N Y 113 S Y=0 114 I $L(X)=6,$E(X,2,3)="69","2345"[$E(X),'$D(^RCY(344.1,"B",X)) S Y=1 115 Q Y 116 ;
Note:
See TracChangeset
for help on using the changeset viewer.
