- RCDPAPLI ;WISC/RFJ-account profile top list manager init ;1 Jun 99
- ;;4.5;Accounts Receivable;**114,141,241,303,301,315,350**;Mar 20, 1995;Build 66
- ;;Per VA Directive 6402, this routine should not be modified.
- Q
- ;
- INIT ; init for list manager screen
- N DMCDATA,RCBILLDA,RCCOMM,RCDATA,RCDATE,RCLINE,RCSTATDA,RCTOTAL
- N TOP4,TOP6
- K ^TMP("RCDPAPLM",$J),^TMP("RCDPAPLMX",$J),^TMP("VALM VIDEO",$J)
- ;
- ; fast exit
- I $G(RCDPFXIT) S VALMQUIT=1 Q
- ;
- I '$G(RCDEBTDA) D Q
- . D SET("",1,1,80)
- . D SET("***** Select an ACCOUNT *****",2,1,80)
- . S VALMCNT=2
- . D HDR^RCDPAPLM
- ;
- ; get bills for a debtor
- D GETBILLS^RCDPAPST(RCDEBTDA)
- ;
- I '$O(^TMP("RCDPAPST",$J,0)) D Q
- . D SET("",1,1,80,IORVOFF,IORVOFF)
- . D SET(" ***** Account does not have any bills *****",2,1,80)
- . S VALMCNT=2
- . S RCTOTAL(1)=0
- . D HDR^RCDPAPLM
- ;
- ; set the listmanager line number
- S RCLINE=0
- ;
- S RCDATE=9999999 F S RCDATE=$O(^TMP("RCDPAPST",$J,RCDATE),-1) Q:'RCDATE D
- . S RCSTATDA=0 F S RCSTATDA=$O(^TMP("RCDPAPST",$J,RCDATE,RCSTATDA)) Q:'RCSTATDA D
- . . S RCBILLDA=0 F S RCBILLDA=$O(^TMP("RCDPAPST",$J,RCDATE,RCSTATDA,RCBILLDA)) Q:'RCBILLDA D
- . . . S RCDATA=^TMP("RCDPAPST",$J,RCDATE,RCSTATDA,RCBILLDA)
- . . . ; add up dollars owed by account (all bills)
- . . . S RCTOTAL(1)=$G(RCTOTAL(1))+$P(RCDATA,"^")
- . . . S RCTOTAL(2)=$G(RCTOTAL(2))+$P(RCDATA,"^",2)
- . . . S RCTOTAL(3)=$G(RCTOTAL(3))+$P(RCDATA,"^",3)
- . . . ;
- . . . ; if not a selected status, do not display
- . . . I ("^"_$G(^DISV(DUZ,"RCDPAPLM","STATUS"))_"^")'[("^"_RCSTATDA_"^") Q
- . . . ;
- . . . ; display the bill in listmanager if the status selected
- . . . D SETBILL
- . . . ;
- . . . ; add up dollars owed by account (bills displayed)
- . . . S RCTOTAL(4)=$G(RCTOTAL(4))+$P(RCDATA,"^")
- . . . S RCTOTAL(5)=$G(RCTOTAL(5))+$P(RCDATA,"^",2)
- . . . S RCTOTAL(6)=$G(RCTOTAL(6))+$P(RCDATA,"^",3)
- ;
- ; show totals of all bills displayed in listmanager
- S RCLINE=RCLINE+1
- D SET(" --------- -------- --------",RCLINE,1,80)
- S RCLINE=RCLINE+1
- D SET(" TOTAL BALANCE OWED FOR ALL BILLS DISPLAYED",RCLINE,1,80)
- D SET($J($G(RCTOTAL(4)),9,2),RCLINE,53,62)
- D SET($J($G(RCTOTAL(5)),9,2),RCLINE,62,71)
- D SET($J($G(RCTOTAL(6)),9,2),RCLINE,71,80)
- ;
- ; get the pending payments for the debtor
- S RCTOTAL("PP")=$$PENDPAY^RCDPURET($P(^RCD(340,RCDEBTDA,0),"^"))
- I $O(^TMP($J,"RCDPUREC","PP",0)) D
- . S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
- . S RCLINE=RCLINE+1 D SET("Pending Payments",RCLINE,1,80,0,IORVON,IORVOFF)
- . N %,DATA,DATE,RECEIPT,RECTDA,TRANDA,TYPE
- . S RECTDA=0 F S RECTDA=$O(^TMP($J,"RCDPUREC","PP",RECTDA)) Q:'RECTDA D
- . . S RECEIPT=$P($G(^RCY(344,RECTDA,0)),"^")
- . . S TYPE=$E($P($G(^RC(341.1,+$P(^RCY(344,RECTDA,0),"^",4),0)),"^"),1,14)
- . . S TRANDA=0 F S TRANDA=$O(^TMP($J,"RCDPUREC","PP",RECTDA,TRANDA)) Q:'TRANDA D
- . . . S DATA=^TMP($J,"RCDPUREC","PP",RECTDA,TRANDA)
- . . . S RCLINE=RCLINE+1
- . . . D SET(RECEIPT_"/"_TRANDA,RCLINE,1,80)
- . . . S DATE=$P(DATA,"^",6)
- . . . S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
- . . . D SET(DATE,RCLINE,13,21)
- . . . ; build type of payment display
- . . . S %=$E(TYPE_" ",1,14)
- . . . I $P(DATA,"^",7)'="" S %=%_"/"_$P(DATA,"^",7) ; check #
- . . . I $P(DATA,"^",8)'="" S %=%_"/"_$P(DATA,"^",8) ; bank #
- . . . I $P(DATA,"^",2)'="" S %=%_"/"_$P(DATA,"^",2) ; confirmation
- . . . D SET(%,RCLINE,29,53)
- . . . ; show amount paid
- . . . D SET($J($P(DATA,"^",4),9,2),RCLINE,53,62)
- . S RCLINE=RCLINE+1
- . D SET(" ---------",RCLINE,1,80)
- . S RCLINE=RCLINE+1
- . D SET(" TOTAL PENDING PAYMENTS",RCLINE,1,80)
- . D SET($J($G(RCTOTAL("PP")),9,2),RCLINE,53,62)
- . K ^TMP($J,"RCDPUREC","PP")
- ;
- ; dmc info
- I $D(^RCD(340,"DMC",1,+RCDEBTDA)) D
- . S DMCDATA=$G(^RCD(340,+RCDEBTDA,3))
- . S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
- . S RCLINE=RCLINE+1
- . D SET("** Account forwarded to DMC: "_$S('$P(DMCDATA,"^",2):"",1:$$SLH^RCFN01($P(DMCDATA,"^",2))),RCLINE,1,80)
- . D SET("Total DMC Amount: "_$J($P(DMCDATA,"^",5),9,2),RCLINE,50,80)
- . I $P(DMCDATA,"^",9)'="" D
- . . S RCLINE=RCLINE+1
- . . D SET(" ",RCLINE,1,80)
- . . D SET("Lesser Amt to DMC: "_$J($P(DMCDATA,"^",9),9,2),RCLINE,49,80)
- ; top info
- I $D(^RCD(340,"TOP",+RCDEBTDA)) D
- . S TOP6=$G(^RCD(340,+RCDEBTDA,6)),TOP4=$G(^(4))
- . S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
- . S RCLINE=RCLINE+1
- . D SET("** Account forwarded to TOP: "_$S('$P(TOP6,"^"):"",1:$$SLH^RCFN01($P(TOP6,"^"))),RCLINE,1,80)
- . D SET("Total TOP Amount: "_$J($P(TOP4,"^",3),13,2),RCLINE,45,80)
- . I $P(TOP6,"^",6)'="" D
- . . S RCLINE=RCLINE+1
- . . D SET(" ",RCLINE,1,80)
- . . D SET("TOP Hold Date: "_$$SLH^RCFN01($P(TOP6,"^",6)),RCLINE,45,80)
- ;
- ; cross-servicing info
- I $D(^RCD(340,"TCSP",+RCDEBTDA)) D
- . S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
- . S RCLINE=RCLINE+1
- . ; PRCA*4.5*350
- . D SET^RCDPBPLM("Debt "_$S($$RRD^RCTCSPU(+RCDEBTDA):"Re-",1:"")_"Referred to Cross-Servicing",RCLINE,1,80)
- . D SET("Total CS Debt: "_$J($$TOTALB^RCTCSPU(+RCDEBTDA),13,2),RCLINE,45,80)
- ;
- ; show if hurricane katrina vet
- I $P(^RCD(340,+RCDEBTDA,0),U)["DPT(" S DFN=+^(0) D
- . Q:$$EMGRES^DGUTL(DFN)'["K"
- . S RCLINE=RCLINE+1
- . D SET("EMERGENCY RESPONSE INDICATOR: HURRICANE KATRINA",RCLINE,1,80)
- ;
- ; show comments if they exist
- I $O(^RCD(340,RCDEBTDA,2,0)) D
- . S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
- . S RCLINE=RCLINE+1 D SET("Comments",RCLINE,1,80,0,IOUON,IOUOFF)
- . S RCCOMM=0 F S RCCOMM=$O(^RCD(340,RCDEBTDA,2,RCCOMM)) Q:'RCCOMM D
- . . S RCLINE=RCLINE+1 D SET(^RCD(340,RCDEBTDA,2,RCCOMM,0),RCLINE,1,80)
- ;
- K ^TMP("RCDPAPST",$J)
- ;
- ; set valmcnt to number of lines in the list
- S VALMCNT=RCLINE
- D HDR^RCDPAPLM
- Q
- ;
- ;
- SETBILL ; set a bill on the listmanager line
- N DATE,IBCNDATA,RCDPDATA,REJECT,VALUE
- D DIQ430^RCDPBPLM(RCBILLDA,".01;2;3;8;60;")
- ;
- S RCLINE=RCLINE+1
- ;
- ; create an index array for bill lookup in list
- S ^TMP("RCDPAPLM",$J,"IDX",RCLINE,RCLINE)=RCBILLDA
- ;
- ; bill number
- ;PRCA*4.5*303 - add reject indicator to kbill ; IA# 6060
- S REJECT=$$BILLREJ^IBJTU6($P(RCDPDATA(430,RCBILLDA,.01,"E"),"-",2))
- D SET(RCLINE,RCLINE,1,80,0,IORVON,IORVOFF)
- D SET($S(REJECT:"c",1:"")_$E($P(RCDPDATA(430,RCBILLDA,.01,"E"),"-",2)_" ",1,7),RCLINE,7,14,0) ;PRCA*3.5*315 increase left margin
- ;PRCA*4.5*303 - End
- ;
- ; PRCA*4.5*315 - add "x" or "y" indicator to kbill
- N CSDATE1,CSDATE2,RCIND
- S CSDATE1=$$GET1^DIQ(430,RCBILLDA,"DATE BILL REFERRED TO TCSP","I")
- S CSDATE2=$$GET1^DIQ(430,RCBILLDA,"ORIGINAL DATE REFERRED TO TCSP","I")
- D SET(RCLINE,RCLINE,1,80,0,IORVON,IORVOFF)
- S RCIND=$S(CSDATE1'="":"x",CSDATE2'="":"y",1:"")
- I RCIND]"" D SET(RCIND_$E($P(RCDPDATA(430,RCBILLDA,.01,"E"),"-",2)_" ",1,7),RCLINE,7,15,0)
- I RCIND="" D SET(RCIND_$E($P(RCDPDATA(430,RCBILLDA,.01,"E"),"-",2)_" ",1,7),RCLINE,8,15,0)
- ;PRCA*4.5*315 End
- ;
- ; get date of care
- D DIQ399^RCXFMSUR(RCBILLDA)
- S DATE=$G(IBCNDATA(399,RCBILLDA,151,"I"))
- I 'DATE S DATE=$G(RCDPDATA(430,RCBILLDA,60,"I"))
- S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
- ;D SET(DATE,RCLINE,13,21,0)
- D SET(DATE,RCLINE,17,24,0) ;PRCA*4.5*315
- ;
- ; status (field 8)
- ;D SET("",RCLINE,23,26,8)
- D SET("",RCLINE,27,30,8) ;PRCA*4.5*315
- ;
- ; type of care
- ;D SET("",RCLINE,29,71,2)
- D SET("",RCLINE,33,53,2) ;PRCA*4.5*315
- ;
- ; principle, interest, admin
- D SET($J($P(RCDATA,"^"),9,2),RCLINE,53,62,0)
- D SET($J($P(RCDATA,"^",2),9,2),RCLINE,62,71,0)
- D SET($J($P(RCDATA,"^",3),9,2),RCLINE,71,80,0)
- Q
- ;
- ;
- SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ; set array
- I $G(FIELD) S STRING=STRING_$S(STRING="":"",1:": ")_$G(RCDPDATA(430,RCBILLDA,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)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPAPLI 8395 printed Feb 18, 2025@23:10:12 Page 2
- RCDPAPLI ;WISC/RFJ-account profile top list manager init ;1 Jun 99
- +1 ;;4.5;Accounts Receivable;**114,141,241,303,301,315,350**;Mar 20, 1995;Build 66
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- INIT ; init for list manager screen
- +1 NEW DMCDATA,RCBILLDA,RCCOMM,RCDATA,RCDATE,RCLINE,RCSTATDA,RCTOTAL
- +2 NEW TOP4,TOP6
- +3 KILL ^TMP("RCDPAPLM",$JOB),^TMP("RCDPAPLMX",$JOB),^TMP("VALM VIDEO",$JOB)
- +4 ;
- +5 ; fast exit
- +6 IF $GET(RCDPFXIT)
- SET VALMQUIT=1
- QUIT
- +7 ;
- +8 IF '$GET(RCDEBTDA)
- Begin DoDot:1
- +9 DO SET("",1,1,80)
- +10 DO SET("***** Select an ACCOUNT *****",2,1,80)
- +11 SET VALMCNT=2
- +12 DO HDR^RCDPAPLM
- End DoDot:1
- QUIT
- +13 ;
- +14 ; get bills for a debtor
- +15 DO GETBILLS^RCDPAPST(RCDEBTDA)
- +16 ;
- +17 IF '$ORDER(^TMP("RCDPAPST",$JOB,0))
- Begin DoDot:1
- +18 DO SET("",1,1,80,IORVOFF,IORVOFF)
- +19 DO SET(" ***** Account does not have any bills *****",2,1,80)
- +20 SET VALMCNT=2
- +21 SET RCTOTAL(1)=0
- +22 DO HDR^RCDPAPLM
- End DoDot:1
- QUIT
- +23 ;
- +24 ; set the listmanager line number
- +25 SET RCLINE=0
- +26 ;
- +27 SET RCDATE=9999999
- FOR
- SET RCDATE=$ORDER(^TMP("RCDPAPST",$JOB,RCDATE),-1)
- if 'RCDATE
- QUIT
- Begin DoDot:1
- +28 SET RCSTATDA=0
- FOR
- SET RCSTATDA=$ORDER(^TMP("RCDPAPST",$JOB,RCDATE,RCSTATDA))
- if 'RCSTATDA
- QUIT
- Begin DoDot:2
- +29 SET RCBILLDA=0
- FOR
- SET RCBILLDA=$ORDER(^TMP("RCDPAPST",$JOB,RCDATE,RCSTATDA,RCBILLDA))
- if 'RCBILLDA
- QUIT
- Begin DoDot:3
- +30 SET RCDATA=^TMP("RCDPAPST",$JOB,RCDATE,RCSTATDA,RCBILLDA)
- +31 ; add up dollars owed by account (all bills)
- +32 SET RCTOTAL(1)=$GET(RCTOTAL(1))+$PIECE(RCDATA,"^")
- +33 SET RCTOTAL(2)=$GET(RCTOTAL(2))+$PIECE(RCDATA,"^",2)
- +34 SET RCTOTAL(3)=$GET(RCTOTAL(3))+$PIECE(RCDATA,"^",3)
- +35 ;
- +36 ; if not a selected status, do not display
- +37 IF ("^"_$GET(^DISV(DUZ,"RCDPAPLM","STATUS"))_"^")'[("^"_RCSTATDA_"^")
- QUIT
- +38 ;
- +39 ; display the bill in listmanager if the status selected
- +40 DO SETBILL
- +41 ;
- +42 ; add up dollars owed by account (bills displayed)
- +43 SET RCTOTAL(4)=$GET(RCTOTAL(4))+$PIECE(RCDATA,"^")
- +44 SET RCTOTAL(5)=$GET(RCTOTAL(5))+$PIECE(RCDATA,"^",2)
- +45 SET RCTOTAL(6)=$GET(RCTOTAL(6))+$PIECE(RCDATA,"^",3)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +46 ;
- +47 ; show totals of all bills displayed in listmanager
- +48 SET RCLINE=RCLINE+1
- +49 DO SET(" --------- -------- --------",RCLINE,1,80)
- +50 SET RCLINE=RCLINE+1
- +51 DO SET(" TOTAL BALANCE OWED FOR ALL BILLS DISPLAYED",RCLINE,1,80)
- +52 DO SET($JUSTIFY($GET(RCTOTAL(4)),9,2),RCLINE,53,62)
- +53 DO SET($JUSTIFY($GET(RCTOTAL(5)),9,2),RCLINE,62,71)
- +54 DO SET($JUSTIFY($GET(RCTOTAL(6)),9,2),RCLINE,71,80)
- +55 ;
- +56 ; get the pending payments for the debtor
- +57 SET RCTOTAL("PP")=$$PENDPAY^RCDPURET($PIECE(^RCD(340,RCDEBTDA,0),"^"))
- +58 IF $ORDER(^TMP($JOB,"RCDPUREC","PP",0))
- Begin DoDot:1
- +59 SET RCLINE=RCLINE+1
- DO SET(" ",RCLINE,1,80)
- +60 SET RCLINE=RCLINE+1
- DO SET("Pending Payments",RCLINE,1,80,0,IORVON,IORVOFF)
- +61 NEW %,DATA,DATE,RECEIPT,RECTDA,TRANDA,TYPE
- +62 SET RECTDA=0
- FOR
- SET RECTDA=$ORDER(^TMP($JOB,"RCDPUREC","PP",RECTDA))
- if 'RECTDA
- QUIT
- Begin DoDot:2
- +63 SET RECEIPT=$PIECE($GET(^RCY(344,RECTDA,0)),"^")
- +64 SET TYPE=$EXTRACT($PIECE($GET(^RC(341.1,+$PIECE(^RCY(344,RECTDA,0),"^",4),0)),"^"),1,14)
- +65 SET TRANDA=0
- FOR
- SET TRANDA=$ORDER(^TMP($JOB,"RCDPUREC","PP",RECTDA,TRANDA))
- if 'TRANDA
- QUIT
- Begin DoDot:3
- +66 SET DATA=^TMP($JOB,"RCDPUREC","PP",RECTDA,TRANDA)
- +67 SET RCLINE=RCLINE+1
- +68 DO SET(RECEIPT_"/"_TRANDA,RCLINE,1,80)
- +69 SET DATE=$PIECE(DATA,"^",6)
- +70 SET DATE=$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)
- +71 DO SET(DATE,RCLINE,13,21)
- +72 ; build type of payment display
- +73 SET %=$EXTRACT(TYPE_" ",1,14)
- +74 ; check #
- IF $PIECE(DATA,"^",7)'=""
- SET %=%_"/"_$PIECE(DATA,"^",7)
- +75 ; bank #
- IF $PIECE(DATA,"^",8)'=""
- SET %=%_"/"_$PIECE(DATA,"^",8)
- +76 ; confirmation
- IF $PIECE(DATA,"^",2)'=""
- SET %=%_"/"_$PIECE(DATA,"^",2)
- +77 DO SET(%,RCLINE,29,53)
- +78 ; show amount paid
- +79 DO SET($JUSTIFY($PIECE(DATA,"^",4),9,2),RCLINE,53,62)
- End DoDot:3
- End DoDot:2
- +80 SET RCLINE=RCLINE+1
- +81 DO SET(" ---------",RCLINE,1,80)
- +82 SET RCLINE=RCLINE+1
- +83 DO SET(" TOTAL PENDING PAYMENTS",RCLINE,1,80)
- +84 DO SET($JUSTIFY($GET(RCTOTAL("PP")),9,2),RCLINE,53,62)
- +85 KILL ^TMP($JOB,"RCDPUREC","PP")
- End DoDot:1
- +86 ;
- +87 ; dmc info
- +88 IF $DATA(^RCD(340,"DMC",1,+RCDEBTDA))
- Begin DoDot:1
- +89 SET DMCDATA=$GET(^RCD(340,+RCDEBTDA,3))
- +90 SET RCLINE=RCLINE+1
- DO SET(" ",RCLINE,1,80)
- +91 SET RCLINE=RCLINE+1
- +92 DO SET("** Account forwarded to DMC: "_$SELECT('$PIECE(DMCDATA,"^",2):"",1:$$SLH^RCFN01($PIECE(DMCDATA,"^",2))),RCLINE,1,80)
- +93 DO SET("Total DMC Amount: "_$JUSTIFY($PIECE(DMCDATA,"^",5),9,2),RCLINE,50,80)
- +94 IF $PIECE(DMCDATA,"^",9)'=""
- Begin DoDot:2
- +95 SET RCLINE=RCLINE+1
- +96 DO SET(" ",RCLINE,1,80)
- +97 DO SET("Lesser Amt to DMC: "_$JUSTIFY($PIECE(DMCDATA,"^",9),9,2),RCLINE,49,80)
- End DoDot:2
- End DoDot:1
- +98 ; top info
- +99 IF $DATA(^RCD(340,"TOP",+RCDEBTDA))
- Begin DoDot:1
- +100 SET TOP6=$GET(^RCD(340,+RCDEBTDA,6))
- SET TOP4=$GET(^(4))
- +101 SET RCLINE=RCLINE+1
- DO SET(" ",RCLINE,1,80)
- +102 SET RCLINE=RCLINE+1
- +103 DO SET("** Account forwarded to TOP: "_$SELECT('$PIECE(TOP6,"^"):"",1:$$SLH^RCFN01($PIECE(TOP6,"^"))),RCLINE,1,80)
- +104 DO SET("Total TOP Amount: "_$JUSTIFY($PIECE(TOP4,"^",3),13,2),RCLINE,45,80)
- +105 IF $PIECE(TOP6,"^",6)'=""
- Begin DoDot:2
- +106 SET RCLINE=RCLINE+1
- +107 DO SET(" ",RCLINE,1,80)
- +108 DO SET("TOP Hold Date: "_$$SLH^RCFN01($PIECE(TOP6,"^",6)),RCLINE,45,80)
- End DoDot:2
- End DoDot:1
- +109 ;
- +110 ; cross-servicing info
- +111 IF $DATA(^RCD(340,"TCSP",+RCDEBTDA))
- Begin DoDot:1
- +112 SET RCLINE=RCLINE+1
- DO SET(" ",RCLINE,1,80)
- +113 SET RCLINE=RCLINE+1
- +114 ; PRCA*4.5*350
- +115 DO SET^RCDPBPLM("Debt "_$SELECT($$RRD^RCTCSPU(+RCDEBTDA):"Re-",1:"")_"Referred to Cross-Servicing",RCLINE,1,80)
- +116 DO SET("Total CS Debt: "_$JUSTIFY($$TOTALB^RCTCSPU(+RCDEBTDA),13,2),RCLINE,45,80)
- End DoDot:1
- +117 ;
- +118 ; show if hurricane katrina vet
- +119 IF $PIECE(^RCD(340,+RCDEBTDA,0),U)["DPT("
- SET DFN=+^(0)
- Begin DoDot:1
- +120 if $$EMGRES^DGUTL(DFN)'["K"
- QUIT
- +121 SET RCLINE=RCLINE+1
- +122 DO SET("EMERGENCY RESPONSE INDICATOR: HURRICANE KATRINA",RCLINE,1,80)
- End DoDot:1
- +123 ;
- +124 ; show comments if they exist
- +125 IF $ORDER(^RCD(340,RCDEBTDA,2,0))
- Begin DoDot:1
- +126 SET RCLINE=RCLINE+1
- DO SET(" ",RCLINE,1,80)
- +127 SET RCLINE=RCLINE+1
- DO SET("Comments",RCLINE,1,80,0,IOUON,IOUOFF)
- +128 SET RCCOMM=0
- FOR
- SET RCCOMM=$ORDER(^RCD(340,RCDEBTDA,2,RCCOMM))
- if 'RCCOMM
- QUIT
- Begin DoDot:2
- +129 SET RCLINE=RCLINE+1
- DO SET(^RCD(340,RCDEBTDA,2,RCCOMM,0),RCLINE,1,80)
- End DoDot:2
- End DoDot:1
- +130 ;
- +131 KILL ^TMP("RCDPAPST",$JOB)
- +132 ;
- +133 ; set valmcnt to number of lines in the list
- +134 SET VALMCNT=RCLINE
- +135 DO HDR^RCDPAPLM
- +136 QUIT
- +137 ;
- +138 ;
- SETBILL ; set a bill on the listmanager line
- +1 NEW DATE,IBCNDATA,RCDPDATA,REJECT,VALUE
- +2 DO DIQ430^RCDPBPLM(RCBILLDA,".01;2;3;8;60;")
- +3 ;
- +4 SET RCLINE=RCLINE+1
- +5 ;
- +6 ; create an index array for bill lookup in list
- +7 SET ^TMP("RCDPAPLM",$JOB,"IDX",RCLINE,RCLINE)=RCBILLDA
- +8 ;
- +9 ; bill number
- +10 ;PRCA*4.5*303 - add reject indicator to kbill ; IA# 6060
- +11 SET REJECT=$$BILLREJ^IBJTU6($PIECE(RCDPDATA(430,RCBILLDA,.01,"E"),"-",2))
- +12 DO SET(RCLINE,RCLINE,1,80,0,IORVON,IORVOFF)
- +13 ;PRCA*3.5*315 increase left margin
- DO SET($SELECT(REJECT:"c",1:"")_$EXTRACT($PIECE(RCDPDATA(430,RCBILLDA,.01,"E"),"-",2)_" ",1,7),RCLINE,7,14,0)
- +14 ;PRCA*4.5*303 - End
- +15 ;
- +16 ; PRCA*4.5*315 - add "x" or "y" indicator to kbill
- +17 NEW CSDATE1,CSDATE2,RCIND
- +18 SET CSDATE1=$$GET1^DIQ(430,RCBILLDA,"DATE BILL REFERRED TO TCSP","I")
- +19 SET CSDATE2=$$GET1^DIQ(430,RCBILLDA,"ORIGINAL DATE REFERRED TO TCSP","I")
- +20 DO SET(RCLINE,RCLINE,1,80,0,IORVON,IORVOFF)
- +21 SET RCIND=$SELECT(CSDATE1'="":"x",CSDATE2'="":"y",1:"")
- +22 IF RCIND]""
- DO SET(RCIND_$EXTRACT($PIECE(RCDPDATA(430,RCBILLDA,.01,"E"),"-",2)_" ",1,7),RCLINE,7,15,0)
- +23 IF RCIND=""
- DO SET(RCIND_$EXTRACT($PIECE(RCDPDATA(430,RCBILLDA,.01,"E"),"-",2)_" ",1,7),RCLINE,8,15,0)
- +24 ;PRCA*4.5*315 End
- +25 ;
- +26 ; get date of care
- +27 DO DIQ399^RCXFMSUR(RCBILLDA)
- +28 SET DATE=$GET(IBCNDATA(399,RCBILLDA,151,"I"))
- +29 IF 'DATE
- SET DATE=$GET(RCDPDATA(430,RCBILLDA,60,"I"))
- +30 SET DATE=$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)
- +31 ;D SET(DATE,RCLINE,13,21,0)
- +32 ;PRCA*4.5*315
- DO SET(DATE,RCLINE,17,24,0)
- +33 ;
- +34 ; status (field 8)
- +35 ;D SET("",RCLINE,23,26,8)
- +36 ;PRCA*4.5*315
- DO SET("",RCLINE,27,30,8)
- +37 ;
- +38 ; type of care
- +39 ;D SET("",RCLINE,29,71,2)
- +40 ;PRCA*4.5*315
- DO SET("",RCLINE,33,53,2)
- +41 ;
- +42 ; principle, interest, admin
- +43 DO SET($JUSTIFY($PIECE(RCDATA,"^"),9,2),RCLINE,53,62,0)
- +44 DO SET($JUSTIFY($PIECE(RCDATA,"^",2),9,2),RCLINE,62,71,0)
- +45 DO SET($JUSTIFY($PIECE(RCDATA,"^",3),9,2),RCLINE,71,80,0)
- +46 QUIT
- +47 ;
- +48 ;
- SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ; set array
- +1 IF $GET(FIELD)
- SET STRING=STRING_$SELECT(STRING="":"",1:": ")_$GET(RCDPDATA(430,RCBILLDA,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