RCDPBTL1.m

RCDPBTL1 ;WISC/RFJ-bill transaction options ;1 Jun 99

 ;;4.5;Accounts Receivable;**114**;Mar 20, 1995

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 Q

 ;

 ;

BILLPROF ;  bill profile

 D EN^VALM("RCDP BILL PROFILE")

 ;

 D INIT^RCDPBTLM

 S VALMBCK="R"

 ;  fast exit

 I $G(RCDPFXIT) S VALMBCK="Q"

 Q

 ;

 ;

TRANPROF ;  transaction profile

 N INDEX,RCTRANDA,VALMBG,VALMLST,VALMY

 S VALMBCK="R"

 ;

 ;  if no transactions, quit

 I '$O(^TMP("RCDPBTLM",$J,"IDX",0)) S VALMSG="There are NO transactions to profile." Q

 ;

 ;  if only one transaction, select that one automatically

 I '$O(^TMP("RCDPBTLM",$J,"IDX",1)) S INDEX=1

 ;

 ;  select the entry from the list

 I '$G(INDEX) D   I 'INDEX Q

 .   ;  if not on first screen, make sure selection begins with 1

 .   S VALMBG=1

 .   ;  if not on last screen, make sure selection ends with last

 .   S VALMLST=$O(^TMP("RCDPBTLM",$J,"IDX",999999999),-1)

 .   D EN^VALM2($G(XQORNOD(0)),"OS")

 .   S INDEX=$O(VALMY(0))

 ;

 S RCTRANDA=+$G(^TMP("RCDPBTLM",$J,"IDX",INDEX,INDEX))

 D EN^VALM("RCDP TRANS PROFILE")

 ;

 D INIT^RCDPBTLM

 S VALMBCK="R"

 ;  fast exit

 I $G(RCDPFXIT) S VALMBCK="Q"

 Q

 ;

 ;

NEWBILL ;  select a new bill

 D FULL^VALM1

 S VALMBCK="R"

 ;

 W !!,"This option will allow you to select a new bill to display."

 W ! S %=$$SELBILL^RCDPBTLM

 I %<1 Q

 S RCBILLDA=%

 ;

 ;  if called from account profile, pick new account

 I $D(^TMP("RCDPAPLM",$J)) S RCDEBTDA=$P(^PRCA(430,RCBILLDA,0),"^",9)

 ;

 D INIT^RCDPBTLM

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RCDPBTL1   1541     printed  Apr 09, 2024@20:47:39                                                                                                                                                                                                    Page 2

RCDPBTL1  ;WISC/RFJ-bill transaction options ;1 Jun 99

 +1       ;;4.5;Accounts Receivable;**114**;Mar 20, 1995

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        QUIT 

 +4       ;

 +5       ;

BILLPROF  ;  bill profile

 +1        DO EN^VALM("RCDP BILL PROFILE")

 +2       ;

 +3        DO INIT^RCDPBTLM

 +4        SET VALMBCK="R"

 +5       ;  fast exit

 +6        IF $GET(RCDPFXIT)

               SET VALMBCK="Q"

 +7        QUIT 

 +8       ;

 +9       ;

TRANPROF  ;  transaction profile

 +1        NEW INDEX,RCTRANDA,VALMBG,VALMLST,VALMY

 +2        SET VALMBCK="R"

 +3       ;

 +4       ;  if no transactions, quit

 +5        IF '$ORDER(^TMP("RCDPBTLM",$JOB,"IDX",0))

               SET VALMSG="There are NO transactions to profile."

               QUIT 

 +6       ;

 +7       ;  if only one transaction, select that one automatically

 +8        IF '$ORDER(^TMP("RCDPBTLM",$JOB,"IDX",1))

               SET INDEX=1

 +9       ;

 +10      ;  select the entry from the list

 +11       IF '$GET(INDEX)

               Begin DoDot:1

 +12      ;  if not on first screen, make sure selection begins with 1

 +13               SET VALMBG=1

 +14      ;  if not on last screen, make sure selection ends with last

 +15               SET VALMLST=$ORDER(^TMP("RCDPBTLM",$JOB,"IDX",999999999),-1)

 +16               DO EN^VALM2($GET(XQORNOD(0)),"OS")

 +17               SET INDEX=$ORDER(VALMY(0))

               End DoDot:1

               IF 'INDEX

                   QUIT 

 +18      ;

 +19       SET RCTRANDA=+$GET(^TMP("RCDPBTLM",$JOB,"IDX",INDEX,INDEX))

 +20       DO EN^VALM("RCDP TRANS PROFILE")

 +21      ;

 +22       DO INIT^RCDPBTLM

 +23       SET VALMBCK="R"

 +24      ;  fast exit

 +25       IF $GET(RCDPFXIT)

               SET VALMBCK="Q"

 +26       QUIT 

 +27      ;

 +28      ;

NEWBILL   ;  select a new bill

 +1        DO FULL^VALM1

 +2        SET VALMBCK="R"

 +3       ;

 +4        WRITE !!,"This option will allow you to select a new bill to display."

 +5        WRITE !

           SET %=$$SELBILL^RCDPBTLM

 +6        IF %<1

               QUIT 

 +7        SET RCBILLDA=%

 +8       ;

 +9       ;  if called from account profile, pick new account

 +10       IF $DATA(^TMP("RCDPAPLM",$JOB))

               SET RCDEBTDA=$PIECE(^PRCA(430,RCBILLDA,0),"^",9)

 +11      ;

 +12       DO INIT^RCDPBTLM

 +13       QUIT