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

RCDPDPLM.m

Go to the documentation of this file.
  1. RCDPDPLM ;WISC/RFJ - deposit profile listmanager top routine ;1 Jun 99
  1. ;;4.5;Accounts Receivable;**114,149,304**;Mar 20, 1995;Build 104
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. N RCDEPTDA,RCDPFXIT
  1. ;
  1. F D Q:'RCDEPTDA
  1. . W !! S RCDEPTDA=$$PREPDEPT^RCDPUDEP() ; PRCA*4.5*304 allow adding new deposit
  1. . I RCDEPTDA<1 S RCDEPTDA=0 Q
  1. . D EN^VALM("RCDP DEPOSIT PROFILE")
  1. . ; fast exit
  1. . I $G(RCDPFXIT) S RCDEPTDA=0
  1. Q
  1. ;
  1. ;
  1. INIT ; initialization for list manager list
  1. N COMMDA,FMSDOC,RCDEPCNT,RCDEPTOT,RCDPDATA,RCLINE,RCRECTDA,STATUS
  1. K ^TMP("RCDPDPLM",$J),^TMP("VALM VIDEO",$J)
  1. ;
  1. ; fast exit
  1. I $G(RCDPFXIT) S VALMQUIT=1 Q
  1. ;
  1. ; set the listmanager line number
  1. S RCLINE=0
  1. ;
  1. S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,"AD",RCDEPTDA,RCRECTDA)) Q:'RCRECTDA D
  1. . D DIQ344^RCDPRPLM(RCRECTDA,".01:999;")
  1. . S RCLINE=RCLINE+1
  1. . ; create an index array for bill lookup in list
  1. . S ^TMP("RCDPDPLM",$J,"IDX",RCLINE,RCLINE)=RCRECTDA
  1. . D SET(RCLINE,RCLINE,1,80,0,IORVON,IORVOFF)
  1. . ; receipt
  1. . D SET("",RCLINE,5,18,.01) ;PRCA*4.5*304
  1. . ; type of payment
  1. . D SET("",RCLINE,19,36,.04) ;PRCA*4.5*304
  1. . ; date opened
  1. . I RCDPDATA(344,RCRECTDA,.03,"I") D
  1. . . D SET($E(RCDPDATA(344,RCRECTDA,.03,"I"),4,5)_"/"_$E(RCDPDATA(344,RCRECTDA,.03,"I"),6,7)_"/"_$E(RCDPDATA(344,RCRECTDA,.03,"I"),2,3),RCLINE,37,44)
  1. . ; by (check for null before calling set)
  1. . I RCDPDATA(344,RCRECTDA,.02,"E")'="" D
  1. . . S X=$E($P(RCDPDATA(344,RCRECTDA,.02,"E"),",",2))_$E(RCDPDATA(344,RCRECTDA,.02,"E"))
  1. . . I RCDPDATA(344,RCRECTDA,.02,"I")=.5 S X="ar"
  1. . . D SET(X,RCLINE,46,47)
  1. . ; date processed
  1. . I RCDPDATA(344,RCRECTDA,.08,"I") D
  1. . . D SET($E(RCDPDATA(344,RCRECTDA,.08,"I"),4,5)_"/"_$E(RCDPDATA(344,RCRECTDA,.08,"I"),6,7)_"/"_$E(RCDPDATA(344,RCRECTDA,.08,"I"),2,3),RCLINE,49,56)
  1. . ; by (check for null before calling set)
  1. . I RCDPDATA(344,RCRECTDA,.07,"E")'="" D
  1. . . S X=$E($P(RCDPDATA(344,RCRECTDA,.07,"E"),",",2))_$E(RCDPDATA(344,RCRECTDA,.07,"E"))
  1. . . I RCDPDATA(344,RCRECTDA,.07,"I")=.5 S X="ar"
  1. . . D SET(X,RCLINE,59,60)
  1. . ; number of transactions
  1. . D SET($J(RCDPDATA(344,RCRECTDA,101,"E"),8),RCLINE,61,69)
  1. . ; total dollars
  1. . D SET($J(RCDPDATA(344,RCRECTDA,.15,"E"),10,2),RCLINE,70,79)
  1. . ; calculate totals
  1. . S RCDEPCNT=$G(RCDEPCNT)+RCDPDATA(344,RCRECTDA,101,"E")
  1. . S RCDEPTOT=$G(RCDEPTOT)+RCDPDATA(344,RCRECTDA,.15,"E")
  1. . K RCDPDATA
  1. ;
  1. I RCLINE=0 S RCLINE=RCLINE+1 D SET(" *** No RECEIPTS for this deposit ***",RCLINE,1,80)
  1. ;
  1. ; show totals
  1. S RCLINE=RCLINE+1
  1. D SET(" -------- --------",RCLINE,1,80)
  1. S RCLINE=RCLINE+1
  1. D SET(" TOTAL DOLLARS FOR DEPOSIT",RCLINE,1,80)
  1. D SET($J($G(RCDEPCNT),8),RCLINE,61,69)
  1. D SET($J($G(RCDEPTOT),10,2),RCLINE,70,79)
  1. ;
  1. ; deposit data displayed on screen
  1. D DIQ3441(RCDEPTDA,".01:1")
  1. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET(" Bank: "_RCDPDATA(344.1,RCDEPTDA,.13,"E"),RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET(" Bank Trace Number: "_RCDPDATA(344.1,RCDEPTDA,.05,"E"),RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET(" Agency Location Code: "_RCDPDATA(344.1,RCDEPTDA,.14,"E"),RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET(" Agency Title: "_RCDPDATA(344.1,RCDEPTDA,.17,"E"),RCLINE,1,80)
  1. ;
  1. ; display comments if there are any
  1. I $O(^RCY(344.1,RCDEPTDA,1,0)) D
  1. . S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
  1. . S RCLINE=RCLINE+1 D SET("Comments",RCLINE,1,80,0,IOUON,IOUOFF)
  1. . S COMMDA=0 F S COMMDA=$O(^RCY(344.1,RCDEPTDA,1,COMMDA)) Q:'COMMDA D
  1. . . S RCLINE=RCLINE+1 D SET(^RCY(344.1,RCDEPTDA,1,COMMDA,0),RCLINE,1,80)
  1. ;
  1. ; display FMS CR documents if turned on
  1. I $G(^DISV(DUZ,"RCDPDPLM","SHOWFMS")) D
  1. . S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
  1. . S RCLINE=RCLINE+1 D SET("FMS CR Documents",RCLINE,1,80,0,IOUON,IOUOFF)
  1. . S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,"AD",RCDEPTDA,RCRECTDA)) Q:'RCRECTDA D
  1. . . D DIQ344^RCDPRPLM(RCRECTDA,".01;.14;")
  1. . . S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
  1. . . S RCLINE=RCLINE+1
  1. . . D SET("",RCLINE,5,80,.01)
  1. . . D SET("",RCLINE,17,80,.14)
  1. . . D SET($P(FMSDOC,"^"),RCLINE,25,80)
  1. . . D SET($P(FMSDOC,"^",2),RCLINE,40,80)
  1. . . K RCDPDATA
  1. ;
  1. ; set valmcnt to number of lines in the list
  1. S VALMCNT=RCLINE
  1. Q
  1. ;
  1. ;
  1. SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ; set array
  1. I $G(FIELD) S STRING=STRING_$S(STRING="":"",1:": ")_$G(RCDPDATA(344,RCRECTDA,FIELD,"E"))
  1. I STRING="",'$G(FIELD) D SET^VALM10(LINE,$J("",80)) Q
  1. I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
  1. D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLBEG,COLEND-COLBEG+1))
  1. I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLBEG,$L(STRING),ON,OFF)
  1. Q
  1. ;
  1. ;
  1. DIQ3441(DA,DR) ; diq call to retrieve data for dr fields in file 344.1
  1. N D0,DIC,DIQ,DIQ2,YY
  1. K RCDPDATA(344.1,DA)
  1. S DIQ(0)="IE",DIC="^RCY(344.1,",DIQ="RCDPDATA" D EN^DIQ1
  1. Q
  1. ;
  1. ;
  1. HDR ; header code for list manager display
  1. N DATE,RCDPDATA,SPACE
  1. D DIQ3441(RCDEPTDA,".01:1")
  1. S SPACE="",$P(SPACE," ",80)=""
  1. S VALMHDR(1)=$E(" Deposit #: "_RCDPDATA(344.1,RCDEPTDA,.01,"E")_SPACE,1,39)_" Deposit Status: "_RCDPDATA(344.1,RCDEPTDA,.12,"E")
  1. S VALMHDR(2)=$E("Deposit Date: "_RCDPDATA(344.1,RCDEPTDA,.03,"E")_SPACE,1,39)
  1. S DATE=RCDPDATA(344.1,RCDEPTDA,.07,"E"),DATE=$P(DATE,"@")_" "_$P($P(DATE,"@",2),":",1,2)
  1. I RCDPDATA(344.1,RCDEPTDA,.06,"I")=.5 S RCDPDATA(344.1,RCDEPTDA,.06,"E")="accounts receivable"
  1. S VALMHDR(3)=$E(" Opened By: "_RCDPDATA(344.1,RCDEPTDA,.06,"E")_SPACE,1,39)_"Date/Time Opened: "_DATE
  1. S DATE=RCDPDATA(344.1,RCDEPTDA,.11,"E"),DATE=$P(DATE,"@")_" "_$P($P(DATE,"@",2),":",1,2)
  1. I RCDPDATA(344.1,RCDEPTDA,.1,"I")=.5 S RCDPDATA(344.1,RCDEPTDA,.1,"E")="accounts receivable"
  1. S VALMHDR(4)=$E("Confirmed By: "_RCDPDATA(344.1,RCDEPTDA,.1,"E")_SPACE,1,39)_"Date/Time Confirmed: "_DATE
  1. ;
  1. I RCDPDATA(344.1,RCDEPTDA,.11,"I") S VALMSG="Deposit confirmed on "_RCDPDATA(344.1,RCDEPTDA,.11,"E")
  1. Q
  1. ;
  1. ;
  1. EXIT ; exit list manager option and clean up
  1. K ^TMP("RCDPDPLM",$J)
  1. Q
  1. ;
  1. ;
  1. FASTEXIT ; this is called by the protocol file to exit any of the deposit
  1. ; processing listmanager screens
  1. N DIR,DIQ2,DTOUT,DUOUT,X,Y
  1. ;
  1. S DIR(0)="YO",DIR("B")="NO"
  1. S DIR("A")=" Exit option entirely"
  1. D ^DIR
  1. I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1. I $G(DIRUT)!(Y) S RCDPFXIT=1
  1. Q