Routine: RCBDPSL1

RCBDPSL1 ;WISC/RFJ-patient statement top list manager routine ;1 Dec 00

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

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

INITCONT ;  continue building list

 ;  initialize line counter and transaction counter

 S (RCLINE,RCTRCNT)=0

 ;  initialize patient account totals

 S (RCTOTAL(1),RCTOTAL(2),RCTOTAL(3))=0

 ;  show transactions by statement date

 S RCSTATE=0 F  S RCSTATE=$O(^TMP("RCBDPSLMDATA",$J,RCDEBTDA,RCSTATE)) Q:'RCSTATE  D

 .   ;  display statement date on listmanager screen

 .   S RCLINE=RCLINE+1

 .   S RCSTDATE=RCSTATE I RCSTDATE=10000000 S RCSTDATE="NEW ACTIVITY"

 .   I RCSTDATE S RCSTDATE=RCSTDATE_"00000" S RCSTDATE=$E(RCSTDATE,4,5)_"/"_$E(RCSTDATE,6,7)_"/"_$E(RCSTDATE,2,3)_" @ "_$E(RCSTDATE,9,10)_":"_$E(RCSTDATE,11,12)

 .   D SET("Transactions for LAST Patient Statement as of Date: "_RCSTDATE,RCLINE,1,80,0,IORVON,IORVOFF)

 .   ;  initialize totals by statement date

 .   S (RCTOTAL(4),RCTOTAL(5),RCTOTAL(6))=0

 .   ;  initialize flag marking transactions incomplete

 .   S RCFINCOM=0

 .   ;

 .   S RCDATE=0 F  S RCDATE=$O(^TMP("RCBDPSLMDATA",$J,RCDEBTDA,RCSTATE,RCDATE)) Q:'RCDATE  D

 .   .   S RCTRANDA="" F  S RCTRANDA=$O(^TMP("RCBDPSLMDATA",$J,RCDEBTDA,RCSTATE,RCDATE,RCTRANDA)) Q:RCTRANDA=""  D

 .   .   .   S RCVALUE=^TMP("RCBDPSLMDATA",$J,RCDEBTDA,RCSTATE,RCDATE,RCTRANDA)

 .   .   .   ;

 .   .   .   I 'RCTRANDA D SETBILL

 .   .   .   I RCTRANDA D SETTRAN

 .   .   .   ;

 .   .   .   ;  compute totals by statement date

 .   .   .   S RCTOTAL(4)=RCTOTAL(4)+$P(RCVALUE,"^",2)

 .   .   .   S RCTOTAL(5)=RCTOTAL(5)+$P(RCVALUE,"^",3)

 .   .   .   S RCTOTAL(6)=RCTOTAL(6)+$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5)+$P(RCVALUE,"^",6)

 .   .   .   ;

 .   .   .   ;  compute totals by patient account

 .   .   .   S RCTOTAL(1)=RCTOTAL(1)+$P(RCVALUE,"^",2)

 .   .   .   S RCTOTAL(2)=RCTOTAL(2)+$P(RCVALUE,"^",3)

 .   .   .   S RCTOTAL(3)=RCTOTAL(3)+$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5)+$P(RCVALUE,"^",6)

 .   ;

 .   ;  if transaction was set incomplete on any transactions, show why

 .   I RCFINCOM D

 .   .   S RCLINE=RCLINE+1 D SET("                       * indicates transaction",RCLINE,1,80)

 .   .   S RCLINE=RCLINE+1 D SET("                       * is MARKed INCOMPLETE",RCLINE,1,80)

 .   ;

 .   ;  display totals by statement date

 .   S RCLINE=RCLINE+1

 .   D SET("                                                    --------- -------- --------",RCLINE,1,80)

 .   S RCLINE=RCLINE+1

 .   D SET("TOTAL BY LAST STATEMENT AS OF DATE: "_RCSTDATE,RCLINE,1,80)

 .   D SET($J(RCTOTAL(4),9,2),RCLINE,53,62)

 .   D SET($J(RCTOTAL(5),9,2),RCLINE,62,71)

 .   D SET($J(RCTOTAL(6),9,2),RCLINE,71,80)

 .   ;

 .   ;  if last statement date, check to see if it is equal to what is stored

 .   I RCSTATE=$P($P(RCEVENDA,"^"),".") D

 .   .   S RCOUTBAL=0

 .   .   I +RCTOTAL(4)'=+RCEVENT("PB") S RCOUTBAL=1

 .   .   I +RCTOTAL(5)'=+RCEVENT("IN") S RCOUTBAL=1

 .   .   I +RCTOTAL(6)'=(RCEVENT("AD")+RCEVENT("CC")+RCEVENT("MF")) S RCOUTBAL=1

 .   .   I RCOUTBAL D

 .   .   .   S RCLINE=RCLINE+1

 .   .   .   D SET("          ***** LAST PATIENT STATEMENT OUT OF BALANCE",RCLINE,1,80)

 .   .   .   D SET($J(RCEVENT("PB"),9,2),RCLINE,53,62)

 .   .   .   D SET($J(RCEVENT("IN"),9,2),RCLINE,62,71)

 .   .   .   D SET($J(RCEVENT("AD")+RCEVENT("CC")+RCEVENT("MF"),9,2),RCLINE,71,80)

 .   ;

 .   ;

 .   ;  add some extra lines

 .   S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)

 .   S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)

 ;  show totals of all transactions displayed in listmanager

 S RCLINE=RCLINE+1

 D SET("                                                    --------- -------- --------",RCLINE,1,80)

 S RCLINE=RCLINE+1

 D SET("   TOTAL BALANCE FOR PATIENT ACCOUNT",RCLINE,1,80)

 D SET($J(RCTOTAL(1),9,2),RCLINE,53,62)

 D SET($J(RCTOTAL(2),9,2),RCLINE,62,71)

 D SET($J(RCTOTAL(3),9,2),RCLINE,71,80)

 ;  set valmcnt to number of lines in the list

 S VALMCNT=RCLINE

 D HDR^RCDPAPLM

SETTRAN ;  set a transaction on the listmanager line

 N DATE,RCDPDATA

 ;  get 433 data

 D DIQ433^RCDPTPLM(RCTRANDA,".01;.03;12;19;")

 ;  increment line number / transaction counter

 S RCLINE=RCLINE+1,RCTRCNT=RCTRCNT+1

 ;  bill number

 D SET(RCTRCNT,RCLINE,1,80,0,IORVON,IORVOFF)

 D SET($E($P(RCDPDATA(433,RCTRANDA,.03,"E"),"-",2)_"       ",1,7),RCLINE,6,12)

 ;  set transaction number

 D SET(RCTRANDA,RCLINE,14,23)

 ;  display transaction incomplete

 I $P($G(^PRCA(433,RCTRANDA,0)),"^",10) D SET("*",RCLINE,24,24) S RCFINCOM=1

 ;  set transaction date

 S DATE=$P($G(RCDPDATA(433,RCTRANDA,19,"I")),".") I 'DATE S DATE=" "

 I DATE S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)

 D SET(DATE,RCLINE,25,33)

 ;  set transaction type

 D SET($TR(RCDPDATA(433,RCTRANDA,12,"E"),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz"),RCLINE,35,52)

 D SET($J($P(RCVALUE,"^",2),9,2),RCLINE,53,62)

 D SET($J($P(RCVALUE,"^",3),9,2),RCLINE,62,71)

 ;  add marshal fee and court cost to create admin dollars

 D SET($J($P(RCVALUE,"^",4)+$P(RCVALUE,"^",5)+$P(RCVALUE,"^",6),9,2),RCLINE,71,80)

SETBILL ;  set a bill original amount

 N DATE

 ;  increment line number

 S RCLINE=RCLINE+1

 ;  bill number

 D SET(" ",RCLINE,1,80)

 D SET($E($P($P($G(^PRCA(430,+$P(RCVALUE,"^"),0)),"^"),"-",2)_"       ",1,7),RCLINE,6,12)

 ;  set bill date

 S DATE=RCDATE I 'DATE S DATE=" "

 I DATE S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)

 D SET(DATE,RCLINE,25,33)

 ;  set transaction type

 D SET("Original Amount",RCLINE,35,52)

 D SET($J($P(RCVALUE,"^",2),9,2),RCLINE,53,62)

 D SET($J(0,9,2),RCLINE,62,71)

 ;  add marshal fee and court cost to create admin dollars

 D SET($J(0,9,2),RCLINE,71,80)

SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ;  set array

 I $G(FIELD) S STRING=STRING_$S(STRING="":"",1:": ")_$G(RCDPDATA(433,RCTRANDA,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)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBDPSL1   6264     printed  Mar 13, 2025@20:47:13                                                                                                                                                                                                    Page 2

RCBDPSL1  ;WISC/RFJ-patient statement top list manager routine ;1 Dec 00

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

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

 +3        QUIT

 +4       ;

 +5       ;

INITCONT  ;  continue building list

 +1       ;

 +2       ;  initialize line counter and transaction counter

 +3        SET (RCLINE,RCTRCNT)=0

 +4       ;  initialize patient account totals

 +5        SET (RCTOTAL(1),RCTOTAL(2),RCTOTAL(3))=0

 +6       ;

 +7       ;  show transactions by statement date

 +8        SET RCSTATE=0

FOR

               SET RCSTATE=$ORDER(^TMP("RCBDPSLMDATA",$JOB,RCDEBTDA,RCSTATE))

               if 'RCSTATE

                   QUIT

               Begin DoDot:1

 +9       ;  display statement date on listmanager screen

 +10               SET RCLINE=RCLINE+1

 +11               SET RCSTDATE=RCSTATE

                   IF RCSTDATE=10000000

                       SET RCSTDATE="NEW ACTIVITY"

 +12               IF RCSTDATE

                       SET RCSTDATE=RCSTDATE_"00000"

                       SET RCSTDATE=$EXTRACT(RCSTDATE,4,5)_"/"_$EXTRACT(RCSTDATE,6,7)_"/"_$EXTRACT(RCSTDATE,2,3)_" @ "_$EXTRACT(RCSTDATE,9,10)_":"_$EXTRACT(RCSTDATE,11,12)

 +13               DO SET("Transactions for LAST Patient Statement as of Date: "_RCSTDATE,RCLINE,1,80,0,IORVON,IORVOFF)

 +14      ;  initialize totals by statement date

 +15               SET (RCTOTAL(4),RCTOTAL(5),RCTOTAL(6))=0

 +16      ;  initialize flag marking transactions incomplete

 +17               SET RCFINCOM=0

 +18      ;

 +19               SET RCDATE=0

FOR

                       SET RCDATE=$ORDER(^TMP("RCBDPSLMDATA",$JOB,RCDEBTDA,RCSTATE,RCDATE))

                       if 'RCDATE

                           QUIT

                       Begin DoDot:2

 +20                       SET RCTRANDA=""

FOR

                               SET RCTRANDA=$ORDER(^TMP("RCBDPSLMDATA",$JOB,RCDEBTDA,RCSTATE,RCDATE,RCTRANDA))

                               if RCTRANDA=""

                                   QUIT

                               Begin DoDot:3

 +21                               SET RCVALUE=^TMP("RCBDPSLMDATA",$JOB,RCDEBTDA,RCSTATE,RCDATE,RCTRANDA)

 +22      ;

 +23                               IF 'RCTRANDA

                                       DO SETBILL

 +24                               IF RCTRANDA

                                       DO SETTRAN

 +25      ;

 +26      ;  compute totals by statement date

 +27                               SET RCTOTAL(4)=RCTOTAL(4)+$PIECE(RCVALUE,"^",2)

 +28                               SET RCTOTAL(5)=RCTOTAL(5)+$PIECE(RCVALUE,"^",3)

 +29                               SET RCTOTAL(6)=RCTOTAL(6)+$PIECE(RCVALUE,"^",4)+$PIECE(RCVALUE,"^",5)+$PIECE(RCVALUE,"^",6)

 +30      ;

 +31      ;  compute totals by patient account

 +32                               SET RCTOTAL(1)=RCTOTAL(1)+$PIECE(RCVALUE,"^",2)

 +33                               SET RCTOTAL(2)=RCTOTAL(2)+$PIECE(RCVALUE,"^",3)

 +34                               SET RCTOTAL(3)=RCTOTAL(3)+$PIECE(RCVALUE,"^",4)+$PIECE(RCVALUE,"^",5)+$PIECE(RCVALUE,"^",6)

                               End DoDot:3

                       End DoDot:2

 +35      ;

 +36      ;  if transaction was set incomplete on any transactions, show why

 +37               IF RCFINCOM

                       Begin DoDot:2

 +38                       SET RCLINE=RCLINE+1

                           DO SET("                       * indicates transaction",RCLINE,1,80)

 +39                       SET RCLINE=RCLINE+1

                           DO SET("                       * is MARKed INCOMPLETE",RCLINE,1,80)

                       End DoDot:2

 +40      ;

 +41      ;  display totals by statement date

 +42               SET RCLINE=RCLINE+1

 +43               DO SET("                                                    --------- -------- --------",RCLINE,1,80)

 +44               SET RCLINE=RCLINE+1

 +45               DO SET("TOTAL BY LAST STATEMENT AS OF DATE: "_RCSTDATE,RCLINE,1,80)

 +46               DO SET($JUSTIFY(RCTOTAL(4),9,2),RCLINE,53,62)

 +47               DO SET($JUSTIFY(RCTOTAL(5),9,2),RCLINE,62,71)

 +48               DO SET($JUSTIFY(RCTOTAL(6),9,2),RCLINE,71,80)

 +49      ;

 +50      ;  if last statement date, check to see if it is equal to what is stored

 +51               IF RCSTATE=$PIECE($PIECE(RCEVENDA,"^"),".")

                       Begin DoDot:2

 +52                       SET RCOUTBAL=0

 +53                       IF +RCTOTAL(4)'=+RCEVENT("PB")

                               SET RCOUTBAL=1

 +54                       IF +RCTOTAL(5)'=+RCEVENT("IN")

                               SET RCOUTBAL=1

 +55                       IF +RCTOTAL(6)'=(RCEVENT("AD")+RCEVENT("CC")+RCEVENT("MF"))

                               SET RCOUTBAL=1

 +56                       IF RCOUTBAL

                               Begin DoDot:3

 +57                               SET RCLINE=RCLINE+1

 +58                               DO SET("          ***** LAST PATIENT STATEMENT OUT OF BALANCE",RCLINE,1,80)

 +59                               DO SET($JUSTIFY(RCEVENT("PB"),9,2),RCLINE,53,62)

 +60                               DO SET($JUSTIFY(RCEVENT("IN"),9,2),RCLINE,62,71)

 +61                               DO SET($JUSTIFY(RCEVENT("AD")+RCEVENT("CC")+RCEVENT("MF"),9,2),RCLINE,71,80)

                               End DoDot:3

                       End DoDot:2

 +62      ;

 +63      ;

 +64      ;  add some extra lines

 +65               SET RCLINE=RCLINE+1

                   DO SET(" ",RCLINE,1,80)

 +66               SET RCLINE=RCLINE+1

                   DO SET(" ",RCLINE,1,80)

               End DoDot:1

 +67      ;

 +68      ;  show totals of all transactions displayed in listmanager

 +69       SET RCLINE=RCLINE+1

 +70       DO SET("                                                    --------- -------- --------",RCLINE,1,80)

 +71       SET RCLINE=RCLINE+1

 +72       DO SET("   TOTAL BALANCE FOR PATIENT ACCOUNT",RCLINE,1,80)

 +73       DO SET($JUSTIFY(RCTOTAL(1),9,2),RCLINE,53,62)

 +74       DO SET($JUSTIFY(RCTOTAL(2),9,2),RCLINE,62,71)

 +75       DO SET($JUSTIFY(RCTOTAL(3),9,2),RCLINE,71,80)

 +76      ;

 +77      ;  set valmcnt to number of lines in the list

 +78       SET VALMCNT=RCLINE

 +79       DO HDR^RCDPAPLM

 +80       QUIT

 +81      ;

 +82      ;

SETTRAN   ;  set a transaction on the listmanager line

 +1        NEW DATE,RCDPDATA

 +2       ;

 +3       ;  get 433 data

 +4        DO DIQ433^RCDPTPLM(RCTRANDA,".01;.03;12;19;")

 +5       ;

 +6       ;  increment line number / transaction counter

 +7        SET RCLINE=RCLINE+1

           SET RCTRCNT=RCTRCNT+1

 +8       ;

 +9       ;  bill number

 +10       DO SET(RCTRCNT,RCLINE,1,80,0,IORVON,IORVOFF)

 +11       DO SET($EXTRACT($PIECE(RCDPDATA(433,RCTRANDA,.03,"E"),"-",2)_"       ",1,7),RCLINE,6,12)

 +12      ;

 +13      ;  set transaction number

 +14       DO SET(RCTRANDA,RCLINE,14,23)

 +15      ;

 +16      ;  display transaction incomplete

 +17       IF $PIECE($GET(^PRCA(433,RCTRANDA,0)),"^",10)

               DO SET("*",RCLINE,24,24)

               SET RCFINCOM=1

 +18      ;

 +19      ;  set transaction date

 +20       SET DATE=$PIECE($GET(RCDPDATA(433,RCTRANDA,19,"I")),".")

           IF 'DATE

               SET DATE=" "

 +21       IF DATE

               SET DATE=$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)

 +22       DO SET(DATE,RCLINE,25,33)

 +23      ;

 +24      ;  set transaction type

 +25       DO SET($TRANSLATE(RCDPDATA(433,RCTRANDA,12,"E"),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz"),RCLINE,35,52)

 +26       DO SET($JUSTIFY($PIECE(RCVALUE,"^",2),9,2),RCLINE,53,62)

 +27       DO SET($JUSTIFY($PIECE(RCVALUE,"^",3),9,2),RCLINE,62,71)

 +28      ;  add marshal fee and court cost to create admin dollars

 +29       DO SET($JUSTIFY($PIECE(RCVALUE,"^",4)+$PIECE(RCVALUE,"^",5)+$PIECE(RCVALUE,"^",6),9,2),RCLINE,71,80)

 +30       QUIT

 +31      ;

 +32      ;

SETBILL   ;  set a bill original amount

 +1        NEW DATE

 +2       ;

 +3       ;  increment line number

 +4        SET RCLINE=RCLINE+1

 +5       ;

 +6       ;  bill number

 +7        DO SET(" ",RCLINE,1,80)

 +8        DO SET($EXTRACT($PIECE($PIECE($GET(^PRCA(430,+$PIECE(RCVALUE,"^"),0)),"^"),"-",2)_"       ",1,7),RCLINE,6,12)

 +9       ;

 +10      ;  set bill date

 +11       SET DATE=RCDATE

           IF 'DATE

               SET DATE=" "

 +12       IF DATE

               SET DATE=$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)

 +13       DO SET(DATE,RCLINE,25,33)

 +14      ;

 +15      ;  set transaction type

 +16       DO SET("Original Amount",RCLINE,35,52)

 +17       DO SET($JUSTIFY($PIECE(RCVALUE,"^",2),9,2),RCLINE,53,62)

 +18       DO SET($JUSTIFY(0,9,2),RCLINE,62,71)

 +19      ;  add marshal fee and court cost to create admin dollars

 +20       DO SET($JUSTIFY(0,9,2),RCLINE,71,80)

 +21       QUIT

 +22      ;

 +23      ;

SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ;  set array

 +1        IF $GET(FIELD)

               SET STRING=STRING_$SELECT(STRING="":"",1:": ")_$GET(RCDPDATA(433,RCTRANDA,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

RCBDPSL1.m