RCDPDPLM ;WISC/RFJ - deposit profile listmanager top routine ;1 Jun 99
;;4.5;Accounts Receivable;**114,149,304**;Mar 20, 1995;Build 104
;;Per VA Directive 6402, this routine should not be modified.
;
N RCDEPTDA,RCDPFXIT
;
F D Q:'RCDEPTDA
. W !! S RCDEPTDA=$$PREPDEPT^RCDPUDEP() ; PRCA*4.5*304 allow adding new deposit
. I RCDEPTDA<1 S RCDEPTDA=0 Q
. D EN^VALM("RCDP DEPOSIT PROFILE")
. ; fast exit
. I $G(RCDPFXIT) S RCDEPTDA=0
Q
;
;
INIT ; initialization for list manager list
N COMMDA,FMSDOC,RCDEPCNT,RCDEPTOT,RCDPDATA,RCLINE,RCRECTDA,STATUS
K ^TMP("RCDPDPLM",$J),^TMP("VALM VIDEO",$J)
;
; fast exit
I $G(RCDPFXIT) S VALMQUIT=1 Q
;
; set the listmanager line number
S RCLINE=0
;
S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,"AD",RCDEPTDA,RCRECTDA)) Q:'RCRECTDA D
. D DIQ344^RCDPRPLM(RCRECTDA,".01:999;")
. S RCLINE=RCLINE+1
. ; create an index array for bill lookup in list
. S ^TMP("RCDPDPLM",$J,"IDX",RCLINE,RCLINE)=RCRECTDA
. D SET(RCLINE,RCLINE,1,80,0,IORVON,IORVOFF)
. ; receipt
. D SET("",RCLINE,5,18,.01) ;PRCA*4.5*304
. ; type of payment
. D SET("",RCLINE,19,36,.04) ;PRCA*4.5*304
. ; date opened
. I RCDPDATA(344,RCRECTDA,.03,"I") D
. . 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)
. ; by (check for null before calling set)
. I RCDPDATA(344,RCRECTDA,.02,"E")'="" D
. . S X=$E($P(RCDPDATA(344,RCRECTDA,.02,"E"),",",2))_$E(RCDPDATA(344,RCRECTDA,.02,"E"))
. . I RCDPDATA(344,RCRECTDA,.02,"I")=.5 S X="ar"
. . D SET(X,RCLINE,46,47)
. ; date processed
. I RCDPDATA(344,RCRECTDA,.08,"I") D
. . 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)
. ; by (check for null before calling set)
. I RCDPDATA(344,RCRECTDA,.07,"E")'="" D
. . S X=$E($P(RCDPDATA(344,RCRECTDA,.07,"E"),",",2))_$E(RCDPDATA(344,RCRECTDA,.07,"E"))
. . I RCDPDATA(344,RCRECTDA,.07,"I")=.5 S X="ar"
. . D SET(X,RCLINE,59,60)
. ; number of transactions
. D SET($J(RCDPDATA(344,RCRECTDA,101,"E"),8),RCLINE,61,69)
. ; total dollars
. D SET($J(RCDPDATA(344,RCRECTDA,.15,"E"),10,2),RCLINE,70,79)
. ; calculate totals
. S RCDEPCNT=$G(RCDEPCNT)+RCDPDATA(344,RCRECTDA,101,"E")
. S RCDEPTOT=$G(RCDEPTOT)+RCDPDATA(344,RCRECTDA,.15,"E")
. K RCDPDATA
;
I RCLINE=0 S RCLINE=RCLINE+1 D SET(" *** No RECEIPTS for this deposit ***",RCLINE,1,80)
;
; show totals
S RCLINE=RCLINE+1
D SET(" -------- --------",RCLINE,1,80)
S RCLINE=RCLINE+1
D SET(" TOTAL DOLLARS FOR DEPOSIT",RCLINE,1,80)
D SET($J($G(RCDEPCNT),8),RCLINE,61,69)
D SET($J($G(RCDEPTOT),10,2),RCLINE,70,79)
;
; deposit data displayed on screen
D DIQ3441(RCDEPTDA,".01:1")
S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
S RCLINE=RCLINE+1 D SET(" Bank: "_RCDPDATA(344.1,RCDEPTDA,.13,"E"),RCLINE,1,80)
S RCLINE=RCLINE+1 D SET(" Bank Trace Number: "_RCDPDATA(344.1,RCDEPTDA,.05,"E"),RCLINE,1,80)
S RCLINE=RCLINE+1 D SET(" Agency Location Code: "_RCDPDATA(344.1,RCDEPTDA,.14,"E"),RCLINE,1,80)
S RCLINE=RCLINE+1 D SET(" Agency Title: "_RCDPDATA(344.1,RCDEPTDA,.17,"E"),RCLINE,1,80)
;
; display comments if there are any
I $O(^RCY(344.1,RCDEPTDA,1,0)) D
. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
. S RCLINE=RCLINE+1 D SET("Comments",RCLINE,1,80,0,IOUON,IOUOFF)
. S COMMDA=0 F S COMMDA=$O(^RCY(344.1,RCDEPTDA,1,COMMDA)) Q:'COMMDA D
. . S RCLINE=RCLINE+1 D SET(^RCY(344.1,RCDEPTDA,1,COMMDA,0),RCLINE,1,80)
;
; display FMS CR documents if turned on
I $G(^DISV(DUZ,"RCDPDPLM","SHOWFMS")) D
. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
. S RCLINE=RCLINE+1 D SET("FMS CR Documents",RCLINE,1,80,0,IOUON,IOUOFF)
. S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,"AD",RCDEPTDA,RCRECTDA)) Q:'RCRECTDA D
. . D DIQ344^RCDPRPLM(RCRECTDA,".01;.14;")
. . S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
. . S RCLINE=RCLINE+1
. . D SET("",RCLINE,5,80,.01)
. . D SET("",RCLINE,17,80,.14)
. . D SET($P(FMSDOC,"^"),RCLINE,25,80)
. . D SET($P(FMSDOC,"^",2),RCLINE,40,80)
. . K RCDPDATA
;
; set valmcnt to number of lines in the list
S VALMCNT=RCLINE
Q
;
;
SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ; set array
I $G(FIELD) S STRING=STRING_$S(STRING="":"",1:": ")_$G(RCDPDATA(344,RCRECTDA,FIELD,"E"))
I STRING="",'$G(FIELD) D SET^VALM10(LINE,$J("",80)) Q
I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLBEG,COLEND-COLBEG+1))
I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLBEG,$L(STRING),ON,OFF)
Q
;
;
DIQ3441(DA,DR) ; diq call to retrieve data for dr fields in file 344.1
N D0,DIC,DIQ,DIQ2,YY
K RCDPDATA(344.1,DA)
S DIQ(0)="IE",DIC="^RCY(344.1,",DIQ="RCDPDATA" D EN^DIQ1
Q
;
;
HDR ; header code for list manager display
N DATE,RCDPDATA,SPACE
D DIQ3441(RCDEPTDA,".01:1")
S SPACE="",$P(SPACE," ",80)=""
S VALMHDR(1)=$E(" Deposit #: "_RCDPDATA(344.1,RCDEPTDA,.01,"E")_SPACE,1,39)_" Deposit Status: "_RCDPDATA(344.1,RCDEPTDA,.12,"E")
S VALMHDR(2)=$E("Deposit Date: "_RCDPDATA(344.1,RCDEPTDA,.03,"E")_SPACE,1,39)
S DATE=RCDPDATA(344.1,RCDEPTDA,.07,"E"),DATE=$P(DATE,"@")_" "_$P($P(DATE,"@",2),":",1,2)
I RCDPDATA(344.1,RCDEPTDA,.06,"I")=.5 S RCDPDATA(344.1,RCDEPTDA,.06,"E")="accounts receivable"
S VALMHDR(3)=$E(" Opened By: "_RCDPDATA(344.1,RCDEPTDA,.06,"E")_SPACE,1,39)_"Date/Time Opened: "_DATE
S DATE=RCDPDATA(344.1,RCDEPTDA,.11,"E"),DATE=$P(DATE,"@")_" "_$P($P(DATE,"@",2),":",1,2)
I RCDPDATA(344.1,RCDEPTDA,.1,"I")=.5 S RCDPDATA(344.1,RCDEPTDA,.1,"E")="accounts receivable"
S VALMHDR(4)=$E("Confirmed By: "_RCDPDATA(344.1,RCDEPTDA,.1,"E")_SPACE,1,39)_"Date/Time Confirmed: "_DATE
;
I RCDPDATA(344.1,RCDEPTDA,.11,"I") S VALMSG="Deposit confirmed on "_RCDPDATA(344.1,RCDEPTDA,.11,"E")
Q
;
;
EXIT ; exit list manager option and clean up
K ^TMP("RCDPDPLM",$J)
Q
;
;
FASTEXIT ; this is called by the protocol file to exit any of the deposit
; processing listmanager screens
N DIR,DIQ2,DTOUT,DUOUT,X,Y
;
S DIR(0)="YO",DIR("B")="NO"
S DIR("A")=" Exit option entirely"
D ^DIR
I $G(DTOUT)!($G(DUOUT)) S Y=-1
I $G(DIRUT)!(Y) S RCDPFXIT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPDPLM 6535 printed Oct 16, 2024@17:44:52 Page 2
RCDPDPLM ;WISC/RFJ - deposit profile listmanager top routine ;1 Jun 99
+1 ;;4.5;Accounts Receivable;**114,149,304**;Mar 20, 1995;Build 104
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 NEW RCDEPTDA,RCDPFXIT
+5 ;
+6 FOR
Begin DoDot:1
+7 ; PRCA*4.5*304 allow adding new deposit
WRITE !!
SET RCDEPTDA=$$PREPDEPT^RCDPUDEP()
+8 IF RCDEPTDA<1
SET RCDEPTDA=0
QUIT
+9 DO EN^VALM("RCDP DEPOSIT PROFILE")
+10 ; fast exit
+11 IF $GET(RCDPFXIT)
SET RCDEPTDA=0
End DoDot:1
if 'RCDEPTDA
QUIT
+12 QUIT
+13 ;
+14 ;
INIT ; initialization for list manager list
+1 NEW COMMDA,FMSDOC,RCDEPCNT,RCDEPTOT,RCDPDATA,RCLINE,RCRECTDA,STATUS
+2 KILL ^TMP("RCDPDPLM",$JOB),^TMP("VALM VIDEO",$JOB)
+3 ;
+4 ; fast exit
+5 IF $GET(RCDPFXIT)
SET VALMQUIT=1
QUIT
+6 ;
+7 ; set the listmanager line number
+8 SET RCLINE=0
+9 ;
+10 SET RCRECTDA=0
FOR
SET RCRECTDA=$ORDER(^RCY(344,"AD",RCDEPTDA,RCRECTDA))
if 'RCRECTDA
QUIT
Begin DoDot:1
+11 DO DIQ344^RCDPRPLM(RCRECTDA,".01:999;")
+12 SET RCLINE=RCLINE+1
+13 ; create an index array for bill lookup in list
+14 SET ^TMP("RCDPDPLM",$JOB,"IDX",RCLINE,RCLINE)=RCRECTDA
+15 DO SET(RCLINE,RCLINE,1,80,0,IORVON,IORVOFF)
+16 ; receipt
+17 ;PRCA*4.5*304
DO SET("",RCLINE,5,18,.01)
+18 ; type of payment
+19 ;PRCA*4.5*304
DO SET("",RCLINE,19,36,.04)
+20 ; date opened
+21 IF RCDPDATA(344,RCRECTDA,.03,"I")
Begin DoDot:2
+22 DO SET($EXTRACT(RCDPDATA(344,RCRECTDA,.03,"I"),4,5)_"/"_$EXTRACT(RCDPDATA(344,RCRECTDA,.03,"I"),6,7)_"/"_$EXTRACT(RCDPDATA(344,RCRECTDA,.03,"I"),2,3),RCLINE,37,44)
End DoDot:2
+23 ; by (check for null before calling set)
+24 IF RCDPDATA(344,RCRECTDA,.02,"E")'=""
Begin DoDot:2
+25 SET X=$EXTRACT($PIECE(RCDPDATA(344,RCRECTDA,.02,"E"),",",2))_$EXTRACT(RCDPDATA(344,RCRECTDA,.02,"E"))
+26 IF RCDPDATA(344,RCRECTDA,.02,"I")=.5
SET X="ar"
+27 DO SET(X,RCLINE,46,47)
End DoDot:2
+28 ; date processed
+29 IF RCDPDATA(344,RCRECTDA,.08,"I")
Begin DoDot:2
+30 DO SET($EXTRACT(RCDPDATA(344,RCRECTDA,.08,"I"),4,5)_"/"_$EXTRACT(RCDPDATA(344,RCRECTDA,.08,"I"),6,7)_"/"_$EXTRACT(RCDPDATA(344,RCRECTDA,.08,"I"),2,3),RCLINE,49,56)
End DoDot:2
+31 ; by (check for null before calling set)
+32 IF RCDPDATA(344,RCRECTDA,.07,"E")'=""
Begin DoDot:2
+33 SET X=$EXTRACT($PIECE(RCDPDATA(344,RCRECTDA,.07,"E"),",",2))_$EXTRACT(RCDPDATA(344,RCRECTDA,.07,"E"))
+34 IF RCDPDATA(344,RCRECTDA,.07,"I")=.5
SET X="ar"
+35 DO SET(X,RCLINE,59,60)
End DoDot:2
+36 ; number of transactions
+37 DO SET($JUSTIFY(RCDPDATA(344,RCRECTDA,101,"E"),8),RCLINE,61,69)
+38 ; total dollars
+39 DO SET($JUSTIFY(RCDPDATA(344,RCRECTDA,.15,"E"),10,2),RCLINE,70,79)
+40 ; calculate totals
+41 SET RCDEPCNT=$GET(RCDEPCNT)+RCDPDATA(344,RCRECTDA,101,"E")
+42 SET RCDEPTOT=$GET(RCDEPTOT)+RCDPDATA(344,RCRECTDA,.15,"E")
+43 KILL RCDPDATA
End DoDot:1
+44 ;
+45 IF RCLINE=0
SET RCLINE=RCLINE+1
DO SET(" *** No RECEIPTS for this deposit ***",RCLINE,1,80)
+46 ;
+47 ; show totals
+48 SET RCLINE=RCLINE+1
+49 DO SET(" -------- --------",RCLINE,1,80)
+50 SET RCLINE=RCLINE+1
+51 DO SET(" TOTAL DOLLARS FOR DEPOSIT",RCLINE,1,80)
+52 DO SET($JUSTIFY($GET(RCDEPCNT),8),RCLINE,61,69)
+53 DO SET($JUSTIFY($GET(RCDEPTOT),10,2),RCLINE,70,79)
+54 ;
+55 ; deposit data displayed on screen
+56 DO DIQ3441(RCDEPTDA,".01:1")
+57 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+58 SET RCLINE=RCLINE+1
DO SET(" Bank: "_RCDPDATA(344.1,RCDEPTDA,.13,"E"),RCLINE,1,80)
+59 SET RCLINE=RCLINE+1
DO SET(" Bank Trace Number: "_RCDPDATA(344.1,RCDEPTDA,.05,"E"),RCLINE,1,80)
+60 SET RCLINE=RCLINE+1
DO SET(" Agency Location Code: "_RCDPDATA(344.1,RCDEPTDA,.14,"E"),RCLINE,1,80)
+61 SET RCLINE=RCLINE+1
DO SET(" Agency Title: "_RCDPDATA(344.1,RCDEPTDA,.17,"E"),RCLINE,1,80)
+62 ;
+63 ; display comments if there are any
+64 IF $ORDER(^RCY(344.1,RCDEPTDA,1,0))
Begin DoDot:1
+65 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+66 SET RCLINE=RCLINE+1
DO SET("Comments",RCLINE,1,80,0,IOUON,IOUOFF)
+67 SET COMMDA=0
FOR
SET COMMDA=$ORDER(^RCY(344.1,RCDEPTDA,1,COMMDA))
if 'COMMDA
QUIT
Begin DoDot:2
+68 SET RCLINE=RCLINE+1
DO SET(^RCY(344.1,RCDEPTDA,1,COMMDA,0),RCLINE,1,80)
End DoDot:2
End DoDot:1
+69 ;
+70 ; display FMS CR documents if turned on
+71 IF $GET(^DISV(DUZ,"RCDPDPLM","SHOWFMS"))
Begin DoDot:1
+72 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+73 SET RCLINE=RCLINE+1
DO SET("FMS CR Documents",RCLINE,1,80,0,IOUON,IOUOFF)
+74 SET RCRECTDA=0
FOR
SET RCRECTDA=$ORDER(^RCY(344,"AD",RCDEPTDA,RCRECTDA))
if 'RCRECTDA
QUIT
Begin DoDot:2
+75 DO DIQ344^RCDPRPLM(RCRECTDA,".01;.14;")
+76 SET FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
+77 SET RCLINE=RCLINE+1
+78 DO SET("",RCLINE,5,80,.01)
+79 DO SET("",RCLINE,17,80,.14)
+80 DO SET($PIECE(FMSDOC,"^"),RCLINE,25,80)
+81 DO SET($PIECE(FMSDOC,"^",2),RCLINE,40,80)
+82 KILL RCDPDATA
End DoDot:2
End DoDot:1
+83 ;
+84 ; set valmcnt to number of lines in the list
+85 SET VALMCNT=RCLINE
+86 QUIT
+87 ;
+88 ;
SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ; set array
+1 IF $GET(FIELD)
SET STRING=STRING_$SELECT(STRING="":"",1:": ")_$GET(RCDPDATA(344,RCRECTDA,FIELD,"E"))
+2 IF STRING=""
IF '$GET(FIELD)
DO SET^VALM10(LINE,$JUSTIFY("",80))
QUIT
+3 IF '$DATA(@VALMAR@(LINE,0))
DO SET^VALM10(LINE,$JUSTIFY("",80))
+4 DO SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLBEG,COLEND-COLBEG+1))
+5 IF $GET(ON)]""!($GET(OFF)]"")
DO CNTRL^VALM10(LINE,COLBEG,$LENGTH(STRING),ON,OFF)
+6 QUIT
+7 ;
+8 ;
DIQ3441(DA,DR) ; diq call to retrieve data for dr fields in file 344.1
+1 NEW D0,DIC,DIQ,DIQ2,YY
+2 KILL RCDPDATA(344.1,DA)
+3 SET DIQ(0)="IE"
SET DIC="^RCY(344.1,"
SET DIQ="RCDPDATA"
DO EN^DIQ1
+4 QUIT
+5 ;
+6 ;
HDR ; header code for list manager display
+1 NEW DATE,RCDPDATA,SPACE
+2 DO DIQ3441(RCDEPTDA,".01:1")
+3 SET SPACE=""
SET $PIECE(SPACE," ",80)=""
+4 SET VALMHDR(1)=$EXTRACT(" Deposit #: "_RCDPDATA(344.1,RCDEPTDA,.01,"E")_SPACE,1,39)_" Deposit Status: "_RCDPDATA(344.1,RCDEPTDA,.12,"E")
+5 SET VALMHDR(2)=$EXTRACT("Deposit Date: "_RCDPDATA(344.1,RCDEPTDA,.03,"E")_SPACE,1,39)
+6 SET DATE=RCDPDATA(344.1,RCDEPTDA,.07,"E")
SET DATE=$PIECE(DATE,"@")_" "_$PIECE($PIECE(DATE,"@",2),":",1,2)
+7 IF RCDPDATA(344.1,RCDEPTDA,.06,"I")=.5
SET RCDPDATA(344.1,RCDEPTDA,.06,"E")="accounts receivable"
+8 SET VALMHDR(3)=$EXTRACT(" Opened By: "_RCDPDATA(344.1,RCDEPTDA,.06,"E")_SPACE,1,39)_"Date/Time Opened: "_DATE
+9 SET DATE=RCDPDATA(344.1,RCDEPTDA,.11,"E")
SET DATE=$PIECE(DATE,"@")_" "_$PIECE($PIECE(DATE,"@",2),":",1,2)
+10 IF RCDPDATA(344.1,RCDEPTDA,.1,"I")=.5
SET RCDPDATA(344.1,RCDEPTDA,.1,"E")="accounts receivable"
+11 SET VALMHDR(4)=$EXTRACT("Confirmed By: "_RCDPDATA(344.1,RCDEPTDA,.1,"E")_SPACE,1,39)_"Date/Time Confirmed: "_DATE
+12 ;
+13 IF RCDPDATA(344.1,RCDEPTDA,.11,"I")
SET VALMSG="Deposit confirmed on "_RCDPDATA(344.1,RCDEPTDA,.11,"E")
+14 QUIT
+15 ;
+16 ;
EXIT ; exit list manager option and clean up
+1 KILL ^TMP("RCDPDPLM",$JOB)
+2 QUIT
+3 ;
+4 ;
FASTEXIT ; this is called by the protocol file to exit any of the deposit
+1 ; processing listmanager screens
+2 NEW DIR,DIQ2,DTOUT,DUOUT,X,Y
+3 ;
+4 SET DIR(0)="YO"
SET DIR("B")="NO"
+5 SET DIR("A")=" Exit option entirely"
+6 DO ^DIR
+7 IF $GET(DTOUT)!($GET(DUOUT))
SET Y=-1
+8 IF $GET(DIRUT)!(Y)
SET RCDPFXIT=1
+9 QUIT
