- IBCEF21 ;ALB/TMP - FORMATTER SPECIFIC BILL FUNCTIONS CONTINUED ; 3/9/11 1:12pm
- ;;2.0;INTEGRATED BILLING;**51,296,371,389,448,516,592**;21-MAR-94;Build 58
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- COID(IBIFN) ; Claim office ID
- N IBCOID,IBCOID1,IBIN
- S IBIN=$$CURR^IBCEF2(IBIFN),IBCOID1="",IBCOID=$P($$ADDRESS^IBCNSC0(IBIN,.11,5),U,11)
- ;
- I IBIN D
- . I $D(^IBA(364.2,"C",IBIFN)) S IBCOID1=$P($$ADDRESS^IBCNSC0(IBIN,.18,5),U,11) Q ;Rx
- . I $P($G(^DGCR(399,IBIFN,0)),U,5)<3 S IBCOID1=$P($$ADDRESS^IBCNSC0(IBIN,.12,5),U,11) Q ;Inpt
- . I $P($G(^DGCR(399,IBIFN,0)),U,5)'<3 S IBCOID1=$P($$ADDRESS^IBCNSC0(IBIN,.16,5),U,11) Q ;Outpt
- . ;JWS;IB*2.0*592;Dental insurance mailing address info
- . I $$FT^IBCEF(IBIFN)=7 S IBCOID1=$P($$ADDRESS^IBCNSC0(IBIN,.19,11),U,11) Q ;Dental
- ;
- Q $S(IBCOID1'="":IBCOID1,1:IBCOID)
- ;
- ESGHPST(IBIFN,COB) ; return insureds employment status if the bill policy defined by COB is an Employer Sponsored Group Health Plan
- ; ESGHP FLAG (2.312,2.1) ^ the employment status (2.312,2.11)
- ;
- N PPOL,DFN,X,Y S Y=""
- S PPOL=$$PPOL^IBCEF2($G(IBIFN),$G(COB)),DFN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,2)
- I +PPOL,+DFN S X=$G(^DPT(DFN,.312,+PPOL,2)) S Y=+$P(X,U,10)_U_$P(X,U,11)
- Q Y
- ;
- ESGHPNL(IBIFN,COB) ; return employer name and location if the bill policy defined by COB is an Employer Sponsored Group Health Plan
- ; ESGHP FLAG (2.312,2.1) ^ employer name (2.312,2.015) ^ employer city (2.312,2.05)
- ; ^ employer state abbr (2.312,2.06) ^ employer state ifn (2.312,2.06)
- ;
- N PPOL,DFN,X,Y S Y=""
- S PPOL=$$PPOL^IBCEF2($G(IBIFN),$G(COB)),DFN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,2)
- I +PPOL,+DFN S X=$G(^DPT(DFN,.312,+PPOL,2)) S Y=+$P(X,U,10)_U_$P(X,U,9)_U_$P(X,U,5)_U_$P($G(^DIC(5,+$P(X,U,6),0)),U,2)_U_$P(X,U,6)
- Q Y
- ;
- ;IBIFN = bill ien
- N Z,Z0,Z1,IBARRAY,IBSM
- S Z=0
- ;S:$P($G(^DGCR(399,IBIFN,"U1")),U,2) Z=Z+1,Z0=$P(^("U1"),U,2),IBXDATA(Z)="OFFSET AMOUNT: "_"$"_+$P(Z0,".")_"."_$E($P(Z0,".",2)_"00",1,2)
- S:$P($G(^DGCR(399,IBIFN,"U1")),U,8)'="" Z=Z+1,IBXDATA(Z)=$P(^("U1"),U,8) ;Bill comment on bill
- S Z0=$G(^DGCR(399,IBIFN,0)),Z1=$G(^DGCR(399.3,+$P(Z0,U,7),0))
- D SET^IBCSC5B(IBIFN,.IBARRAY)
- I $P($G(IBARRAY),U,2) D ;Prosthetics
- . S Z0=0 F S Z0=$O(IBARRAY(Z0)) Q:Z0="" S Z1=0 F S Z1=$O(IBARRAY(Z0,Z1)) Q:'Z1 S Z=Z+1,IBXDATA(Z)="Prosthetic: "_$E($$PINB^IBCSC5B(+IBARRAY(Z0,Z1)),1,39)_" "_$E(Z0,4,5)_"/"_$E(Z0,6,7)_"/"_$E(Z0,1,2)
- Q
- ;
- CREM(IBIFN) ; Compile array of bill remarks common to every bill
- ;IBIFN = bill ien
- N Z
- S Z=0
- S:$P($G(^IBE(350.9,1,1)),U,4)'="" Z=Z+1,IBXDATA(Z)=$P(^(1),U,4) ;Site specific 'every bill' comment
- Q
- ;
- ADMDT(IBIFN,NOOUTCK) ; Calculate admission/start of care date/time
- ; IBIFN = bill ien
- ; NOOUTCK = flag that will:
- ; (1) no check for inpt episode overlap for outpt
- ; (0 or null) performs check for inpt episode overlap for outpt
- ;
- ; Returns IBXDATA = fileman date format
- N Z,Z0,Z1
- ;JWS;IB*2.0*592;send Event Date for Admission Date for Dental claims; IA# 2056
- I $$FT^IBCEF(IBIFN)=7 S IBXDATA=$$GET1^DIQ(399,IBIFN_",",.03,"I") Q
- S Z=$G(^DGCR(399,IBIFN,0)),Z1=$P($G(^("U")),U,20),Z0=$$INPAT^IBCEF(IBIFN,1)
- S IBXDATA=$S(Z0&$P(Z,U,8):$P($G(^DGPT(+$P(Z,U,8),0)),U,2),1:"")
- S:'IBXDATA IBXDATA=$P(Z,U,3)_$S(Z0&(Z1<25):"."_$E("0",$L(Z1))_Z1,1:"")
- ; Check to see if outpt episode (date in event date) overlaps inpt
- ; episode - use admit date if it does
- I 'Z0,IBXDATA,'$G(NOOUTCK) D
- . N VAINDT,VAIN,DFN
- . S VAINDT=IBXDATA,DFN=$P($G(^DGCR(399,IBIFN,0)),U,2)
- . D INP^VADPT S IBXDATA=+VAIN(7) S:'IBXDATA IBXDATA=""
- I 'IBXDATA,'Z0 S IBXDATA=$$SERVDT^IBCEF(IBIFN,,2)
- Q
- ;
- DISDT(IBIFN) ; Calculate discharge date
- ; IBIFN = bill ien
- N Z,Z0
- ;JWS;IB*2.0*592;do not send for Discharge Date for Dental claims
- I $$FT^IBCEF(IBIFN)=7 S IBXDATA="" Q
- S Z=$$INPAT^IBCEF(IBIFN,1),Z0=$G(^DGCR(399,IBIFN,0))
- I Z S IBXDATA=+$G(^DGPT(+$P(Z0,U,8),70)) S:'IBXDATA IBXDATA=$P(Z0,U,16)
- I 'Z N VAINDT,VAIN,DFN S DFN=$P($G(^DGCR(399,IBIFN,0)),U,2) D INP^VADPT I VAIN(1) S IBXDATA=+$G(^DGPM(+$P($G(^DGPM(+VAIN(1),0)),U,17),0))
- Q
- ;
- INSSECID(IBIFN,TYPE,SEQ) ; Extract subscriber and patient prim/sec ID's
- ; IBIFN required
- ; TYPE is either "PAT" or "SUB" to indicate we need to extract either
- ; patient or subscriber ID information. Default="SUB".
- ; SEQ is the insurance sequence# (1,2,3). Default is current ins seq#.
- ;
- ; Output:
- ; Function returns an 8-piece string as follows.
- ; [1] primary qualifier
- ; [2] primary ID
- ; [3] secondary qual(1)
- ; [4] secondary ID(1)
- ; [5] secondary qual(2)
- ; [6] secondary ID(2)
- ; [7] secondary qual(3)
- ; [8] secondary ID(3)
- ;
- NEW DATA,DFN,POL,IB0,IB5,REL
- S DATA=""
- S IBIFN=+$G(IBIFN) I 'IBIFN G INSSX
- I $G(TYPE)="" S TYPE="SUB" ; default type of ID's to get
- I '$F(".PAT.SUB.","."_TYPE_".") G INSSX
- I '$G(SEQ) S SEQ=$$COBN^IBCEF(IBIFN) ; default current ins seq#
- I '$F(".1.2.3.","."_SEQ_".") G INSSX
- S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2) I 'DFN G INSSX
- S POL=+$P($G(^DGCR(399,IBIFN,"M")),U,SEQ+11) I 'POL G INSSX
- ;IB*2.0*516/baa - Use HIPAA compliant fields
- ;S IB0=$G(^DPT(DFN,.312,POL,0)) I IB0="" G INSSX ;516 - baa
- S IB0=$$ZND^IBCNS1(DFN,POL) I IB0="" G INSSX ;516 - baa
- S IB5=$G(^DPT(DFN,.312,POL,5))
- S REL=+$P(IB0,U,16) ; pat rel to insured
- S $P(DATA,U,1)="MI"
- S $P(DATA,U,2)=$P(IB0,U,2) ; subscriber primary ID
- S $P(DATA,U,3,8)=$P(IB5,U,2,7) ; subscriber secondary data
- I TYPE="PAT",REL'=1 D
- . S $P(DATA,U,2)=$P(IB5,U,1) ; patient primary ID
- . S $P(DATA,U,3,8)=$P(IB5,U,8,13) ; patient secondary data
- . Q
- ;
- S DATA=$$SCRUB(DATA) ; scrub the data
- INSSX ;
- Q DATA
- ;
- SCRUB(DATA) ; Scrub the 8-piece string gathered above
- NEW PCE
- ;
- ; make sure you can't have an ID without a qualifier or a qualifier
- ; without an ID. Check all 4 pairs.
- F PCE=1,3,5,7 D
- . I $P(DATA,U,PCE)'="",$P(DATA,U,PCE+1)'="" Q
- . S ($P(DATA,U,PCE),$P(DATA,U,PCE+1))=""
- . Q
- ;
- ; fill in secondary gaps. If Set1 and Set2 are blank, but Set3 exists
- ; then move Set3 to Set1 and delete Set3.
- I $P(DATA,U,3)="",$P(DATA,U,5)="",$P(DATA,U,7)'="" D
- . S $P(DATA,U,3)=$P(DATA,U,7),$P(DATA,U,4)=$P(DATA,U,8)
- . S ($P(DATA,U,7),$P(DATA,U,8))=""
- . Q
- ;
- ; fill in secondary gaps more generically.
- ; If Set(n) is blank, but Set(n+1) exists, then move it up.
- F PCE=3,5 D
- . I $P(DATA,U,PCE)="",$P(DATA,U,PCE+2)'="" D
- .. S $P(DATA,U,PCE)=$P(DATA,U,PCE+2)
- .. S $P(DATA,U,PCE+1)=$P(DATA,U,PCE+3)
- .. S ($P(DATA,U,PCE+2),$P(DATA,U,PCE+3))=""
- .. Q
- . Q
- ;
- Q DATA
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEF21 6788 printed Feb 18, 2025@23:36:25 Page 2
- IBCEF21 ;ALB/TMP - FORMATTER SPECIFIC BILL FUNCTIONS CONTINUED ; 3/9/11 1:12pm
- +1 ;;2.0;INTEGRATED BILLING;**51,296,371,389,448,516,592**;21-MAR-94;Build 58
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- COID(IBIFN) ; Claim office ID
- +1 NEW IBCOID,IBCOID1,IBIN
- +2 SET IBIN=$$CURR^IBCEF2(IBIFN)
- SET IBCOID1=""
- SET IBCOID=$PIECE($$ADDRESS^IBCNSC0(IBIN,.11,5),U,11)
- +3 ;
- +4 IF IBIN
- Begin DoDot:1
- +5 ;Rx
- IF $DATA(^IBA(364.2,"C",IBIFN))
- SET IBCOID1=$PIECE($$ADDRESS^IBCNSC0(IBIN,.18,5),U,11)
- QUIT
- +6 ;Inpt
- IF $PIECE($GET(^DGCR(399,IBIFN,0)),U,5)<3
- SET IBCOID1=$PIECE($$ADDRESS^IBCNSC0(IBIN,.12,5),U,11)
- QUIT
- +7 ;Outpt
- IF $PIECE($GET(^DGCR(399,IBIFN,0)),U,5)'<3
- SET IBCOID1=$PIECE($$ADDRESS^IBCNSC0(IBIN,.16,5),U,11)
- QUIT
- +8 ;JWS;IB*2.0*592;Dental insurance mailing address info
- +9 ;Dental
- IF $$FT^IBCEF(IBIFN)=7
- SET IBCOID1=$PIECE($$ADDRESS^IBCNSC0(IBIN,.19,11),U,11)
- QUIT
- End DoDot:1
- +10 ;
- +11 QUIT $SELECT(IBCOID1'="":IBCOID1,1:IBCOID)
- +12 ;
- ESGHPST(IBIFN,COB) ; return insureds employment status if the bill policy defined by COB is an Employer Sponsored Group Health Plan
- +1 ; ESGHP FLAG (2.312,2.1) ^ the employment status (2.312,2.11)
- +2 ;
- +3 NEW PPOL,DFN,X,Y
- SET Y=""
- +4 SET PPOL=$$PPOL^IBCEF2($GET(IBIFN),$GET(COB))
- SET DFN=$PIECE($GET(^DGCR(399,+$GET(IBIFN),0)),U,2)
- +5 IF +PPOL
- IF +DFN
- SET X=$GET(^DPT(DFN,.312,+PPOL,2))
- SET Y=+$PIECE(X,U,10)_U_$PIECE(X,U,11)
- +6 QUIT Y
- +7 ;
- ESGHPNL(IBIFN,COB) ; return employer name and location if the bill policy defined by COB is an Employer Sponsored Group Health Plan
- +1 ; ESGHP FLAG (2.312,2.1) ^ employer name (2.312,2.015) ^ employer city (2.312,2.05)
- +2 ; ^ employer state abbr (2.312,2.06) ^ employer state ifn (2.312,2.06)
- +3 ;
- +4 NEW PPOL,DFN,X,Y
- SET Y=""
- +5 SET PPOL=$$PPOL^IBCEF2($GET(IBIFN),$GET(COB))
- SET DFN=$PIECE($GET(^DGCR(399,+$GET(IBIFN),0)),U,2)
- +6 IF +PPOL
- IF +DFN
- SET X=$GET(^DPT(DFN,.312,+PPOL,2))
- SET Y=+$PIECE(X,U,10)_U_$PIECE(X,U,9)_U_$PIECE(X,U,5)_U_$PIECE($GET(^DIC(5,+$PIECE(X,U,6),0)),U,2)_U_$PIECE(X,U,6)
- +7 QUIT Y
- +8 ;
- +1 ;IBIFN = bill ien
- +2 NEW Z,Z0,Z1,IBARRAY,IBSM
- +3 SET Z=0
- +4 ;S:$P($G(^DGCR(399,IBIFN,"U1")),U,2) Z=Z+1,Z0=$P(^("U1"),U,2),IBXDATA(Z)="OFFSET AMOUNT: "_"$"_+$P(Z0,".")_"."_$E($P(Z0,".",2)_"00",1,2)
- +5 ;Bill comment on bill
- if $PIECE($GET(^DGCR(399,IBIFN,"U1")),U,8)'=""
- SET Z=Z+1
- SET IBXDATA(Z)=$PIECE(^("U1"),U,8)
- +6 SET Z0=$GET(^DGCR(399,IBIFN,0))
- SET Z1=$GET(^DGCR(399.3,+$PIECE(Z0,U,7),0))
- +7 DO SET^IBCSC5B(IBIFN,.IBARRAY)
- +8 ;Prosthetics
- IF $PIECE($GET(IBARRAY),U,2)
- Begin DoDot:1
- +9 SET Z0=0
- FOR
- SET Z0=$ORDER(IBARRAY(Z0))
- if Z0=""
- QUIT
- SET Z1=0
- FOR
- SET Z1=$ORDER(IBARRAY(Z0,Z1))
- if 'Z1
- QUIT
- SET Z=Z+1
- SET IBXDATA(Z)="Prosthetic: "_$EXTRACT($$PINB^IBCSC5B(+IBARRAY(Z0,Z1)),1,39)_" "_$EXTRACT(Z0,4,5)_"/"_$EXTRACT(Z0,6,7)_"/"_$EXTRACT(Z0,1,2)
- End DoDot:1
- +10 QUIT
- +11 ;
- CREM(IBIFN) ; Compile array of bill remarks common to every bill
- +1 ;IBIFN = bill ien
- +2 NEW Z
- +3 SET Z=0
- +4 ;Site specific 'every bill' comment
- if $PIECE($GET(^IBE(350.9,1,1)),U,4)'=""
- SET Z=Z+1
- SET IBXDATA(Z)=$PIECE(^(1),U,4)
- +5 QUIT
- +6 ;
- ADMDT(IBIFN,NOOUTCK) ; Calculate admission/start of care date/time
- +1 ; IBIFN = bill ien
- +2 ; NOOUTCK = flag that will:
- +3 ; (1) no check for inpt episode overlap for outpt
- +4 ; (0 or null) performs check for inpt episode overlap for outpt
- +5 ;
- +6 ; Returns IBXDATA = fileman date format
- +7 NEW Z,Z0,Z1
- +8 ;JWS;IB*2.0*592;send Event Date for Admission Date for Dental claims; IA# 2056
- +9 IF $$FT^IBCEF(IBIFN)=7
- SET IBXDATA=$$GET1^DIQ(399,IBIFN_",",.03,"I")
- QUIT
- +10 SET Z=$GET(^DGCR(399,IBIFN,0))
- SET Z1=$PIECE($GET(^("U")),U,20)
- SET Z0=$$INPAT^IBCEF(IBIFN,1)
- +11 SET IBXDATA=$SELECT(Z0&$PIECE(Z,U,8):$PIECE($GET(^DGPT(+$PIECE(Z,U,8),0)),U,2),1:"")
- +12 if 'IBXDATA
- SET IBXDATA=$PIECE(Z,U,3)_$SELECT(Z0&(Z1<25):"."_$EXTRACT("0",$LENGTH(Z1))_Z1,1:"")
- +13 ; Check to see if outpt episode (date in event date) overlaps inpt
- +14 ; episode - use admit date if it does
- +15 IF 'Z0
- IF IBXDATA
- IF '$GET(NOOUTCK)
- Begin DoDot:1
- +16 NEW VAINDT,VAIN,DFN
- +17 SET VAINDT=IBXDATA
- SET DFN=$PIECE($GET(^DGCR(399,IBIFN,0)),U,2)
- +18 DO INP^VADPT
- SET IBXDATA=+VAIN(7)
- if 'IBXDATA
- SET IBXDATA=""
- End DoDot:1
- +19 IF 'IBXDATA
- IF 'Z0
- SET IBXDATA=$$SERVDT^IBCEF(IBIFN,,2)
- +20 QUIT
- +21 ;
- DISDT(IBIFN) ; Calculate discharge date
- +1 ; IBIFN = bill ien
- +2 NEW Z,Z0
- +3 ;JWS;IB*2.0*592;do not send for Discharge Date for Dental claims
- +4 IF $$FT^IBCEF(IBIFN)=7
- SET IBXDATA=""
- QUIT
- +5 SET Z=$$INPAT^IBCEF(IBIFN,1)
- SET Z0=$GET(^DGCR(399,IBIFN,0))
- +6 IF Z
- SET IBXDATA=+$GET(^DGPT(+$PIECE(Z0,U,8),70))
- if 'IBXDATA
- SET IBXDATA=$PIECE(Z0,U,16)
- +7 IF 'Z
- NEW VAINDT,VAIN,DFN
- SET DFN=$PIECE($GET(^DGCR(399,IBIFN,0)),U,2)
- DO INP^VADPT
- IF VAIN(1)
- SET IBXDATA=+$GET(^DGPM(+$PIECE($GET(^DGPM(+VAIN(1),0)),U,17),0))
- +8 QUIT
- +9 ;
- INSSECID(IBIFN,TYPE,SEQ) ; Extract subscriber and patient prim/sec ID's
- +1 ; IBIFN required
- +2 ; TYPE is either "PAT" or "SUB" to indicate we need to extract either
- +3 ; patient or subscriber ID information. Default="SUB".
- +4 ; SEQ is the insurance sequence# (1,2,3). Default is current ins seq#.
- +5 ;
- +6 ; Output:
- +7 ; Function returns an 8-piece string as follows.
- +8 ; [1] primary qualifier
- +9 ; [2] primary ID
- +10 ; [3] secondary qual(1)
- +11 ; [4] secondary ID(1)
- +12 ; [5] secondary qual(2)
- +13 ; [6] secondary ID(2)
- +14 ; [7] secondary qual(3)
- +15 ; [8] secondary ID(3)
- +16 ;
- +17 NEW DATA,DFN,POL,IB0,IB5,REL
- +18 SET DATA=""
- +19 SET IBIFN=+$GET(IBIFN)
- IF 'IBIFN
- GOTO INSSX
- +20 ; default type of ID's to get
- IF $GET(TYPE)=""
- SET TYPE="SUB"
- +21 IF '$FIND(".PAT.SUB.","."_TYPE_".")
- GOTO INSSX
- +22 ; default current ins seq#
- IF '$GET(SEQ)
- SET SEQ=$$COBN^IBCEF(IBIFN)
- +23 IF '$FIND(".1.2.3.","."_SEQ_".")
- GOTO INSSX
- +24 SET DFN=+$PIECE($GET(^DGCR(399,IBIFN,0)),U,2)
- IF 'DFN
- GOTO INSSX
- +25 SET POL=+$PIECE($GET(^DGCR(399,IBIFN,"M")),U,SEQ+11)
- IF 'POL
- GOTO INSSX
- +26 ;IB*2.0*516/baa - Use HIPAA compliant fields
- +27 ;S IB0=$G(^DPT(DFN,.312,POL,0)) I IB0="" G INSSX ;516 - baa
- +28 ;516 - baa
- SET IB0=$$ZND^IBCNS1(DFN,POL)
- IF IB0=""
- GOTO INSSX
- +29 SET IB5=$GET(^DPT(DFN,.312,POL,5))
- +30 ; pat rel to insured
- SET REL=+$PIECE(IB0,U,16)
- +31 SET $PIECE(DATA,U,1)="MI"
- +32 ; subscriber primary ID
- SET $PIECE(DATA,U,2)=$PIECE(IB0,U,2)
- +33 ; subscriber secondary data
- SET $PIECE(DATA,U,3,8)=$PIECE(IB5,U,2,7)
- +34 IF TYPE="PAT"
- IF REL'=1
- Begin DoDot:1
- +35 ; patient primary ID
- SET $PIECE(DATA,U,2)=$PIECE(IB5,U,1)
- +36 ; patient secondary data
- SET $PIECE(DATA,U,3,8)=$PIECE(IB5,U,8,13)
- +37 QUIT
- End DoDot:1
- +38 ;
- +39 ; scrub the data
- SET DATA=$$SCRUB(DATA)
- INSSX ;
- +1 QUIT DATA
- +2 ;
- SCRUB(DATA) ; Scrub the 8-piece string gathered above
- +1 NEW PCE
- +2 ;
- +3 ; make sure you can't have an ID without a qualifier or a qualifier
- +4 ; without an ID. Check all 4 pairs.
- +5 FOR PCE=1,3,5,7
- Begin DoDot:1
- +6 IF $PIECE(DATA,U,PCE)'=""
- IF $PIECE(DATA,U,PCE+1)'=""
- QUIT
- +7 SET ($PIECE(DATA,U,PCE),$PIECE(DATA,U,PCE+1))=""
- +8 QUIT
- End DoDot:1
- +9 ;
- +10 ; fill in secondary gaps. If Set1 and Set2 are blank, but Set3 exists
- +11 ; then move Set3 to Set1 and delete Set3.
- +12 IF $PIECE(DATA,U,3)=""
- IF $PIECE(DATA,U,5)=""
- IF $PIECE(DATA,U,7)'=""
- Begin DoDot:1
- +13 SET $PIECE(DATA,U,3)=$PIECE(DATA,U,7)
- SET $PIECE(DATA,U,4)=$PIECE(DATA,U,8)
- +14 SET ($PIECE(DATA,U,7),$PIECE(DATA,U,8))=""
- +15 QUIT
- End DoDot:1
- +16 ;
- +17 ; fill in secondary gaps more generically.
- +18 ; If Set(n) is blank, but Set(n+1) exists, then move it up.
- +19 FOR PCE=3,5
- Begin DoDot:1
- +20 IF $PIECE(DATA,U,PCE)=""
- IF $PIECE(DATA,U,PCE+2)'=""
- Begin DoDot:2
- +21 SET $PIECE(DATA,U,PCE)=$PIECE(DATA,U,PCE+2)
- +22 SET $PIECE(DATA,U,PCE+1)=$PIECE(DATA,U,PCE+3)
- +23 SET ($PIECE(DATA,U,PCE+2),$PIECE(DATA,U,PCE+3))=""
- +24 QUIT
- End DoDot:2
- +25 QUIT
- End DoDot:1
- +26 ;
- +27 QUIT DATA
- +28 ;