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

RCDPEAD3.m

Go to the documentation of this file.
  1. RCDPEAD3 ;ALB/PJH - AUTO DECREASE ; 6/27/19 2:43pm
  1. ;;4.5;Accounts Receivable;**345,349**;Mar 20, 1995;Build 44
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;Read ^IBM(361.1) via Private IA 4051
  1. ;
  1. EN(RCDAY) ; EP - EN^RCDPEM. Auto Decrease - applies to auto-posted claims only
  1. ;
  1. ; INPUT RCDAY - Day to search for auto-posted but not decreased lines
  1. ; OUTPUT - Auto-decreases claims
  1. ;
  1. N IEN350,IENS41,J,RC6AM,RCARRAY,RCBAL3RD,RCBILL,RCDAYS,RCERA,RCLINE,RCPAID,RCQIEN,RCRTYPE,RCSECS,STAT,STATUS,X
  1. ; Nightly process does not pass RCDAY. Default: Run for most recent business day minus RCDAYS delay
  1. S RCDAYS=+$$GET1^DIQ(342,"1,",.15,"E")
  1. I $G(RCDAY)="" D ;
  1. . S RCSECS=$P($H,",",2)
  1. . S RC6AM=21600
  1. . S RCDAY=$$FMADD^XLFDT(DT,$S(RCSECS<RC6AM:-1-RCDAYS,1:-RCDAYS))
  1. ;
  1. ; Status of 1st Party Claim can be OPEN,ACTIVE
  1. F J=16,42 S STAT(J)=""
  1. ;
  1. ; Scan "F" index of ERA file for ERA entries with AUTOPOST DATE field 344.41 #9 matching RCDAY
  1. S RCERA=0
  1. F S RCERA=$O(^RCY(344.4,"F",RCDAY,RCERA)) Q:'RCERA D
  1. . ; Build index to scratchpad for this ERA
  1. . K RCARRAY
  1. . D BUILD^RCDPEAP(RCERA,.RCARRAY)
  1. . ;
  1. . ; Scan ERA DETAIL entries in #344.41 for auto-posted medical claims
  1. . S RCLINE=0
  1. . F S RCLINE=$O(^RCY(344.4,"F",RCDAY,RCERA,RCLINE)) Q:'RCLINE D
  1. . . ; Process line
  1. . . I $$GET1^DIQ(344.41,RCLINE_","_RCERA_",",10.01,"I") Q ; PRCA*4.5*349 - Already processed before
  1. . . D EN2(RCERA,.RCARRAY,RCLINE)
  1. . . D FLAG(RCERA,RCLINE) ; PRCA*4.5*349 - Flag line as having been processed
  1. ;
  1. ; Scan entries in RCDPE FIRST PARTY CHARGE QUEUE that could not be decreased due to existence of a pre-pay
  1. S RCQIEN=0
  1. F S RCQIEN=$O(^RCY(344.74,RCQIEN)) Q:'RCQIEN D ;
  1. . S IEN350=$$GET1^DIQ(344.74,RCQIEN_",",.01,"I")
  1. . S RCBILL=$$GET1^DIQ(344.74,RCQIEN_",",.02,"I")
  1. . S IENS41=$$GET1^DIQ(344.74,RCQIEN_",",.04,"E")
  1. . S (RCPAID,RCBAL3RD)=+$$GET1^DIQ(344.41,IENS41,.03)
  1. . ; Access to file 350 DBIA4541.
  1. . S STATUS=$$GET1^DIQ(350,IEN350_",",.05,"I")
  1. . I STATUS'=8 D DEL74(RCQIEN) ; If charge is not on hold remove from queue, but continue with checks.
  1. . I STATUS'=3,STATUS'=8 Q ; Charge not on hold or billed so quit
  1. . ;
  1. . ; On hold charge with no pre-pay. Release from hold.
  1. . I STATUS=8 D ;
  1. . . I $$PREPAY(IEN350)=1 Q ; Still has open pre-pay so quit
  1. . . S IBNOS=IEN350,IBSEQNO=1,IBDUZ=.5
  1. . . S DFN=$$GET1^DIQ(350,IEN350_",",.02,"I") ; DBIA4541
  1. . . D ^IBR ; Call to ^IBR allowed by DBIA7007
  1. . . D DEL74(RCQIEN) ; Charge released from hold, remove from queue.
  1. . ;
  1. . S STATUS=$$GET1^DIQ(350,IEN350_",",.05,"I")
  1. . I STATUS'=3 Q
  1. . ;
  1. . S X=$$PROCESS(IEN350,RCBILL,RCPAID,.RCBAL3RD) ; Process this charge for attempted auto-decrease
  1. ;
  1. Q
  1. ;
  1. EN2(RCERA,RCARRAY,RCLINE) ; Auto-decrease selected lines
  1. ; Input: RCERA - ERA number
  1. ; RCARRAY - Array of ERA Scratchpad lines
  1. ; RCLINE - ERA line sequence
  1. ;
  1. ; Get claim number RCBILL for the ERA line using EOB #361.1 pointer
  1. N AMT,COMMENT,COPAY,DEBT,DFN,EOBIEN,FDA,IBNOS,IBSEQNO,IBDUZ,PRCADB,PRCATY,QUIT
  1. N RCBAL,RCBILL,RCCLAIM,RCCOPAY,RCGROUP,RCLST,RCSTATUS,RCSUB,RCTRANDA,RCTYP3,RCTYPE,STATUS
  1. ;
  1. ; Get amount paid on the line
  1. S IENS41=RCLINE_","_RCERA_","
  1. S (RCPAID,RCBAL3RD)=+$$GET1^DIQ(344.41,IENS41,.03)
  1. ;
  1. ; Quit if this is a no-payment line
  1. I RCPAID=0 Q
  1. ;
  1. ; Get pointer to EOB file #361.1 from ERA DETAIL
  1. S EOBIEN=$P($G(^RCY(344.4,RCERA,1,RCLINE,0)),U,2),RCBILL=0
  1. ;
  1. ; Get ^DGCR(399 pointer (DINUM for #430 file)
  1. S:EOBIEN RCBILL=$P($G(^IBM(361.1,EOBIEN,0)),U) Q:'RCBILL
  1. S RCTYP3=$$TYP^IBRFN(RCBILL) ; Get type of bill and only match with same type. DBIA 2031 covers call to TYP^IBRFN
  1. ;
  1. ; If claim has been split/edit and claim changed in APAR do not auto decrease - BOOKMARK - VERIFY WITH EPAY TEAM
  1. Q:$$SPLIT^RCDPEAD(RCERA,RCLINE,RCBILL,.RCARRAY)
  1. ;
  1. ; Do not auto decrease if claim is referred to General Council
  1. Q:$P($G(^PRCA(430,RCBILL,6)),U,4)]""
  1. ;
  1. ; Get copay details
  1. K ^TMP("IBRBF",$J)
  1. D RELBILL^IBRFN(RCBILL) ; Integration agreement DBIA3124
  1. ; Quit if no related 1st Party claim
  1. I '$O(^TMP("IBRBF",$J,RCBILL,0)) Q
  1. ; Get COPAY amount and COPAY claim IEN for #430
  1. ;
  1. S QUIT=0
  1. S RCSUB=0
  1. F S RCSUB=$O(^TMP("IBRBF",$J,RCBILL,RCSUB)) Q:'RCSUB D Q:QUIT ;
  1. . S RCTYPE=$$GET1^DIQ(350,RCSUB_",",.03,"I") ; Access to file 350 covered by DBIA4541
  1. . S RCGROUP=$$GET1^DIQ(350,RCSUB_",",".03:.11","I") ; Billing group 4=OPT COPAY, 5=RX COPAY
  1. . I RCTYPE=""!(RCGROUP="") Q
  1. . I $D(^RC(342,1,14,"ACE",1,RCTYPE)) D ; Action type is flagged for auto-decrease
  1. . . I RCTYP3="O",RCGROUP'=4 Q ; Only match O/P claim with O/P charge
  1. . . I RCTYP3="PH",RCGROUP'=5 Q ; Only match RX claim with RX charge
  1. . . S RCLST(RCBILL,RCSUB)=""
  1. . . ; If charge is on hold then release it.
  1. . . S STATUS=$$GET1^DIQ(350,RCSUB_",",.05,"I") ; DBIA4541
  1. . . I STATUS=8 D ; Charge is in on-hold, can it be released?
  1. . . . I $$PREPAY(RCSUB)=1 D QUEUE(RCSUB,RCBILL,IENS41) Q ; Open prepay, queue the charge to check later
  1. . . . S IBNOS=RCSUB,IBSEQNO=1,IBDUZ=.5
  1. . . . S DFN=$$GET1^DIQ(350,RCSUB_",",.02,"I") ; DBIA4541
  1. . . . D ^IBR ; Call to ^IBR allowed by DBIA7007
  1. . . ;
  1. . . S STATUS=$$GET1^DIQ(350,RCSUB_",",.05,"I") ; DBIA4541. Check status again, after release from hold.
  1. . . I STATUS'=3 Q ; Status should be billed if charge was released.
  1. . . ;
  1. . . S QUIT=$$PROCESS(RCSUB,RCBILL,RCPAID,.RCBAL3RD) ; Process this charge for attempted auto-decrease
  1. ;
  1. K ^TMP("IBRBF",$J)
  1. Q
  1. ;
  1. PROCESS(IEN350,RCBILL,RCPAID,RCBAL3RD) ; Process this charge for attempted auto-decrease
  1. ; Inputs: IEN350 - Internal entry number for charge in file #350
  1. ; RCBILL - Internal entry number for third party bill from file #399
  1. ; RCPAID - Amount paid on ERA line for this third party bill
  1. ; RCBAL3RD - Remaining balance on third party bill not yet used for auto-decrease of a copay
  1. ; Returns: 1 - quit loop after processing this record
  1. ; 0 - don't quit
  1. ;
  1. ; Get copay claim (external format)
  1. S RETURN=0
  1. S RCCLAIM=$$GET1^DIQ(350,IEN350_",",.11) ; DBIA4541
  1. I RCCLAIM="" Q 0
  1. S RCCOPAY=$O(^PRCA(430,"B",RCCLAIM,""))
  1. I 'RCCOPAY Q 0
  1. S STATUS=$P($G(^PRCA(430,RCCOPAY,0)),"^",8)
  1. ; Check 1st Party claim status vs list allowed for auto-decrease
  1. I '$D(STAT(STATUS)) Q 0
  1. ;
  1. ; Get copay balance remaining
  1. S COPAY=+$$GET1^DIQ(430,RCCOPAY_",",11)
  1. ; Quit if copay balance is zero
  1. I COPAY=0 Q 0
  1. ; PRCA*4.5*349 - Only process auto-decrease if copay balance = (charge - (previous auto-decreases))
  1. I +COPAY'=($$GET1^DIQ(350,IEN350_",",.07)-$$DECAMT(RCCOPAY)) Q 0 ; DBIA4541
  1. ;
  1. ; Get 1st party balance
  1. S DEBT=$$GET1^DIQ(430,RCCOPAY_",",9,"I")
  1. I 'DEBT Q 0
  1. S PRCADB=$$GET1^DIQ(340,DEBT_",",.01,"I")
  1. S PRCATY="ALL"
  1. D COMP^PRCAAPR
  1. S RCBAL=+$G(^TMP("PRCAAPR",$J,"C"))
  1. K ^TMP("PRCAAPR",$J)
  1. ; Determine decrease amount
  1. S AMT=$$AMT(RCBAL,RCBAL3RD,COPAY)
  1. ; Ignore zero amounts
  1. Q:AMT'>0 0
  1. ; Decrease adjustment comment
  1. D COMM1(.COMMENT,IEN350,RCBILL,AMT,RCPAID)
  1. ; Apply DECREASE ADJUSTMENT for COPAY
  1. S RCTRANDA=$$INCDEC^RCBEUTR1(RCCOPAY,-AMT,.COMMENT,"","",0) Q:'RCTRANDA 0
  1. ; File third party bill on decrease adjustment transaction
  1. K FDA
  1. S FDA(433,RCTRANDA_",",94)=RCBILL
  1. S FDA(433,RCTRANDA_",",42)=.5 ; Make sure PROCESSED BY is postmaster
  1. D FILE^DIE("","FDA")
  1. ; Add a comment transaction to first party bill also.
  1. S RCTRANDA=$$TRAN1(IEN350,RCBILL,RCCOPAY,AMT,RCPAID)
  1. S RCTRANDA=$$TRAN3(IEN350,RCBILL,RCCOPAY,AMT,COPAY) ; Add third party bill comment Transaction
  1. S RCBAL3RD=RCBAL3RD-AMT ; Take amount off the 3rd party payment and use for subsequent decrease.
  1. I RCBAL3RD=0!(RCBAL3RD<0) S RETURN=1
  1. Q RETURN
  1. ;
  1. AMT(RCBAL,RCPAID,RCOPAY) ; Calculate Decrease Amount
  1. ;
  1. ; INPUT
  1. ; RCBAL - 1st Party Balance
  1. ; RCPAID - Amount Paid on 3rd Party claim
  1. ; RCOPAY - Copay amount
  1. ; OUTPUT
  1. ; Amount to decrease
  1. ;
  1. ; Existing credit balance on 1st party account
  1. I RCBAL<0!(RCBAL=0) Q 0 ; Adjustment would leave the account in credit so don't do anything
  1. I RCBAL<COPAY Q $S(RCPAID<RCBAL:RCPAID,1:RCBAL)
  1. ; Existing debit balance on 1st party account
  1. Q $S(RCPAID<RCOPAY:RCPAID,1:RCOPAY)
  1. ;
  1. SHOWTYP() ; EP - Display list of IB ACTION TYPE enabled for 1st party auto-decrease
  1. ; Input - None
  1. ; Output - To screen
  1. N COUNT,FLAG,IEN2,TYPE,X
  1. S COUNT=0
  1. S FLAG=$$GET1^DIQ(342,"1,",.14,"I")
  1. I FLAG D ; Only show enabled types if auto-decrease is on
  1. . S IEN2=0
  1. . F S IEN2=$O(^RC(342,1,14,IEN2)) Q:'IEN2 D ;
  1. . . S FLAG=$$GET1^DIQ(342.014,IEN2_",1,",.02,"I")
  1. . . I FLAG D ;
  1. . . . I COUNT=0 W !!,"Charge types enabled for 1st party auto-decrease:"
  1. . . . W !," "_$$GET1^DIQ(342.014,IEN2_",1,",.01,"E")
  1. . . . S COUNT=COUNT+1
  1. W !
  1. Q
  1. ;
  1. TRAN1(IEN350,IEN399,IEN430,AMT,RCPAID) ; File auto-decrease comment on first party AR
  1. ; Input: IEN350 - Internal entry number to IB Action (File #350)
  1. ; IEN399 - Internal entry number to Third Party Bill (Files #399 and #430)
  1. ; IEN430 - Internal entry number of First Party Bill (File #430)
  1. ; AMT - Amount of auto-decease
  1. ; RCPAID - Amount paid on third party bill
  1. ;
  1. N BILL3,BILL430,COMMENT,FDA,IENS,RCDOS
  1. S RCDOS=$$DOS(IEN350)
  1. S BILL3=$$GET1^DIQ(399,IEN399_",",.01,"E")
  1. S BILL430=$$GET1^DIQ(430,IEN399_",",.01,"E")
  1. ;
  1. S RCTRANDA=$$ADD433^RCBEUTRA(IEN430,45) I 'RCTRANDA Q 0
  1. ;
  1. S FDA(433,RCTRANDA_",",4)=2
  1. S FDA(433,RCTRANDA_",",5.02)=BILL3_" PD $"_$FN(AMT,"",2)_" DOS:"_RCDOS
  1. S FDA(433,RCTRANDA_",",11)=DT
  1. S FDA(433,RCTRANDA_",",15)=0
  1. S FDA(433,RCTRANDA_",",42)=.5
  1. D FILE^DIE("","FDA")
  1. ;
  1. S COMMENT(1)="THIRD PARTY PAYMENT RECIEVED ON BILL NUMBER "_BILL430_" = $"_$FN(RCPAID,"",2)
  1. S COMMENT(2)="DOS:"_RCDOS_" "_$$RXMT(IEN350)
  1. S COMMENT(3)="$"_$FN(AMT,"",2)_" AUTO-DECREASE APPLIED FOR CLAIMS MATCHING"
  1. S COMMENT(4)=$$GET1^DIQ(200,".5,",.01,"E")
  1. D WP^DIE(433,RCTRANDA_",",41,"","COMMENT")
  1. L -^PRCA(433,RCTRANDA)
  1. Q RCTRANDA
  1. Q
  1. ;
  1. TRAN3(IEN350,IEN399,IEN430,AMT,COPAY) ; File auto-decrease comment on third party AR
  1. ; Input: IEN350 - Internal entry number to IB Action (File #350)
  1. ; IEN399 - Internal entry number to Third Party Bill (Files #399 and #430)
  1. ; IEN430 - Internal entry number of First Party Bill (File #430)
  1. ; AMT - Amount of auto-decease
  1. ; COPAY - Copay amount being decreased
  1. ;
  1. N BILL1,COMMENT,FDA,IENS,RCDOS
  1. S RCDOS=$$DOS(IEN350)
  1. S BILL1=$$GET1^DIQ(430,IEN430_",",.01,"E")
  1. ;
  1. S RCTRANDA=$$ADD433^RCBEUTRA(IEN399,45) I 'RCTRANDA Q 0
  1. ;
  1. S FDA(433,RCTRANDA_",",4)=2
  1. S FDA(433,RCTRANDA_",",5.02)=BILL1_" offset $"_$FN(AMT,"",2)
  1. S FDA(433,RCTRANDA_",",11)=DT
  1. S FDA(433,RCTRANDA_",",15)=0
  1. S FDA(433,RCTRANDA_",",42)=.5
  1. D FILE^DIE("","FDA")
  1. ;
  1. S COMMENT(1)="FIRST PARTY BILL # "_BILL1_" AUTO-DECREASED $"_$FN(AMT,"",2)_" FOR CLAIMS MATCHING"
  1. S COMMENT(2)="DOS:"_RCDOS
  1. S COMMENT(3)=$$GET1^DIQ(200,".5,",.01,"E")
  1. D WP^DIE(433,RCTRANDA_",",41,"","COMMENT")
  1. L -^PRCA(433,RCTRANDA)
  1. Q RCTRANDA
  1. ;
  1. COMM1(COMMENT,IEN350,IEN399,AMT,RCPAID) ; Build comment text for first party bill
  1. ; Input: IEN350 - Internal entry number to IB Action (File #350)
  1. ; IEN399 - Internal entry number to Third Party Bill (Files #399 and #430)
  1. ; AMT - Amount of auto-decease
  1. ; RCPAID - Amount paid on third party bill
  1. ; Output: COMMENT - Array passed by reference
  1. N BILL3
  1. S BILL3=$$GET1^DIQ(430,IEN399_",",.01,"E")
  1. S COMMENT(1)="THIRD PARTY PAYMENT RECIEVED ON BILL NUMBER "_BILL3_" = $"_$FN(RCPAID,"",2)
  1. S COMMENT(2)="DOS: "_$$DOS(IEN350)_" "_$$RXMT(IEN350)
  1. S COMMENT(3)="$"_$FN(AMT,"",2)_" AUTO-DECREASE APPLIED FOR CLAIMS MATCHING"
  1. S COMMENT(4)=$$GET1^DIQ(200,".5,",.01,"E")
  1. Q
  1. ;
  1. DOS(IEN350) ; Get Date of Service for charge
  1. ; Input: IEN350 - Intenal entry number of IB Action (file #350)
  1. ;
  1. N FIELD,FILE,FROM,IEN,RETURN
  1. S RETURN=""
  1. S FROM=$$GET1^DIQ(350,IEN350_",",.04,"I") ; DBIA4541
  1. S FILE=$P(FROM,":",1),IEN=+$P(FROM,":",2)
  1. ; Use issue date for prescription or date for o/p encounter
  1. S FIELD=$S(FILE=52:1,FILE=409.68:.01,1:"")
  1. I FIELD="" S FILE=350,FIELD=.17,IEN=IEN350 ; If not Rx or o/p use Event date from charge file
  1. S RETURN=$$GET1^DIQ(FILE,IEN_",",FIELD,"I")
  1. I RETURN'="" S RETURN=$$FMTE^XLFDT(RETURN,"2D")
  1. Q RETURN
  1. ;
  1. RXMT(IEN350) ; Return Rx # or "MT" for transaction comment line
  1. ; Input: IEN350 - Internal entry number of IB Action (file #350)
  1. ;
  1. N FROM,RETURN
  1. S RETURN="MT"
  1. S FROM=$$GET1^DIQ(350,IEN350_",",.04,"I") ; DBIA4541
  1. S FILE=$P(FROM,":",1),IEN=+$P(FROM,":",2)
  1. I FILE=52 S RETURN="RX#: "_$$GET1^DIQ(FILE,IEN_",",.01,"E") ; RX #
  1. Q RETURN
  1. ;
  1. PREPAY(IEN350) ; Check for open pre-pay
  1. ; Input: IEN350 - Internal entry number of charge from IB ACTION file #350
  1. ; Returns: 1 - Patient has an open pre-payment
  1. ; 0 - No open pre-payment
  1. ; -1 - Error
  1. N PIEN,RCDATA7,RCDEBTDA,RCPREDA,RCVPP,RETURN
  1. S RETURN=0
  1. S PIEN=$$GET1^DIQ(350,IEN350_",",.02,"I")
  1. I 'PIEN Q -1
  1. S RCVPP=PIEN_";DPT(" ; Variable pointer to debtor file 340
  1. S RCDEBTDA=$O(^RCD(340,"B",RCVPP,0))
  1. I 'RCDEBTDA Q -1
  1. ;
  1. S RCPREDA=0
  1. F S RCPREDA=$O(^PRCA(430,"AS",RCDEBTDA,42,RCPREDA)) Q:'RCPREDA!(RETURN'=0) D
  1. . ;
  1. . I $$GET1^DIQ(430,RCPREDA_",",2,"I")'=26 Q ; Not a prepayment
  1. . I $$GET1^DIQ(430,RCPREDA_",",8,"E")'="OPEN" Q ; If CURRENT STATUS not "OPEN" skip
  1. . I '$$GET1^DIQ(430,RCPREDA_",",71,"I") Q ; No balance on prepayment so skip.
  1. . ;
  1. . S RETURN=1
  1. ;
  1. Q RETURN
  1. ;
  1. QUEUE(IEN350,IEN399,IENS41) ; Place the charge in a queue from processing at a later date
  1. ; Input: IEN350 - Internal entry number of charge from IB ACTION file #350
  1. ; IEN399 - Internal entry number of third party bill from file 399 or 430
  1. ; IENS41 - Internal entry numbers of subfile 344.41 in format nnn,nnnnnnn,
  1. ; Output: New entry in file #344.74
  1. ;
  1. N FDA,IENS
  1. S IENS="+1,"
  1. S FDA(344.74,IENS,.01)=IEN350
  1. S FDA(344.74,IENS,.02)=IEN399
  1. S FDA(344.74,IENS,.03)=$$NOW^XLFDT()
  1. S FDA(344.74,IENS,.04)=IENS41
  1. D UPDATE^DIE("","FDA")
  1. Q
  1. DEL74(IEN74) ; Delete FIRST PARTY CHARGE QUEUE entry
  1. ; Input: IEN74 - Internal entry number of file 344.74
  1. ; Output: None
  1. N FDA
  1. S FDA(344.74,IEN74_",",.01)="@"
  1. D FILE^DIE("","FDA")
  1. Q
  1. ;
  1. ; Subroutine added for PRCA*4.5*349
  1. DECAMT(IEN430) ; Return amount that bill has been previously auto-decreased.
  1. ; Input: IEN430 - Internal Entry number of file #430
  1. ; Returns: Total amount of previous auto-decreases
  1. N RETURN,TRANDA,TYPE
  1. S RETURN=0
  1. S TRANDA=""
  1. F S TRANDA=$O(^PRCA(433,"C",IEN430,TRANDA)) Q:'TRANDA D ;
  1. . I $$GET1^DIQ(433,TRANDA_",",12,"E")'="DECREASE ADJUSTMENT" Q
  1. . I $$GET1^DIQ(433,TRANDA_",",42,"E")'="POSTMASTER" Q
  1. . S RETURN=RETURN+$$GET1^DIQ(433,TRANDA_",",15,"E") ; Add auto-decrease amount to total
  1. Q RETURN
  1. ;
  1. ; PRCA*4.5*349 - Subroutine added
  1. FLAG(RCERA,RCLINE) ; Flag ERA detail line as having been checked or processed for 1st party auto-decrease
  1. ; Input: RCERA - Internal entry number of file 344.4
  1. ; RCLINE - Internal entry number of subfile 344.41
  1. N FDA
  1. S FDA(344.41,RCLINE_","_RCERA_",",10.01)=1
  1. D FILE^DIE("","FDA")
  1. Q