- 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 Feb 18, 2025@23:12:37 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 ;