Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPTPLI

RCDPTPLI.m

Go to the documentation of this file.
  1. RCDPTPLI ;WISC/RFJ - transaction profile init to build array ;1 Jun 99
  1. ;;4.5;Accounts Receivable;**114,153,365,372,392**;Mar 20, 1995;Build 10
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ; Reference to FILE #350 in ICR #4541
  1. Q
  1. ;
  1. ;
  1. INIT ; initialization for list manager list
  1. ; requires rctranda
  1. N %,COMMDA,DATA,DATA3,DATA8,RCDPDATA,RCFYDA,RCLINE,RCSPACE,RCX,SHOWBAL,SHOWCOL,TOTAL3,TOTAL8,TRANTYPE,RCTOC
  1. K ^TMP("RCDPTPLM",$J),^TMP("VALM VIDEO",$J)
  1. ;
  1. D DIQ433^RCDPTPLM(RCTRANDA,".01;.03;5.02;5.03;11;12;13;14;15;17;19;42;86;88;")
  1. S TRANTYPE=RCDPDATA(433,RCTRANDA,12,"I")
  1. ;
  1. S RCSPACE="",$P(RCSPACE," ",81)=""
  1. ;
  1. ; set the listmanager line number 1
  1. S RCLINE=1
  1. D SET("Transaction",RCLINE,1,40,.01)
  1. D SET("Type",RCLINE,41,80,12)
  1. ;
  1. S RCLINE=RCLINE+1
  1. D SET(" TransDate",RCLINE,1,80,11)
  1. ; increase/decrease adjustment
  1. I TRANTYPE=1!(TRANTYPE=35) D
  1. . I RCDPDATA(433,RCTRANDA,88,"I") D SET("Contract Adj",RCLINE,47,80)
  1. . D SET("Adjustment",RCLINE,64,80,14)
  1. ; payment
  1. I TRANTYPE=2!(TRANTYPE=34) D SET("Receipt",RCLINE,38,80,13)
  1. ; terminated
  1. I TRANTYPE=8!(TRANTYPE=9) D SET("TermReason",RCLINE,35,80,17)
  1. ;
  1. S RCLINE=RCLINE+1
  1. D SET(" Processed",RCLINE,1,80,19)
  1. D SET(" By",RCLINE,41,80,42)
  1. ;
  1. S RCLINE=RCLINE+1
  1. D SET(" Trans Amt: "_$J(RCDPDATA(433,RCTRANDA,15,"E"),0,2),RCLINE,1,80)
  1. ;
  1. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
  1. ;
  1. ; fiscal year multiple
  1. S RCLINE=RCLINE+1
  1. D SET("Fiscal Year",RCLINE,28,40,0,IOUON,IOUOFF)
  1. D SET("Principal Amount",RCLINE,44,60,0,IOUON,IOUOFF)
  1. D SET("FY Trans Amount",RCLINE,64,80,0,IOUON,IOUOFF)
  1. S RCFYDA=0 F S RCFYDA=$O(^PRCA(433,RCTRANDA,4,RCFYDA)) Q:'RCFYDA D
  1. . S DATA=$G(^PRCA(433,RCTRANDA,4,RCFYDA,0))
  1. . S RCLINE=RCLINE+1
  1. . D SET($J($P(DATA,"^"),38),RCLINE,1,80) ;fiscal year
  1. . D SET($J($P(DATA,"^",2),19,2),RCLINE,41,60) ;prin amt
  1. . D SET($J($P(DATA,"^",5),19,2),RCLINE,60,80) ;fy trans amt
  1. ;
  1. ; admin cost/charge
  1. I TRANTYPE=12!(TRANTYPE=13)!(TRANTYPE=14) D
  1. . S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
  1. . S DATA=$P($G(^PRCA(433,RCTRANDA,2)),"^",1,9)
  1. . I $TR(DATA,"^0")="" Q
  1. . S RCLINE=RCLINE+1 D SET("Administrative Cost Charge:",RCLINE,1,80,0,IOUON,IOUOFF)
  1. . I $P(DATA,"^",1) S RCLINE=RCLINE+1 D SET(" IRS Locator: "_$J($P(DATA,"^",1),10,2),RCLINE,1,80)
  1. . I $P(DATA,"^",2) S RCLINE=RCLINE+1 D SET(" Credit Agency: "_$J($P(DATA,"^",2),10,2),RCLINE,1,80)
  1. . I $P(DATA,"^",3) S RCLINE=RCLINE+1 D SET(" DMV Locator: "_$J($P(DATA,"^",3),10,2),RCLINE,1,80)
  1. . I $P(DATA,"^",4) S RCLINE=RCLINE+1 D SET(" Consumer Rep: "_$J($P(DATA,"^",4),10,2),RCLINE,1,80)
  1. . I $P(DATA,"^",5) S RCLINE=RCLINE+1 D SET(" Marshall Fee: "_$J($P(DATA,"^",5),10,2),RCLINE,1,80)
  1. . I $P(DATA,"^",6) S RCLINE=RCLINE+1 D SET(" Court Cost: "_$J($P(DATA,"^",6),10,2),RCLINE,1,80)
  1. . I $P(DATA,"^",7) S RCLINE=RCLINE+1 D SET("Interest Charge: "_$J($P(DATA,"^",7),10,2),RCLINE,1,80)
  1. . I $P(DATA,"^",8) S RCLINE=RCLINE+1 D SET(" Admin Charge: "_$J($P(DATA,"^",8),10,2),RCLINE,1,80)
  1. . I $P(DATA,"^",9) S RCLINE=RCLINE+1 D SET(" Penalty Charge: "_$J($P(DATA,"^",9),10,2),RCLINE,1,80)
  1. ;
  1. ;
  1. ; collections and balances
  1. ; set flag to display balances if there are any
  1. S DATA8=$P($G(^PRCA(433,RCTRANDA,8)),"^",1,5)
  1. S SHOWBAL=1 I $TR(DATA8,"^0")="" S SHOWBAL=0
  1. ; set flag to display collections if there are any
  1. S DATA3=$P($G(^PRCA(433,RCTRANDA,3)),"^",1,5)
  1. S SHOWCOL=1 I $TR(DATA3,"^0")="" S SHOWCOL=0
  1. ; show data
  1. I SHOWBAL!(SHOWCOL) D
  1. . S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
  1. . F %=1:1:5 S TOTAL3=$G(TOTAL3)+$P(DATA3,"^",%),TOTAL8=$G(TOTAL8)+$P(DATA8,"^",%)
  1. . S RCLINE=RCLINE+1 D SET("Balances",RCLINE,19,26,0,IOUON,IOUOFF)
  1. . I SHOWCOL D SET("Collections",RCLINE,34,55,0,IOUON,IOUOFF)
  1. . S RCLINE=RCLINE+1 D SET(" Principal: "_$J($P(DATA8,"^",1),10,2),RCLINE,1,80)
  1. . I SHOWCOL D SET($J($P(DATA3,"^",1),10,2),RCLINE,35,55)
  1. . S RCLINE=RCLINE+1 D SET(" Interest: "_$J($P(DATA8,"^",2),10,2),RCLINE,1,80)
  1. . I SHOWCOL D SET($J($P(DATA3,"^",2),10,2),RCLINE,35,55)
  1. . S RCLINE=RCLINE+1 D SET("Administrative: "_$J($P(DATA8,"^",3),10,2),RCLINE,1,80)
  1. . I SHOWCOL D SET($J($P(DATA3,"^",3),10,2),RCLINE,35,55)
  1. . S RCLINE=RCLINE+1 D SET(" Marshall Fee: "_$J($P(DATA8,"^",4),10,2),RCLINE,1,80)
  1. . I SHOWCOL D SET($J($P(DATA3,"^",4),10,2),RCLINE,35,55)
  1. . S RCLINE=RCLINE+1 D SET(" Court Cost: "_$J($P(DATA8,"^",5),10,2),RCLINE,1,80,0,IOUON,IOUOFF)
  1. . I SHOWCOL D SET($J($P(DATA3,"^",5),10,2),RCLINE,35,55,0,IOUON,IOUOFF)
  1. . S RCLINE=RCLINE+1 D SET(" Total: "_$J(TOTAL8,10,2),RCLINE,1,80)
  1. . I SHOWCOL D SET($J(TOTAL3,10,2),RCLINE,35,55)
  1. ;
  1. ; brief comments, followup date
  1. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET("Brief Comment",RCLINE,1,80,5.02)
  1. D SET("Follow-up Date",RCLINE,51,80,5.03)
  1. ;
  1. ; comments
  1. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET("Comments:",RCLINE,1,80,0,IOUON,IOUOFF)
  1. I RCDPDATA(433,RCTRANDA,86,"E")'="" S RCLINE=RCLINE+1 D SET("",RCLINE,1,80,86)
  1. S COMMDA=0 F S COMMDA=$O(^PRCA(433,RCTRANDA,7,COMMDA)) Q:'COMMDA D
  1. . S RCX=^PRCA(433,RCTRANDA,7,COMMDA,0)
  1. . S RCLINE=RCLINE+1 D SET($E(RCX,1,79),RCLINE,1,80)
  1. . I $E(RCX,80,159)'="" S RCLINE=RCLINE+1 D SET($E(RCX,80,159),RCLINE,1,80)
  1. . I $E(RCX,160,239)'="" S RCLINE=RCLINE+1 D SET($E(RCX,160,239),RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
  1. ;
  1. ; show integrated billing data
  1. N BILLCAT,BILLDA,BILLNO,IBATYP,IBDA,IBZ,N0,RCDSPFLG,TMPDT,TRCARE
  1. S BILLDA=+$P(^PRCA(433,RCTRANDA,0),"^",2),TRCARE=0
  1. S N0=$G(^PRCA(430,BILLDA,0)),BILLNO=$P(N0,U),BILLCAT=$P(N0,U,2) ; PRCA*4.5*392
  1. ;
  1. ;PRCA*4.5*365 - moved vaild AR Category check to the field DISPLAY ON BILL PROFILE? field
  1. ; in the AR Category (430.2) file. If RCDSPFLG contains NULL or 0, no IB info
  1. ; will display. Otherwise it contains a code that will determine what info is
  1. ; displayed.
  1. S RCDSPFLG=$$GET1^DIQ(430.2,BILLCAT_",",1.04,"I")
  1. I BILLCAT=18 D
  1. .S RCTOC=$P(^PRCA(430,BILLDA,0),"^",16)
  1. .S RCDSPFLG=$$GET1^DIQ(430.2,RCTOC_",",1.04,"I")
  1. .Q
  1. I BILLCAT=31 D ; Tricare Patient category is a special case PRCA*4.5*392
  1. .S IBZ=$O(^IB("ABIL",BILLNO,""),-1) ; get last IB action
  1. .S IBATYP=$$GET1^DIQ(350,IBZ_",",.03,"I") ; get IB action type (file 350.1 ien)
  1. .I "^68^71^"[(U_IBATYP_U) S RCDSPFLG=5,TRCARE=1 ; Tricare RX
  1. .I "^69^72^"[(U_IBATYP_U) S RCDSPFLG=2,TRCARE=1 ; Tricare outpatient
  1. .I "^70^73^"[(U_IBATYP_U) S RCDSPFLG=4,TRCARE=1 ; Tricare inpatient
  1. .Q
  1. I +$G(RCDSPFLG) D
  1. .D STMT^IBRFN1(RCTRANDA)
  1. .I '$D(^TMP("IBRFN1",$J)) Q
  1. .; start on 2nd screen if not there already
  1. .F RCLINE=RCLINE:1:15 D SET(" ",RCLINE,1,80)
  1. .S RCLINE=RCLINE+1 D SET("Integrated Billing Data",RCLINE,1,80,0,IOUON,IOUOFF)
  1. .S IBDA=0 F S IBDA=$O(^TMP("IBRFN1",$J,IBDA)) Q:'IBDA D
  1. ..S DATA=^TMP("IBRFN1",$J,IBDA)
  1. ..;Start PRCA*4.5*372
  1. ..; If piece 7 is not filled in, and it is a pharmacy transaction, the transaction was manually created. Treat like a CC RX.
  1. ..I RCDSPFLG=1,$P(DATA,U,7)="" S RCDSPFLG="MVA"
  1. ..;end PRCA*4.5*372
  1. ..;if more than one ib data transaction to display, skip a line
  1. ..I IBDA>1 S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
  1. ..S RCLINE=RCLINE+1 D SET("IB Ref #: "_$P(DATA,"^"),RCLINE,1,80)
  1. ..; show VA RX via ECME (RCDSPFLG=1)
  1. ..I RCDSPFLG=1 D Q
  1. ...D SET("Pharmacy",RCLINE,28,80)
  1. ...D SET("Charge Amt: "_$J($P(DATA,U,8),0,2),RCLINE,60,80)
  1. ...S RCLINE=RCLINE+1
  1. ...D SET(" Rx#: "_$P(DATA,U,2),RCLINE,1,80)
  1. ...D SET("Drug: "_$P(DATA,U,3),RCLINE,22,80)
  1. ...S TMPDT=$$FMTE^XLFDT($P(DATA,U,7),"2DZ") D SET("Re/Fill Date: "_TMPDT,RCLINE,58,80) ; PRCA*4.5*392
  1. ...S RCLINE=RCLINE+1
  1. ...D SET(" Physician: "_$P(DATA,U,5),RCLINE,1,48)
  1. ...D SET("Days Supply: "_$P(DATA,U,4),RCLINE,48,80)
  1. ...D SET("Qty: "_$P(DATA,U,6),RCLINE,67,80)
  1. ...Q
  1. ..; show outpatient (type of care 430.2 = 4 outpatient care), OR RCDSPFLG=2 (Other Outpatient) or 5 (CC RX)
  1. ..;Start PRCA*4.5*372
  1. ..;Manually billed RX
  1. ..I RCDSPFLG="MVA" D Q
  1. ...D SET("Pharmacy",RCLINE,25,80)
  1. ...S TMPDT=$$FMTE^XLFDT($P(DATA,U,3),"2DZ") D SET("Fill Date: "_TMPDT,RCLINE,38,80) ; PRCA*4.5*392
  1. ...D SET("Charge Amt: "_$J($P(DATA,U,8),0,2),RCLINE,60,80)
  1. ...Q
  1. ..;end PRCA*4.5*372
  1. ..I ($P(^PRCA(430,BILLDA,0),U,16)=4)!(RCDSPFLG=2)!(RCDSPFLG=5) D Q
  1. ...;Start PRCA*4.5*372
  1. ...I RCDSPFLG=5 D Q
  1. ....D SET($S(TRCARE:"Tricare RX",1:"Comm Care RX"),RCLINE,25,80) ; PRCA*4.5*392
  1. ....I TRCARE S $P(DATA,U,3)=$P(DATA,U,2) ; special case for Tricare RX - move fill date to the correct piece PRCA*4.5*392
  1. ....S TMPDT=$$FMTE^XLFDT($P(DATA,U,3),"2DZ") D SET("Fill Date: "_TMPDT,RCLINE,38,80) ; PRCA*4.5*392
  1. ....D SET("Charge Amt: "_$J($P(DATA,U,8),0,2),RCLINE,60,80)
  1. ....Q
  1. ...;end PRCA*4.5*372
  1. ...D SET("Outpatient",RCLINE,26,80)
  1. ...S TMPDT=$$FMTE^XLFDT($P(DATA,U,2),"2DZ") D SET("Visit Date: "_TMPDT,RCLINE,37,80) ; PRCA*4.5*392
  1. ...D SET("Charge Amt: "_$J($P(DATA,U,8),0,2),RCLINE,60,80)
  1. ...Q
  1. ..;Start PRCA*4.5*372
  1. ..; show inpatient [ RCDSPFLG=3 (LTC) or 4 (inpatient) ]
  1. ..D:RCDSPFLG=3 SET("Long Term Care",RCLINE,28,80)
  1. ..D:RCDSPFLG'=3 SET("Inpatient",RCLINE,28,80)
  1. ..;end PRCA*4.5*372
  1. ..D SET("Charge Amt: "_$J($P(DATA,U,8),0,2),RCLINE,60,80)
  1. ..S RCLINE=RCLINE+1
  1. ..S TMPDT=$$FMTE^XLFDT($P(DATA,U,2),"2DZ") D SET(" Admission Date: "_TMPDT,RCLINE,1,80) ; PRCA*4.5*392
  1. ..S TMPDT=$$FMTE^XLFDT($P(DATA,U,5),"2DZ") D SET("Discharge Date: "_TMPDT,RCLINE,56,80) ; PRCA*4.5*392
  1. ..S RCLINE=RCLINE+1
  1. ..S TMPDT=$$FMTE^XLFDT($P(DATA,U,3),"2DZ") D SET(" Bill Cycle Begin Date: "_TMPDT,RCLINE,1,80)
  1. ..S TMPDT=$$FMTE^XLFDT($P(DATA,U,4),"2DZ") D SET("End Date: "_TMPDT,RCLINE,62,80)
  1. ..Q
  1. .K ^TMP("IBRFN1",$J)
  1. .Q
  1. ; set valmcnt to number of lines in the list
  1. S VALMCNT=RCLINE
  1. Q
  1. ;
  1. ;
  1. SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ; set array
  1. I $G(FIELD) S STRING=STRING_$S(STRING="":"",1:": ")_$G(RCDPDATA(433,RCTRANDA,FIELD,"E"))
  1. I STRING="",'$G(FIELD) Q
  1. I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
  1. D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLBEG,COLEND-COLBEG+1))
  1. I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLBEG,$L(STRING),ON,OFF)
  1. Q
  1. ;