RCDPRL.m

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 ---RCDPRL   1166     printed  Apr 09, 2024@20:43:41                                                                                                                                                                                                      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       ;