RCDPRL ;AITC/CJE - list of receipts report ;23 Aug 2017
;;4.5;Accounts Receivable;**321**;;Build 48
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; -- main entry point for RCDP LIST OF RECIEPTS REPORT
N RCDPFXIT
D EN^VALM("RCDP LIST OF RECEIPTS REPORT")
Q
;
HDR ; -- header code
S VALMHDR(1)=^TMP($J,"RCDPRLIS","HDR",2)
S VALMHDR(2)=^TMP($J,"RCDPRLIS","HDR",3)
S VALMHDR(3)=^TMP($J,"RCDPRLIS","HDR",4)
Q
;
INIT ; -- init variables and list array
N K
S (K,VALMCNT)=0
F S K=$O(^TMP($J,"RCDPRLIS",K)) Q:'K D ;
. S VALMCNT=VALMCNT+1
. D SET^VALM10(VALMCNT,^TMP($J,"RCDPRLIS",K),VALMCNT)
Q
;
RP ; EP - Launch receipt processing list template
; Input: None
; Output: None
;
N IBFASTXT,RCRECTDA,RCK
D EN^VALM2($G(XQORNOD(0)),"S")
I '$D(VALMY) Q
;
S VALMBCK="R"
S RCK=0
F S RCK=$O(VALMY(RCK)) Q:'RCK!$G(RCDPFXIT) D ;
. S RCRECTDA=$G(^TMP($J,"RCDPRLIS","IDX",RCK))
. D EN^VALM("RCDP RECEIPT PROFILE")
. ; fast exit
. I $G(RCDPFXIT) S RCRECTDA=0
I $G(RCDPFXIT) S VALMBCK="Q"
Q
;
HELP ; -- help code
N X
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPRL 1166 printed Oct 16, 2024@17:47:04 Page 2
RCDPRL ;AITC/CJE - list of receipts report ;23 Aug 2017
+1 ;;4.5;Accounts Receivable;**321**;;Build 48
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; -- main entry point for RCDP LIST OF RECIEPTS REPORT
+1 NEW RCDPFXIT
+2 DO EN^VALM("RCDP LIST OF RECEIPTS REPORT")
+3 QUIT
+4 ;
HDR ; -- header code
+1 SET VALMHDR(1)=^TMP($JOB,"RCDPRLIS","HDR",2)
+2 SET VALMHDR(2)=^TMP($JOB,"RCDPRLIS","HDR",3)
+3 SET VALMHDR(3)=^TMP($JOB,"RCDPRLIS","HDR",4)
+4 QUIT
+5 ;
INIT ; -- init variables and list array
+1 NEW K
+2 SET (K,VALMCNT)=0
+3 ;
FOR
SET K=$ORDER(^TMP($JOB,"RCDPRLIS",K))
if 'K
QUIT
Begin DoDot:1
+4 SET VALMCNT=VALMCNT+1
+5 DO SET^VALM10(VALMCNT,^TMP($JOB,"RCDPRLIS",K),VALMCNT)
End DoDot:1
+6 QUIT
+7 ;
RP ; EP - Launch receipt processing list template
+1 ; Input: None
+2 ; Output: None
+3 ;
+4 NEW IBFASTXT,RCRECTDA,RCK
+5 DO EN^VALM2($GET(XQORNOD(0)),"S")
+6 IF '$DATA(VALMY)
QUIT
+7 ;
+8 SET VALMBCK="R"
+9 SET RCK=0
+10 ;
FOR
SET RCK=$ORDER(VALMY(RCK))
if 'RCK!$GET(RCDPFXIT)
QUIT
Begin DoDot:1
+11 SET RCRECTDA=$GET(^TMP($JOB,"RCDPRLIS","IDX",RCK))
+12 DO EN^VALM("RCDP RECEIPT PROFILE")
+13 ; fast exit
+14 IF $GET(RCDPFXIT)
SET RCRECTDA=0
End DoDot:1
+15 IF $GET(RCDPFXIT)
SET VALMBCK="Q"
+16 QUIT
+17 ;
HELP ; -- help code
+1 NEW X
+2 SET X="?"
DO DISP^XQORM1
WRITE !!
+3 QUIT
+4 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
