IB20P554 ;ALB/DRF - IB*2.0*554 Post Init: Rate Type Update;09/30/15 7:55am
;;2.0;INTEGRATED BILLING;**554**;21-MAR-94;Build 81
;Per VA Directive 6402, this routine should not be modified.
Q
;
POSTINIT ; Derived from IBYPPC, post-init for IB*2.0*52
;IB*2.0*554/DRF
N I,J,RTDATA,DA,DR,DIC,DIE,DIK,X,Y
D BMES^XPDUTL(" >> Starting the Post-Initialization routine ...")
D ADDRT ; add Rate Type (399.3)
D ADDER ; add Billing Errors (350.8)
D ADDRS ; add Rate Schedules (363)
D BMES^XPDUTL(" >> Completed the Post-Initialization routine.")
Q ;POSTINIT
;
;
ADDRT ;Add rate type for NON-VA reimbursable insurance
N LIN,RTDATA,DIC,DIE,X,Y,J,DLAYGO,DR
D MES^XPDUTL(" -> Adding new Rate Types to file 399.3 ...")
F LIN=1:1 D Q:RTDATA="END"
. S RTDATA=$P($T(NEWRT+LIN),";",3,99)
. Q:RTDATA="END"
. ; do a lookup and go on if exists.
. S DIC="^DGCR(399.3,",X=$P(RTDATA,";") D ^DIC
. I +Y>0 D Q
.. D MES^XPDUTL(" "_$P(RTDATA,";")_" already exists.")
. ; add entry
. K DO
. S DIC(0)="L",DLAYGO=399.3,DR=""
. D FILE^DICN
. I +Y=-1 D Q
.. D MES^XPDUTL(" "_$P(RTDATA,";")_" failed to add!")
. S DA=+Y
. S DR=".02////"_$P(RTDATA,";",2)_";"
. F J=3:1:6,8:1:11 S DR=$G(DR)_(J/100)_"///"_$P(RTDATA,";",J)_";"
. S DIE=DIC K DIC
. D ^DIE
D MES^XPDUTL(" Rate Types completed.")
Q ;ADDRT
;
;
ADDER ;Add Billing Errors for NON-VA rate type
D MES^XPDUTL(" -> Adding new Billing Errors to file 350.8 ...")
F I=1:1 D Q:RTDATA="END"
. S RTDATA=$P($T(NEWBE+I),";",3,99)
. Q:RTDATA="END"
. ; do a lookup and go on if exists.
. S DIC="^IBE(350.8,",X=$P(RTDATA,";") D ^DIC
. I +Y>0 D Q
.. D MES^XPDUTL(" "_$P(RTDATA,";")_" already exists!")
. ; add entry
. S X=$P(RTDATA,";") D FILE^DICN
. I +Y=-1 D Q
.. D MES^XPDUTL(" "_$P(RTDATA,";")_" failed to add!")
. ;set fields
. S DIE=DIC K DIC
. S DA=+Y
. F J=2:1:5 S DR=$G(DR)_(J/100)_"////"_$P(RTDATA,";",J)_";"
. D ^DIE
D MES^XPDUTL(" -> Billing Errors completed.")
Q ;ADDER
;
;
ADDRS ; Add Rate Schedules (363) for FEE REIMB INS
D MES^XPDUTL(" -> Adding new Rate Schedules to file 363 ...")
N IBA,IBCNT,IBI,IBLN,IBFN,IBRT,IBBS,IBCNTCS,IBDISP,IBJ,IBLNCS,IBCS,IBCSFN,IBADMIN,DD,DO,DLAYGO,DIC,DIE,DA,DR,RXDT,X,Y S IBCNT=0
F IBI=1:1 S IBLN=$P($T(RSF+IBI),";;",2) Q:IBLN="END" I $E(IBLN)?1A D
. ;Check for problems
. I $O(^IBE(363,"B",$P(IBLN,U,1),0)) Q ;Already exists
. S IBBS=$P(IBLN,U,4) I IBBS'="" S IBBS=$$MCCRUTL(IBBS,13) Q:'IBBS ;Billable service invalid
. S IBRT=$P(IBLN,U,2),IBRT=$O(^DGCR(399.3,"B",IBRT,0)) D Q:'IBRT
.. I 'IBRT D MSG(" **** Rate Type "_$P(IBLN,U,2)_" not defined, RS "_$P(IBLN,U,1)_" not created")
.. I +$P($G(^DGCR(399.3,+IBRT,0)),U,3) S IBRT=0 D MSG(" **** Rate Type "_$P(IBLN,U,2)_" not Active, RS "_$P(IBLN,U,1)_" not created")
. ;No problems found, so create entry
. K DD,DO
. S DLAYGO=363,DIC="^IBE(363,",DIC(0)="L",X=$P(IBLN,U,1)
. D FILE^DICN K DIC,DINUM,DLAYGO
. I Y<1 K X,Y Q
. S IBFN=+Y,IBCNT=IBCNT+1
. S DR=".02////"_IBRT_";.03////"_$P(IBLN,U,3) I +IBBS S DR=DR_";.04////"_IBBS
. S DR=DR_";.05////"_$S($P(IBLN,U,1)["RX":3110318,1:3031219)
. I $P(IBLN,U,1)["RX" S RXDT=$$RXDT()
. I $P(IBLN,U,1)["RX",IBDISP]"" S DR=DR_";1.01///"_IBDISP
. I $P(IBLN,U,1)["RX",IBADMIN]"" S DR=DR_";1.02////"_IBADMIN
. S DIE="^IBE(363,",DA=+Y D ^DIE K DIE,DA,DR,X,Y
. S IBCNTCS=0
. ; add all Reasonable Charges Charge Sets
. S IBCNTCS=$$RSCS(IBFN)
. D MES^XPDUTL(" Total Reasonable Charge Set"_$S(IBCNTCS=1:" ",1:"s ")_IBCNTCS_" added to the rate schedule.")
D MES^XPDUTL(" Rate Schedules completed.")
Q ;ADDRS
;
RSCS(IBFN) ; add existing Charge Sets to FR
; copy the Charge Sets from the corresponding RI RS (v2)
N IBCNT,IBNRS,IBRSNM,IBTY,IBVDT,IBCOPY,IBCS,IBCS0,IBXFN,IBCSFN,IBCSNM,IBCSAA,IBNAME
S (IBCNT,IBCOPY)=0
S IBNRS=$G(^IBE(363,+$G(IBFN),0)),IBRSNM=$P(IBNRS,"^",1)
S IBTY=$P(IBNRS,"^",3)
S IBVDT=$$VERSDT^IBCRU8(2)
I IBRSNM["INPT" S IBCOPY=+$$RSEXISTS(IBVDT,"RI-INPT")
I IBRSNM["SNF" S IBCOPY=+$$RSEXISTS(IBVDT,"RI-SNF")
I IBRSNM["OPT" S IBCOPY=+$$RSEXISTS(IBVDT,"RI-OPT")
I IBRSNM["RX" S IBVDT=RXDT S IBCOPY=$$RSEXISTS(IBVDT,"RI-RX")
I 'IBCOPY G RSCSQ
I +$P($G(^IBE(363,+IBCOPY,0)),U,3)=IBTY D
. S IBXFN=0 F S IBXFN=$O(^IBE(363,IBCOPY,11,IBXFN)) Q:'IBXFN D
.. S IBCS=$G(^IBE(363,IBCOPY,11,IBXFN,0)),IBCSFN=+IBCS
.. I +$$RSCSFILE(IBFN,$P($G(^IBE(363.1,IBCSFN,0)),U,1),$P(IBCS,U,2)) S IBCNT=IBCNT+1
RSCSQ Q IBCNT
;
;
RSCSFILE(IBFN,IBCSNM,IBCSAA) ; Add Charge Set to a Rate Schedule
N IBX,DD,DO,DLAYGO,DIC,DA,DR,X,Y,IBCSFN S IBX=0
I $G(^IBE(363,+$G(IBFN),0))="" G RSCSFQ
I $G(IBCSNM)="" G RSCSFQ
S IBCSFN=$O(^IBE(363.1,"B",IBCSNM,0)) I 'IBCSFN G RSCSFQ
I $O(^IBE(363,IBFN,11,"B",IBCSFN,0)) G RSCSFQ
S DLAYGO=363,DA(1)=+IBFN,DIC="^IBE(363,"_DA(1)_",11,",DIC(0)="L"
S X=IBCSNM,DIC("DR")=".02///"_$G(IBCSAA),DIC("P")="363.0011P"
D ^DIC S:+Y IBX=1
RSCSFQ Q IBX
;
;
RSEXISTS(IBVDT,IBNAME) ; return RS IFN if Rate Schedule exists for Effective Date
N IBX,IBRSFN,IBRS0 S IBX=0
S IBRSFN=0 F S IBRSFN=$O(^IBE(363,IBRSFN)) Q:'IBRSFN D I IBX Q
. S IBRS0=$G(^IBE(363,IBRSFN,0))
. I $P(IBRS0,U,1)=IBNAME,$P(IBRS0,U,5)=IBVDT S IBX=IBRSFN
Q IBX
;
;
MCCRUTL(X,P) ; returns IFN of item in 399.1 if Name is found and piece P is true
N IBX,IBY S IBY=""
I $G(X)'="" S IBX=0 F S IBX=$O(^DGCR(399.1,"B",X,IBX)) Q:'IBX I $P($G(^DGCR(399.1,IBX,0)),U,+$G(P)) S IBY=IBX
Q IBY
;
;
MSG(X) ;
N IBX S IBX=$O(IBA(999999),-1) S:'IBX IBX=1 S IBX=IBX+1
S IBA(IBX)=$G(X)
Q ;MSG
;
;
RXDT() ;Copy the active RX charge schedule from RI to FR
S IBCS="",IBCS=$O(^IBE(363,"B","RI-RX",IBCS),-1)
S IBCS0=^IBE(363,IBCS,0)
S IBDISP=$P($G(^IBE(363,IBCS,1)),U,1),IBADMIN=$G(^IBE(363,IBCS,10))
Q $P(IBCS0,U,5)
;
;
NEWRT ;Rate Type
;;FEE REIMB INS;FEE REIMB INS;;FEE INS;1;45;;1;1;1;28
;;END
;
NEWBE ;Billing Errors
;;INCORRECT NON-VA RATE;Non-VA rate type used for bill that is not Non-VA;IB360;1;1
;;NON-VA RATE TYPE REQUIRED;Non-VA bill requires use of Non-VA rate type;IB361;1;1
;;END
;
RSF ;Rate Schedules (363) for FEE REIMB INS
;;FR-INPT^FEE REIMB INS^1^INPATIENT
;;FR-SNF^FEE REIMB INS^1^SKILLED NURSING
;;FR-OPT^FEE REIMB INS^3
;;FR-RX^FEE REIMB INS^3
;;END
;
CLM ;CLAIMS TRACKING TYPE FILE (356.6)
;;OPT-NON VA CARE^ONVC^2^1^1^1^^6
;;INP-NON VA CARE^INVC^1^^10^^^7
;;RX-NON VA CARE^RXNVC^3^1^5^1^^8
;;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P554 6545 printed Dec 13, 2024@02:03:39 Page 2
IB20P554 ;ALB/DRF - IB*2.0*554 Post Init: Rate Type Update;09/30/15 7:55am
+1 ;;2.0;INTEGRATED BILLING;**554**;21-MAR-94;Build 81
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
POSTINIT ; Derived from IBYPPC, post-init for IB*2.0*52
+1 ;IB*2.0*554/DRF
+2 NEW I,J,RTDATA,DA,DR,DIC,DIE,DIK,X,Y
+3 DO BMES^XPDUTL(" >> Starting the Post-Initialization routine ...")
+4 ; add Rate Type (399.3)
DO ADDRT
+5 ; add Billing Errors (350.8)
DO ADDER
+6 ; add Rate Schedules (363)
DO ADDRS
+7 DO BMES^XPDUTL(" >> Completed the Post-Initialization routine.")
+8 ;POSTINIT
QUIT
+9 ;
+10 ;
ADDRT ;Add rate type for NON-VA reimbursable insurance
+1 NEW LIN,RTDATA,DIC,DIE,X,Y,J,DLAYGO,DR
+2 DO MES^XPDUTL(" -> Adding new Rate Types to file 399.3 ...")
+3 FOR LIN=1:1
Begin DoDot:1
+4 SET RTDATA=$PIECE($TEXT(NEWRT+LIN),";",3,99)
+5 if RTDATA="END"
QUIT
+6 ; do a lookup and go on if exists.
+7 SET DIC="^DGCR(399.3,"
SET X=$PIECE(RTDATA,";")
DO ^DIC
+8 IF +Y>0
Begin DoDot:2
+9 DO MES^XPDUTL(" "_$PIECE(RTDATA,";")_" already exists.")
End DoDot:2
QUIT
+10 ; add entry
+11 KILL DO
+12 SET DIC(0)="L"
SET DLAYGO=399.3
SET DR=""
+13 DO FILE^DICN
+14 IF +Y=-1
Begin DoDot:2
+15 DO MES^XPDUTL(" "_$PIECE(RTDATA,";")_" failed to add!")
End DoDot:2
QUIT
+16 SET DA=+Y
+17 SET DR=".02////"_$PIECE(RTDATA,";",2)_";"
+18 FOR J=3:1:6,8:1:11
SET DR=$GET(DR)_(J/100)_"///"_$PIECE(RTDATA,";",J)_";"
+19 SET DIE=DIC
KILL DIC
+20 DO ^DIE
End DoDot:1
if RTDATA="END"
QUIT
+21 DO MES^XPDUTL(" Rate Types completed.")
+22 ;ADDRT
QUIT
+23 ;
+24 ;
ADDER ;Add Billing Errors for NON-VA rate type
+1 DO MES^XPDUTL(" -> Adding new Billing Errors to file 350.8 ...")
+2 FOR I=1:1
Begin DoDot:1
+3 SET RTDATA=$PIECE($TEXT(NEWBE+I),";",3,99)
+4 if RTDATA="END"
QUIT
+5 ; do a lookup and go on if exists.
+6 SET DIC="^IBE(350.8,"
SET X=$PIECE(RTDATA,";")
DO ^DIC
+7 IF +Y>0
Begin DoDot:2
+8 DO MES^XPDUTL(" "_$PIECE(RTDATA,";")_" already exists!")
End DoDot:2
QUIT
+9 ; add entry
+10 SET X=$PIECE(RTDATA,";")
DO FILE^DICN
+11 IF +Y=-1
Begin DoDot:2
+12 DO MES^XPDUTL(" "_$PIECE(RTDATA,";")_" failed to add!")
End DoDot:2
QUIT
+13 ;set fields
+14 SET DIE=DIC
KILL DIC
+15 SET DA=+Y
+16 FOR J=2:1:5
SET DR=$GET(DR)_(J/100)_"////"_$PIECE(RTDATA,";",J)_";"
+17 DO ^DIE
End DoDot:1
if RTDATA="END"
QUIT
+18 DO MES^XPDUTL(" -> Billing Errors completed.")
+19 ;ADDER
QUIT
+20 ;
+21 ;
ADDRS ; Add Rate Schedules (363) for FEE REIMB INS
+1 DO MES^XPDUTL(" -> Adding new Rate Schedules to file 363 ...")
+2 NEW IBA,IBCNT,IBI,IBLN,IBFN,IBRT,IBBS,IBCNTCS,IBDISP,IBJ,IBLNCS,IBCS,IBCSFN,IBADMIN,DD,DO,DLAYGO,DIC,DIE,DA,DR,RXDT,X,Y
SET IBCNT=0
+3 FOR IBI=1:1
SET IBLN=$PIECE($TEXT(RSF+IBI),";;",2)
if IBLN="END"
QUIT
IF $EXTRACT(IBLN)?1A
Begin DoDot:1
+4 ;Check for problems
+5 ;Already exists
IF $ORDER(^IBE(363,"B",$PIECE(IBLN,U,1),0))
QUIT
+6 ;Billable service invalid
SET IBBS=$PIECE(IBLN,U,4)
IF IBBS'=""
SET IBBS=$$MCCRUTL(IBBS,13)
if 'IBBS
QUIT
+7 SET IBRT=$PIECE(IBLN,U,2)
SET IBRT=$ORDER(^DGCR(399.3,"B",IBRT,0))
Begin DoDot:2
+8 IF 'IBRT
DO MSG(" **** Rate Type "_$PIECE(IBLN,U,2)_" not defined, RS "_$PIECE(IBLN,U,1)_" not created")
+9 IF +$PIECE($GET(^DGCR(399.3,+IBRT,0)),U,3)
SET IBRT=0
DO MSG(" **** Rate Type "_$PIECE(IBLN,U,2)_" not Active, RS "_$PIECE(IBLN,U,1)_" not created")
End DoDot:2
if 'IBRT
QUIT
+10 ;No problems found, so create entry
+11 KILL DD,DO
+12 SET DLAYGO=363
SET DIC="^IBE(363,"
SET DIC(0)="L"
SET X=$PIECE(IBLN,U,1)
+13 DO FILE^DICN
KILL DIC,DINUM,DLAYGO
+14 IF Y<1
KILL X,Y
QUIT
+15 SET IBFN=+Y
SET IBCNT=IBCNT+1
+16 SET DR=".02////"_IBRT_";.03////"_$PIECE(IBLN,U,3)
IF +IBBS
SET DR=DR_";.04////"_IBBS
+17 SET DR=DR_";.05////"_$SELECT($PIECE(IBLN,U,1)["RX":3110318,1:3031219)
+18 IF $PIECE(IBLN,U,1)["RX"
SET RXDT=$$RXDT()
+19 IF $PIECE(IBLN,U,1)["RX"
IF IBDISP]""
SET DR=DR_";1.01///"_IBDISP
+20 IF $PIECE(IBLN,U,1)["RX"
IF IBADMIN]""
SET DR=DR_";1.02////"_IBADMIN
+21 SET DIE="^IBE(363,"
SET DA=+Y
DO ^DIE
KILL DIE,DA,DR,X,Y
+22 SET IBCNTCS=0
+23 ; add all Reasonable Charges Charge Sets
+24 SET IBCNTCS=$$RSCS(IBFN)
+25 DO MES^XPDUTL(" Total Reasonable Charge Set"_$SELECT(IBCNTCS=1:" ",1:"s ")_IBCNTCS_" added to the rate schedule.")
End DoDot:1
+26 DO MES^XPDUTL(" Rate Schedules completed.")
+27 ;ADDRS
QUIT
+28 ;
RSCS(IBFN) ; add existing Charge Sets to FR
+1 ; copy the Charge Sets from the corresponding RI RS (v2)
+2 NEW IBCNT,IBNRS,IBRSNM,IBTY,IBVDT,IBCOPY,IBCS,IBCS0,IBXFN,IBCSFN,IBCSNM,IBCSAA,IBNAME
+3 SET (IBCNT,IBCOPY)=0
+4 SET IBNRS=$GET(^IBE(363,+$GET(IBFN),0))
SET IBRSNM=$PIECE(IBNRS,"^",1)
+5 SET IBTY=$PIECE(IBNRS,"^",3)
+6 SET IBVDT=$$VERSDT^IBCRU8(2)
+7 IF IBRSNM["INPT"
SET IBCOPY=+$$RSEXISTS(IBVDT,"RI-INPT")
+8 IF IBRSNM["SNF"
SET IBCOPY=+$$RSEXISTS(IBVDT,"RI-SNF")
+9 IF IBRSNM["OPT"
SET IBCOPY=+$$RSEXISTS(IBVDT,"RI-OPT")
+10 IF IBRSNM["RX"
SET IBVDT=RXDT
SET IBCOPY=$$RSEXISTS(IBVDT,"RI-RX")
+11 IF 'IBCOPY
GOTO RSCSQ
+12 IF +$PIECE($GET(^IBE(363,+IBCOPY,0)),U,3)=IBTY
Begin DoDot:1
+13 SET IBXFN=0
FOR
SET IBXFN=$ORDER(^IBE(363,IBCOPY,11,IBXFN))
if 'IBXFN
QUIT
Begin DoDot:2
+14 SET IBCS=$GET(^IBE(363,IBCOPY,11,IBXFN,0))
SET IBCSFN=+IBCS
+15 IF +$$RSCSFILE(IBFN,$PIECE($GET(^IBE(363.1,IBCSFN,0)),U,1),$PIECE(IBCS,U,2))
SET IBCNT=IBCNT+1
End DoDot:2
End DoDot:1
RSCSQ QUIT IBCNT
+1 ;
+2 ;
RSCSFILE(IBFN,IBCSNM,IBCSAA) ; Add Charge Set to a Rate Schedule
+1 NEW IBX,DD,DO,DLAYGO,DIC,DA,DR,X,Y,IBCSFN
SET IBX=0
+2 IF $GET(^IBE(363,+$GET(IBFN),0))=""
GOTO RSCSFQ
+3 IF $GET(IBCSNM)=""
GOTO RSCSFQ
+4 SET IBCSFN=$ORDER(^IBE(363.1,"B",IBCSNM,0))
IF 'IBCSFN
GOTO RSCSFQ
+5 IF $ORDER(^IBE(363,IBFN,11,"B",IBCSFN,0))
GOTO RSCSFQ
+6 SET DLAYGO=363
SET DA(1)=+IBFN
SET DIC="^IBE(363,"_DA(1)_",11,"
SET DIC(0)="L"
+7 SET X=IBCSNM
SET DIC("DR")=".02///"_$GET(IBCSAA)
SET DIC("P")="363.0011P"
+8 DO ^DIC
if +Y
SET IBX=1
RSCSFQ QUIT IBX
+1 ;
+2 ;
RSEXISTS(IBVDT,IBNAME) ; return RS IFN if Rate Schedule exists for Effective Date
+1 NEW IBX,IBRSFN,IBRS0
SET IBX=0
+2 SET IBRSFN=0
FOR
SET IBRSFN=$ORDER(^IBE(363,IBRSFN))
if 'IBRSFN
QUIT
Begin DoDot:1
+3 SET IBRS0=$GET(^IBE(363,IBRSFN,0))
+4 IF $PIECE(IBRS0,U,1)=IBNAME
IF $PIECE(IBRS0,U,5)=IBVDT
SET IBX=IBRSFN
End DoDot:1
IF IBX
QUIT
+5 QUIT IBX
+6 ;
+7 ;
MCCRUTL(X,P) ; returns IFN of item in 399.1 if Name is found and piece P is true
+1 NEW IBX,IBY
SET IBY=""
+2 IF $GET(X)'=""
SET IBX=0
FOR
SET IBX=$ORDER(^DGCR(399.1,"B",X,IBX))
if 'IBX
QUIT
IF $PIECE($GET(^DGCR(399.1,IBX,0)),U,+$GET(P))
SET IBY=IBX
+3 QUIT IBY
+4 ;
+5 ;
MSG(X) ;
+1 NEW IBX
SET IBX=$ORDER(IBA(999999),-1)
if 'IBX
SET IBX=1
SET IBX=IBX+1
+2 SET IBA(IBX)=$GET(X)
+3 ;MSG
QUIT
+4 ;
+5 ;
RXDT() ;Copy the active RX charge schedule from RI to FR
+1 SET IBCS=""
SET IBCS=$ORDER(^IBE(363,"B","RI-RX",IBCS),-1)
+2 SET IBCS0=^IBE(363,IBCS,0)
+3 SET IBDISP=$PIECE($GET(^IBE(363,IBCS,1)),U,1)
SET IBADMIN=$GET(^IBE(363,IBCS,10))
+4 QUIT $PIECE(IBCS0,U,5)
+5 ;
+6 ;
NEWRT ;Rate Type
+1 ;;FEE REIMB INS;FEE REIMB INS;;FEE INS;1;45;;1;1;1;28
+2 ;;END
+3 ;
NEWBE ;Billing Errors
+1 ;;INCORRECT NON-VA RATE;Non-VA rate type used for bill that is not Non-VA;IB360;1;1
+2 ;;NON-VA RATE TYPE REQUIRED;Non-VA bill requires use of Non-VA rate type;IB361;1;1
+3 ;;END
+4 ;
RSF ;Rate Schedules (363) for FEE REIMB INS
+1 ;;FR-INPT^FEE REIMB INS^1^INPATIENT
+2 ;;FR-SNF^FEE REIMB INS^1^SKILLED NURSING
+3 ;;FR-OPT^FEE REIMB INS^3
+4 ;;FR-RX^FEE REIMB INS^3
+5 ;;END
+6 ;
CLM ;CLAIMS TRACKING TYPE FILE (356.6)
+1 ;;OPT-NON VA CARE^ONVC^2^1^1^1^^6
+2 ;;INP-NON VA CARE^INVC^1^^10^^^7
+3 ;;RX-NON VA CARE^RXNVC^3^1^5^1^^8
+4 ;;END
