- RCBEPAY ;WISC/RFJ - payment processing (top routine) ;1 Jun 00
- ;;4.5;Accounts Receivable;**153,304,301,326**;Mar 20, 1995;Build 26
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- Q
- ;
- ;
- PROCESS(RCRECTDA,RCPAYDA) ; process a payment for receipt
- ; rcrectda - receipt ien file 344
- ; rcpayda - payment ien file 344 under rcrectda
- ; returns 0 if processed, 1^error if not processed
- ;
- N RCACCT,RCBILLDA,RCDATA,RCERROR,RCPAYAMT,RCPAYDAT,RCTRANDA,X,RCERROR
- ;
- ; lock the receipt payment
- L +^RCY(344,RCRECTDA,1,RCPAYDA):10
- I '$T Q "1^Another user is working with this payment"
- ;
- ; get the payment data
- S RCDATA=^RCY(344,RCRECTDA,1,RCPAYDA,0)
- ;
- ; there is no account, this will go to suspense
- I $P(RCDATA,"^",3)="" L -^RCY(344,RCRECTDA,1,RCPAYDA) D Q RCERROR
- . S RCERROR=0
- . I '$T S RCERROR="1^Another user is updating the Suspense File Audit Log." Q
- . ;
- . ;file a "P"ending entry in the Suspense Audit Log File and for the disposition
- . ;if not already there and not $0 payment (auto-adjustment back to FMS).
- . I '$D(^RCY(344,RCRECTDA,1,RCPAYDA,3)),($P($G(^RCY(344,RCRECTDA,1,RCPAYDA,0)),U,4)'=0) D
- . . D AUDIT(RCRECTDA,RCPAYDA,"I")
- . . ;
- . . ;update disposition
- . . D SUSPDIS(RCRECTDA,RCPAYDA,"P")
- ;
- ; check the payment for errors
- S X=$$CHECKPAY^RCBEPAYC(RCRECTDA,RCPAYDA)
- I X L -^RCY(344,RCRECTDA,1,RCPAYDA) Q X
- ;
- ; get the payment date from the payment. if not on payment get it
- ; from the deposit. if not on deposit, set equal to today
- S RCPAYDAT=$P($P(RCDATA,"^",6),".") I 'RCPAYDAT S RCPAYDAT=$P($G(^RCY(344.1,+$P(^RCY(344,RCRECTDA,0),"^",6),0)),"^",3) I 'RCPAYDAT S RCPAYDAT=DT
- ; get the payment amount (amount paid minus amount processed).
- ; if the payment amount is not greater than zero, do not post.
- S RCPAYAMT=$P(RCDATA,"^",4)-$P(RCDATA,"^",5) I RCPAYAMT'>0 L -^RCY(344,RCRECTDA,1,RCPAYDA) Q 0
- ;
- ; get the account
- S RCACCT=$P(RCDATA,"^",3)
- ; if the account is a bill and the debtor is first party,
- ; then get the account from the debtor file
- I RCACCT["PRCA(430," S X=$P($G(^RCD(340,+$P($G(^PRCA(430,+RCACCT,0)),"^",9),0)),"^") I X["DPT(" S RCACCT=X
- ;
- ;
- ; ----------------- START PROCESSING PAYMENT -----------------
- ;
- ; === benefit debt (example: first party account) ===
- I RCACCT["DPT(" D Q RCERROR
- . S RCERROR=$$FIRSTPTY^RCBEPAYF
- . ; store or clear error
- . D SETERROR(RCRECTDA,RCPAYDA,$P(RCERROR,"^",2))
- . L -^RCY(344,RCRECTDA,1,RCPAYDA)
- ;
- ;
- ; === non-benefit debt (example: third party) ===
- S RCBILLDA=+$P(RCDATA,"^",3)
- ; lock the bill to prevent another used from changing the balance
- L +^PRCA(430,RCBILLDA):10
- I '$T D Q RCERROR
- . S RCERROR="1^Another user is working with bill "_$P(^PRCA(430,RCBILLDA,0),"^")
- . D SETERROR(RCRECTDA,RCPAYDA,$P(RCERROR,"^",2))
- . L -^RCY(344,RCRECTDA,1,RCPAYDA)
- ;
- ; exempt any interest/admin/penalty charges added on or after
- ; the payment date
- D EXEMPT^RCBECHGE(RCBILLDA,RCPAYDAT)
- ;
- ; once charges have been exempted, recheck the payment for errors
- S X=$$CHECKPAY^RCBEPAYC(RCRECTDA,RCPAYDA)
- I X D Q RCERROR
- . S RCERROR="1^"_$P(X,"^",2)
- . D SETERROR(RCRECTDA,RCPAYDA,$P(RCERROR,"^",2))
- . L -^PRCA(430,RCBILLDA)
- . L -^RCY(344,RCRECTDA,1,RCPAYDA)
- ;
- ; apply payment to bill
- ; return error if problem adding payment transaction
- S RCTRANDA=$$PAYTRAN^RCBEPAY1(RCBILLDA,RCPAYAMT,RCRECTDA,RCPAYDA,RCPAYDAT)
- I 'RCTRANDA D Q RCERROR
- . S RCERROR="1^"_$P(RCTRANDA,"^",2)
- . D SETERROR(RCRECTDA,RCPAYDA,$P(RCERROR,"^",2))
- . L -^PRCA(430,RCBILLDA)
- . L -^RCY(344,RCRECTDA,1,RCPAYDA)
- ;
- ; set the amount processed in the receipt
- D SETAMT(RCRECTDA,RCPAYDA,$P($G(^PRCA(433,RCTRANDA,1)),"^",5))
- ;
- ; payment applied to bill
- D SETERROR(RCRECTDA,RCPAYDA,"")
- L -^PRCA(430,RCBILLDA)
- L -^RCY(344,RCRECTDA,1,RCPAYDA)
- Q 0
- ;
- ;
- SETAMT(RCRECTDA,RCPAYDA,RCAMOUNT) ; update the amount posted on the receipt
- N DATA
- S DATA=$G(^RCY(344,RCRECTDA,1,RCPAYDA,0))
- I DATA="" Q
- S $P(^RCY(344,RCRECTDA,1,RCPAYDA,0),"^",5)=$P(DATA,"^",5)+RCAMOUNT
- Q
- ;
- ;
- SETERROR(RCRECTDA,RCPAYDA,RCERROR) ; store the error on the receipt
- ; or clear the posting error if null and defined
- ; error is null and posting error data in file is null
- I RCERROR="",$P($G(^RCY(344,RCRECTDA,1,RCPAYDA,1)),"^")="" Q
- ; error is null, clear posting error
- I RCERROR="" S $P(^RCY(344,RCRECTDA,1,RCPAYDA,1),"^")="" Q
- ; error exists, set the posting error
- I RCERROR'="" S $P(^RCY(344,RCRECTDA,1,RCPAYDA,1),"^")=$E(RCERROR,1,60)
- Q
- ;
- ;
- AUDIT(RCRECTDA,RCPAYDA,RCSTAT,RCMTS) ; store entry in Suspense Audit Log
- ; Input
- ; RCRECTDA - IEN of Receipt file #344
- ; RCPAYDA - IEN of Receipt Transaction file #344.01
- ; RCSTAT - Status I = In Suspense, P = Paid or R = Refund
- ; RCMTS(N) - Array of Multi-Trans split information (OPTIONAL)
- ; $P(2) = AMOUNT
- ; $P(3) = Suspense comment
- ; $P(4) = Account/Claim
- ; e.g.
- ; RCMTS(1)="290613;PRCA(430,^2^^K100005"
- ; RCMTS(2)="290618;PRCA(430,^2^^K100010"
- ; RCMTS(3)="^2.42^Collected/Closed^"
- ;
- ; Output - Update RCDPE SUSPENSE AUDIT file #344.71
- N FDAIEN,RCAUDIT,RCDATA,RCDATA1,RCDATA0 ; PRCA*4.5*326
- ;
- ; get the data elements
- S RCDATA=$G(^RCY(344,RCRECTDA,0)) ;double check these
- S RCDATA0=$G(^RCY(344,RCRECTDA,1,RCPAYDA,0))
- S RCDATA1=$G(^RCY(344,RCRECTDA,1,RCPAYDA,1))
- ;
- ; set up array
- S RCAUDIT(344.71,"+1,",.01)=$$NOW^XLFDT ;Date/Time Stamp
- S RCAUDIT(344.71,"+1,",.02)=DUZ ;User
- S RCAUDIT(344.71,"+1,",.03)=$P(RCDATA,U,1) ;Receipt #
- S RCAUDIT(344.71,"+1,",.04)=RCPAYDA ;Transaction #
- S RCAUDIT(344.71,"+1,",.05)=$P(RCDATA0,U,4) ;Amount
- S RCAUDIT(344.71,"+1,",.06)=$P(RCDATA0,U,9) ;Claim #
- S RCAUDIT(344.71,"+1,",.07)=RCSTAT ;Status
- S RCAUDIT(344.71,"+1,",.08)=$P(RCDATA1,U,2) ;Reason text
- ;
- ;file entry
- D UPDATE^DIE(,"RCAUDIT","FDAIEN") ; Added FDAIEN - PRCA*4.5*326
- ;
- ; BEGIN PRCA*4.5*326
- ; check if filing was successful
- Q:'$G(FDAIEN(1))
- ; if this is a multi-trans split update #344.711
- Q:'$D(RCMTS)
- ;
- N DA,DD,DIC,DLAYGO,DO,DR,RCACC,RCAMT,RCCOM,RCSUB,X,Y,Z
- ; Save details of each claim/suspense line in the split
- S RCSUB=0
- F S RCSUB=$O(RCMTS(RCSUB)) Q:'RCSUB D
- .S RCAMT=$P(RCMTS(RCSUB),U,2)
- .S RCCOM=$P(RCMTS(RCSUB),U,3)
- .S RCACC=$P(RCMTS(RCSUB),U,4)
- .S:RCACC="" RCACC="SUSPENSE"
- .S DLAYGO=344.711,DA(1)=FDAIEN(1),DIC(0)="L",X=RCSUB,DIC="^RCY(344.71,"_DA(1)_",1,"
- .S DIC("DR")=".02///"_RCACC_";.03///"_$J(+RCAMT,"",2)_";.04///"_RCCOM
- .D FILE^DICN
- .K DIC,DD,DO,DLAYGO
- Q
- ; END PRCA*4.5*326
- ;
- SUSPDIS(RCRECTDA,RCTRANDA,RCSTAT) ;Update the disposition field
- ;
- N DA,DR,DIE,DTOUT
- S DA=RCTRANDA,DA(1)=RCRECTDA,DIE="^RCY(344,"_DA(1)_",1,"
- S DR="3.01////"_RCSTAT_";"
- I RCSTAT="P" D
- . S DR=DR_"3.02////"_$$NOW^XLFDT_";"
- . S DR=DR_"3.03////"_DUZ_";"
- I RCSTAT'="P" D
- . S DR=DR_"3.04////"_$$NOW^XLFDT_";"
- . S DR=DR_"3.05////"_DUZ_";"
- S DR=$P(DR,";",1,$L(DR,";")-1)
- ;
- D ^DIE
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBEPAY 7113 printed Feb 18, 2025@23:09:09 Page 2
- RCBEPAY ;WISC/RFJ - payment processing (top routine) ;1 Jun 00
- +1 ;;4.5;Accounts Receivable;**153,304,301,326**;Mar 20, 1995;Build 26
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 QUIT
- +5 ;
- +6 ;
- PROCESS(RCRECTDA,RCPAYDA) ; process a payment for receipt
- +1 ; rcrectda - receipt ien file 344
- +2 ; rcpayda - payment ien file 344 under rcrectda
- +3 ; returns 0 if processed, 1^error if not processed
- +4 ;
- +5 NEW RCACCT,RCBILLDA,RCDATA,RCERROR,RCPAYAMT,RCPAYDAT,RCTRANDA,X,RCERROR
- +6 ;
- +7 ; lock the receipt payment
- +8 LOCK +^RCY(344,RCRECTDA,1,RCPAYDA):10
- +9 IF '$TEST
- QUIT "1^Another user is working with this payment"
- +10 ;
- +11 ; get the payment data
- +12 SET RCDATA=^RCY(344,RCRECTDA,1,RCPAYDA,0)
- +13 ;
- +14 ; there is no account, this will go to suspense
- +15 IF $PIECE(RCDATA,"^",3)=""
- LOCK -^RCY(344,RCRECTDA,1,RCPAYDA)
- Begin DoDot:1
- +16 SET RCERROR=0
- +17 IF '$TEST
- SET RCERROR="1^Another user is updating the Suspense File Audit Log."
- QUIT
- +18 ;
- +19 ;file a "P"ending entry in the Suspense Audit Log File and for the disposition
- +20 ;if not already there and not $0 payment (auto-adjustment back to FMS).
- +21 IF '$DATA(^RCY(344,RCRECTDA,1,RCPAYDA,3))
- IF ($PIECE($GET(^RCY(344,RCRECTDA,1,RCPAYDA,0)),U,4)'=0)
- Begin DoDot:2
- +22 DO AUDIT(RCRECTDA,RCPAYDA,"I")
- +23 ;
- +24 ;update disposition
- +25 DO SUSPDIS(RCRECTDA,RCPAYDA,"P")
- End DoDot:2
- End DoDot:1
- QUIT RCERROR
- +26 ;
- +27 ; check the payment for errors
- +28 SET X=$$CHECKPAY^RCBEPAYC(RCRECTDA,RCPAYDA)
- +29 IF X
- LOCK -^RCY(344,RCRECTDA,1,RCPAYDA)
- QUIT X
- +30 ;
- +31 ; get the payment date from the payment. if not on payment get it
- +32 ; from the deposit. if not on deposit, set equal to today
- +33 SET RCPAYDAT=$PIECE($PIECE(RCDATA,"^",6),".")
- IF 'RCPAYDAT
- SET RCPAYDAT=$PIECE($GET(^RCY(344.1,+$PIECE(^RCY(344,RCRECTDA,0),"^",6),0)),"^",3)
- IF 'RCPAYDAT
- SET RCPAYDAT=DT
- +34 ; get the payment amount (amount paid minus amount processed).
- +35 ; if the payment amount is not greater than zero, do not post.
- +36 SET RCPAYAMT=$PIECE(RCDATA,"^",4)-$PIECE(RCDATA,"^",5)
- IF RCPAYAMT'>0
- LOCK -^RCY(344,RCRECTDA,1,RCPAYDA)
- QUIT 0
- +37 ;
- +38 ; get the account
- +39 SET RCACCT=$PIECE(RCDATA,"^",3)
- +40 ; if the account is a bill and the debtor is first party,
- +41 ; then get the account from the debtor file
- +42 IF RCACCT["PRCA(430,"
- SET X=$PIECE($GET(^RCD(340,+$PIECE($GET(^PRCA(430,+RCACCT,0)),"^",9),0)),"^")
- IF X["DPT("
- SET RCACCT=X
- +43 ;
- +44 ;
- +45 ; ----------------- START PROCESSING PAYMENT -----------------
- +46 ;
- +47 ; === benefit debt (example: first party account) ===
- +48 IF RCACCT["DPT("
- Begin DoDot:1
- +49 SET RCERROR=$$FIRSTPTY^RCBEPAYF
- +50 ; store or clear error
- +51 DO SETERROR(RCRECTDA,RCPAYDA,$PIECE(RCERROR,"^",2))
- +52 LOCK -^RCY(344,RCRECTDA,1,RCPAYDA)
- End DoDot:1
- QUIT RCERROR
- +53 ;
- +54 ;
- +55 ; === non-benefit debt (example: third party) ===
- +56 SET RCBILLDA=+$PIECE(RCDATA,"^",3)
- +57 ; lock the bill to prevent another used from changing the balance
- +58 LOCK +^PRCA(430,RCBILLDA):10
- +59 IF '$TEST
- Begin DoDot:1
- +60 SET RCERROR="1^Another user is working with bill "_$PIECE(^PRCA(430,RCBILLDA,0),"^")
- +61 DO SETERROR(RCRECTDA,RCPAYDA,$PIECE(RCERROR,"^",2))
- +62 LOCK -^RCY(344,RCRECTDA,1,RCPAYDA)
- End DoDot:1
- QUIT RCERROR
- +63 ;
- +64 ; exempt any interest/admin/penalty charges added on or after
- +65 ; the payment date
- +66 DO EXEMPT^RCBECHGE(RCBILLDA,RCPAYDAT)
- +67 ;
- +68 ; once charges have been exempted, recheck the payment for errors
- +69 SET X=$$CHECKPAY^RCBEPAYC(RCRECTDA,RCPAYDA)
- +70 IF X
- Begin DoDot:1
- +71 SET RCERROR="1^"_$PIECE(X,"^",2)
- +72 DO SETERROR(RCRECTDA,RCPAYDA,$PIECE(RCERROR,"^",2))
- +73 LOCK -^PRCA(430,RCBILLDA)
- +74 LOCK -^RCY(344,RCRECTDA,1,RCPAYDA)
- End DoDot:1
- QUIT RCERROR
- +75 ;
- +76 ; apply payment to bill
- +77 ; return error if problem adding payment transaction
- +78 SET RCTRANDA=$$PAYTRAN^RCBEPAY1(RCBILLDA,RCPAYAMT,RCRECTDA,RCPAYDA,RCPAYDAT)
- +79 IF 'RCTRANDA
- Begin DoDot:1
- +80 SET RCERROR="1^"_$PIECE(RCTRANDA,"^",2)
- +81 DO SETERROR(RCRECTDA,RCPAYDA,$PIECE(RCERROR,"^",2))
- +82 LOCK -^PRCA(430,RCBILLDA)
- +83 LOCK -^RCY(344,RCRECTDA,1,RCPAYDA)
- End DoDot:1
- QUIT RCERROR
- +84 ;
- +85 ; set the amount processed in the receipt
- +86 DO SETAMT(RCRECTDA,RCPAYDA,$PIECE($GET(^PRCA(433,RCTRANDA,1)),"^",5))
- +87 ;
- +88 ; payment applied to bill
- +89 DO SETERROR(RCRECTDA,RCPAYDA,"")
- +90 LOCK -^PRCA(430,RCBILLDA)
- +91 LOCK -^RCY(344,RCRECTDA,1,RCPAYDA)
- +92 QUIT 0
- +93 ;
- +94 ;
- SETAMT(RCRECTDA,RCPAYDA,RCAMOUNT) ; update the amount posted on the receipt
- +1 NEW DATA
- +2 SET DATA=$GET(^RCY(344,RCRECTDA,1,RCPAYDA,0))
- +3 IF DATA=""
- QUIT
- +4 SET $PIECE(^RCY(344,RCRECTDA,1,RCPAYDA,0),"^",5)=$PIECE(DATA,"^",5)+RCAMOUNT
- +5 QUIT
- +6 ;
- +7 ;
- SETERROR(RCRECTDA,RCPAYDA,RCERROR) ; store the error on the receipt
- +1 ; or clear the posting error if null and defined
- +2 ; error is null and posting error data in file is null
- +3 IF RCERROR=""
- IF $PIECE($GET(^RCY(344,RCRECTDA,1,RCPAYDA,1)),"^")=""
- QUIT
- +4 ; error is null, clear posting error
- +5 IF RCERROR=""
- SET $PIECE(^RCY(344,RCRECTDA,1,RCPAYDA,1),"^")=""
- QUIT
- +6 ; error exists, set the posting error
- +7 IF RCERROR'=""
- SET $PIECE(^RCY(344,RCRECTDA,1,RCPAYDA,1),"^")=$EXTRACT(RCERROR,1,60)
- +8 QUIT
- +9 ;
- +10 ;
- AUDIT(RCRECTDA,RCPAYDA,RCSTAT,RCMTS) ; store entry in Suspense Audit Log
- +1 ; Input
- +2 ; RCRECTDA - IEN of Receipt file #344
- +3 ; RCPAYDA - IEN of Receipt Transaction file #344.01
- +4 ; RCSTAT - Status I = In Suspense, P = Paid or R = Refund
- +5 ; RCMTS(N) - Array of Multi-Trans split information (OPTIONAL)
- +6 ; $P(2) = AMOUNT
- +7 ; $P(3) = Suspense comment
- +8 ; $P(4) = Account/Claim
- +9 ; e.g.
- +10 ; RCMTS(1)="290613;PRCA(430,^2^^K100005"
- +11 ; RCMTS(2)="290618;PRCA(430,^2^^K100010"
- +12 ; RCMTS(3)="^2.42^Collected/Closed^"
- +13 ;
- +14 ; Output - Update RCDPE SUSPENSE AUDIT file #344.71
- +15 ; PRCA*4.5*326
- NEW FDAIEN,RCAUDIT,RCDATA,RCDATA1,RCDATA0
- +16 ;
- +17 ; get the data elements
- +18 ;double check these
- SET RCDATA=$GET(^RCY(344,RCRECTDA,0))
- +19 SET RCDATA0=$GET(^RCY(344,RCRECTDA,1,RCPAYDA,0))
- +20 SET RCDATA1=$GET(^RCY(344,RCRECTDA,1,RCPAYDA,1))
- +21 ;
- +22 ; set up array
- +23 ;Date/Time Stamp
- SET RCAUDIT(344.71,"+1,",.01)=$$NOW^XLFDT
- +24 ;User
- SET RCAUDIT(344.71,"+1,",.02)=DUZ
- +25 ;Receipt #
- SET RCAUDIT(344.71,"+1,",.03)=$PIECE(RCDATA,U,1)
- +26 ;Transaction #
- SET RCAUDIT(344.71,"+1,",.04)=RCPAYDA
- +27 ;Amount
- SET RCAUDIT(344.71,"+1,",.05)=$PIECE(RCDATA0,U,4)
- +28 ;Claim #
- SET RCAUDIT(344.71,"+1,",.06)=$PIECE(RCDATA0,U,9)
- +29 ;Status
- SET RCAUDIT(344.71,"+1,",.07)=RCSTAT
- +30 ;Reason text
- SET RCAUDIT(344.71,"+1,",.08)=$PIECE(RCDATA1,U,2)
- +31 ;
- +32 ;file entry
- +33 ; Added FDAIEN - PRCA*4.5*326
- DO UPDATE^DIE(,"RCAUDIT","FDAIEN")
- +34 ;
- +35 ; BEGIN PRCA*4.5*326
- +36 ; check if filing was successful
- +37 if '$GET(FDAIEN(1))
- QUIT
- +38 ; if this is a multi-trans split update #344.711
- +39 if '$DATA(RCMTS)
- QUIT
- +40 ;
- +41 NEW DA,DD,DIC,DLAYGO,DO,DR,RCACC,RCAMT,RCCOM,RCSUB,X,Y,Z
- +42 ; Save details of each claim/suspense line in the split
- +43 SET RCSUB=0
- +44 FOR
- SET RCSUB=$ORDER(RCMTS(RCSUB))
- if 'RCSUB
- QUIT
- Begin DoDot:1
- +45 SET RCAMT=$PIECE(RCMTS(RCSUB),U,2)
- +46 SET RCCOM=$PIECE(RCMTS(RCSUB),U,3)
- +47 SET RCACC=$PIECE(RCMTS(RCSUB),U,4)
- +48 if RCACC=""
- SET RCACC="SUSPENSE"
- +49 SET DLAYGO=344.711
- SET DA(1)=FDAIEN(1)
- SET DIC(0)="L"
- SET X=RCSUB
- SET DIC="^RCY(344.71,"_DA(1)_",1,"
- +50 SET DIC("DR")=".02///"_RCACC_";.03///"_$JUSTIFY(+RCAMT,"",2)_";.04///"_RCCOM
- +51 DO FILE^DICN
- +52 KILL DIC,DD,DO,DLAYGO
- End DoDot:1
- +53 QUIT
- +54 ; END PRCA*4.5*326
- +55 ;
- SUSPDIS(RCRECTDA,RCTRANDA,RCSTAT) ;Update the disposition field
- +1 ;
- +2 NEW DA,DR,DIE,DTOUT
- +3 SET DA=RCTRANDA
- SET DA(1)=RCRECTDA
- SET DIE="^RCY(344,"_DA(1)_",1,"
- +4 SET DR="3.01////"_RCSTAT_";"
- +5 IF RCSTAT="P"
- Begin DoDot:1
- +6 SET DR=DR_"3.02////"_$$NOW^XLFDT_";"
- +7 SET DR=DR_"3.03////"_DUZ_";"
- End DoDot:1
- +8 IF RCSTAT'="P"
- Begin DoDot:1
- +9 SET DR=DR_"3.04////"_$$NOW^XLFDT_";"
- +10 SET DR=DR_"3.05////"_DUZ_";"
- End DoDot:1
- +11 SET DR=$PIECE(DR,";",1,$LENGTH(DR,";")-1)
- +12 ;
- +13 DO ^DIE
- +14 QUIT
- +15 ;