BGP1CPU4 ; IHS/CMI/LAB - calc CMS measures ;
;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
;
;
WPOSTINF ;EP
I $Y>(BGPIOSL-8) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
W !!?2,"Post-Operative Infection? ",BGPPOSTI
I BGPPOSTI="" Q
W !?2,"NOTE: Review patient's chart to determine if patient should be excluded"
W !,"to see if all conditions are true: 1) there is physician/APN/PA documentation"
W !,"the patient is being treated for an infection, 2) infection occurred during"
W !,"specified timeframe, and 3) where treatment was administered via an "
W !,"antibiotic administration route listed in the SIP inclusions for the"
W !,"Data Element 'Antibiotic Administration Route.'"
Q
;
PERI ;EP
I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
W !!?2,$S(BGPPEX[1:"*",1:""),"Preoperative Infectious Disease Diagnosis? ",$P($$ADMPRIM^BGP1CU5(BGPVINP,"BGP CMS INFECTIOUS DXS"),U,2)
Q
;
WANTIRX ;EP
S X=0,C=0 F S X=$O(BGPDATA(X)) Q:X'=+X S C=C+1
I $Y>(BGPIOSL-(C+3)) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
W !!?2,"Recent Antibiotic Rx Status: "
I $D(BGPDATA) S X=0 F S X=$O(BGPDATA(X)) Q:X'=+X W !?4,BGPDATA(X)
;W !
Q
;
OTHSURG ;EP
I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
W !!?2,"Other Surgery with Anesthesia? "
K BGPG
K BGPY S BGPC=0,F=""
K BGPG
S Y="BGPG("
S X=DFN_"^ALL PROCEDURES;DURING "_$$VD^APCLV(BGPVSIT)_"-"_$$DSCH^BGP1CU(BGPVINP) S E=$$START1^APCLDF(X,Y)
S Y=0 F S Y=$O(BGPG(Y)) Q:Y'=+Y S X=+$P(BGPG(Y),U,4) D
.Q:'$D(^AUPNVPRC(X,0))
.Q:$P(^AUPNVPRC(X,0),U)=$P(BGPPROC(1),U,2)
.;Q:$P(^AUPNVPRC(X,0),U,8)'="Y"
.S D=$S($P(^AUPNVPRC(X,0),U,6)]"":$P(^AUPNVPRC(X,0),U,6),1:$P($P(BGPVSIT0,U),"."))
.S E=$P(BGPPROC(1),U,3)
.I $$ABS^XLFMTH($$FMDIFF^XLFDT(D,E))>4 Q ;more than 4 days
.W !?4,$$VAL^XBDIQ1(9000010.08,X,.01)," ",$$DATE^BGP1UTL(D)," ",$$VAL^XBDIQ1(9000010.08,X,.04) S F=1
Q:'F
W !,"NOTE: To determine if patient should be excluded, review patients chart"
W !,"to determine if anesthesia was general or spinal anesthesia and occurred"
W !,"during the specified timeframe."
Q
;
INF ;EP
I $Y>(BGPIOSL-5) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
W !!?2,"Infection Documented at Time of Surgery? ",$S($P(BGPPROC(1),U,4)="":"NO",1:$P(BGPPROC(1),U,4))
I BGPPROC(1)="" Q
I $P(BGPPROC(1),U,4)="" Q
I $P(BGPPROC(1),U,4)["N" Q
W !,"NOTE: Review patient's chart to determine if patient should be excluded"
W !,"when infection was present to see if infection was documented by "
W !,"physician/APN/PA prior to this surgery."
Q
WOTHPROC ;EP
K BGPXX
S BGPC=0
S BGPB=(9999999-$$DSCH^BGP1CU(BGPVINP))-1,BGPE=9999999-$P($P(^AUPNVSIT(BGPVSIT,0),U),".")
F S BGPB=$O(^AUPNVPRC("AA",DFN,BGPB)) Q:BGPB'=+BGPB!(BGPB>BGPE) D
.S X=0 F S X=$O(^AUPNVPRC("AA",DFN,BGPB,X)) Q:X'=+X D
..Q:'$D(^AUPNVPRC(X,0))
..Q:$P(^AUPNVPRC(X,0),U)=$P(BGPPROC(1),U,2)
..S BGPC=BGPC+1,BGPXX(BGPC)=$$VAL^XBDIQ1(9000010.08,X,.01)_" "_$$VAL^XBDIQ1(9000010.08,X,.04)
;go through visits in a date range for this patient, check cpts
NEW D,BD,ED,Y,D,V
S BGPB=9999999-$$DSCH^BGP1CU(BGPVINP),BGPE=9999999-$P($P(^AUPNVSIT(BGPVSIT,0),U),".")
F S BGPB=$O(^AUPNVSIT("AA",DFN,BGPB)) Q:BGPB=""!($P(BGPB,".")>BGPE) D
.S V=0 F S V=$O(^AUPNVSIT("AA",DFN,BGPB,V)) Q:V'=+V D
..Q:'$D(^AUPNVSIT(V,0))
..Q:'$D(^AUPNVCPT("AD",V))
..S X=0 F S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X D
...S BGPC=BGPC+1,BGPXX(BGPC)=$$VAL^XBDIQ1(9000010.18,X,.01)_" "_$P($$CPT^ICPTCOD($P(^AUPNVCPT(X,0),U),(9999999-BGPB)),U,3)
...Q
..Q
.Q
S (C,X)=0 F S X=$O(BGPXX(X)) Q:X'=+X S C=C+1
I $Y>(BGPIOSL-(C+3)) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
W !?2,"Other Procedures for this Visit:"
S BGPX=0 F S BGPX=$O(BGPXX(BGPX)) Q:BGPX'=+BGPX W !?4,BGPXX(BGPX)
Q
;
WPP1 ;EP
I $Y>(BGPIOSL-4) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
W !?2,"Principle Procedure: ",$P(BGPPROC(1),U,1)
S X=1 F S X=$O(BGPPROC(X)) Q:X'=+X W !?23,$P(BGPPROC(X),U,1)
W !?2,$S(BGPPPD<$P($P(BGPVSIT0,U),"."):"*",1:""),"Principle Procedure Date: ",$$DATE^BGP1UTL(BGPPPD)
Q
;
WPP ;EP
I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
W:'$D(BGPNOBA) ! W !?2,"Principle Procedure: ",BGPDATA(1)
S X=1 F S X=$O(BGPDATA(X)) Q:X'=+X W !?23,BGPDATA(X)
Q
;
WDOD(V) ;EP - write dod
I $Y>(BGPIOSL-2) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
I $$DOD^AUPNPAT(V)]"" D
.W !!?2,"*Date of Death: ",$$DATE^BGP1UTL($$DOD^AUPNPAT(V))
Q
;
WDT(V) ;EP - write discharge type at column 3
I $Y>(BGPIOSL-2) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
W:'$D(BGPNOBA) ! W !?2,"Discharge Type: ",$$VAL^XBDIQ1(9000010.02,V,.06)
Q
;
WTT(V) ;EP - write transferred to
I $Y>(BGPIOSL-2) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
W !?2,"Transferred to: ",$$VAL^XBDIQ1(9000010.02,V,.09)
Q
;
WPPDPOV(V) ;EP
I $Y>(BGPIOSL-2) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
W:'$D(BGPNOBA) ! W !?2,"Primary Discharge POV: "_$$PRIMPOV^APCLV(V,"C")," ",$$PRIMPOV^APCLV(V,"N")
Q
;
;
OTHDPOVS(V) ;EP write out other discharge povs
NEW X,C
S (X,C)=0 F S X=$O(^AUPNVPOV("AD",BGPVSIT,X)) Q:X'=+X D
.Q:'$D(^AUPNVPOV(X,0))
.Q:$P(^AUPNVPOV(X,0),U,12)="P"
.S C=C+1
.Q
I $Y>(BGPIOSL-(C+2)) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
W !!?2,"Other Discharge POVs for this visit:",$S(C=0:" None",1:"")
S (X,C)=0 F S X=$O(^AUPNVPOV("AD",BGPVSIT,X)) Q:X'=+X D
.Q:'$D(^AUPNVPOV(X,0))
.Q:$P(^AUPNVPOV(X,0),U,12)="P"
.S C=C+1
.S I=$P(^AUPNVPOV(X,0),U),I=$P($$ICDDX^ICDCODE(I),U,2)
.S N=$$VAL^XBDIQ1(9000010.07,X,.04),N=$$UP^XLFSTR(N)
.W !?4,I,?11,N
Q
GETTXT ;EP - GENERALIZED TEXT PRINTER
S BGPLETP("DLT")=1,BGPLETP("ILN")=75
F BGPLETP("Q")=0:0 S:BGPLETP("NRQ")]""&(($L(BGPLETP("NRQ"))+$L(BGPLETP("TXT"))+2)<255) BGPLETP("TXT")=$S(BGPLETP("TXT")]"":BGPLETP("TXT")_"; ",1:"")_BGPLETP("NRQ"),BGPLETP("NRQ")="" Q:BGPLETP("TXT")="" D GETTXT2
K BGPLETP("ILN"),BGPLETP("DLT"),BGPLETP("F"),BGPLETP("C"),BGPLETP("TXT")
Q
GETTXT2 D GETFRAG S BGPLEC=BGPLEC+1,BGPLETXT(BGPLEC)="" F X=1:1:BGPLETP("ICL") S BGPLETXT(BGPLEC)=BGPLETXT(BGPLEC)_" "
S BGPLETXT(BGPLEC)=BGPLETXT(BGPLEC)_BGPLETP("F"),BGPLETP("ICL")=BGPLETP("ICL")+BGPLETP("DLT"),BGPLETP("ILN")=BGPLETP("ILN")-BGPLETP("DLT"),BGPLETP("DLT")=0
Q
GETFRAG I $L(BGPLETP("TXT"))<BGPLETP("ILN") S BGPLETP("F")=BGPLETP("TXT"),BGPLETP("TXT")="" Q
F BGPLETP("C")=BGPLETP("ILN"):-1:1 Q:$E(BGPLETP("TXT"),BGPLETP("C"))=" "
S BGPLETP("F")=$E(BGPLETP("TXT"),1,BGPLETP("C")-1),BGPLETP("TXT")=$E(BGPLETP("TXT"),BGPLETP("C")+1,255)
Q
BGP1CPU4 ; IHS/CMI/LAB - calc CMS measures ;
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
+2 ;
+3 ;
WPOSTINF ;EP
+1 IF $Y>(BGPIOSL-8)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 WRITE !!?2,"Post-Operative Infection? ",BGPPOSTI
+3 IF BGPPOSTI=""
QUIT
+4 WRITE !?2,"NOTE: Review patient's chart to determine if patient should be excluded"
+5 WRITE !,"to see if all conditions are true: 1) there is physician/APN/PA documentation"
+6 WRITE !,"the patient is being treated for an infection, 2) infection occurred during"
+7 WRITE !,"specified timeframe, and 3) where treatment was administered via an "
+8 WRITE !,"antibiotic administration route listed in the SIP inclusions for the"
+9 WRITE !,"Data Element 'Antibiotic Administration Route.'"
+10 QUIT
+11 ;
PERI ;EP
+1 IF $Y>(BGPIOSL-3)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 WRITE !!?2,$SELECT(BGPPEX[1:"*",1:""),"Preoperative Infectious Disease Diagnosis? ",$PIECE($$ADMPRIM^BGP1CU5(BGPVINP,"BGP CMS INFECTIOUS DXS"),U,2)
+3 QUIT
+4 ;
WANTIRX ;EP
+1 SET X=0
SET C=0
FOR
SET X=$ORDER(BGPDATA(X))
IF X'=+X
QUIT
SET C=C+1
+2 IF $Y>(BGPIOSL-(C+3))
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+3 WRITE !!?2,"Recent Antibiotic Rx Status: "
+4 IF $DATA(BGPDATA)
SET X=0
FOR
SET X=$ORDER(BGPDATA(X))
IF X'=+X
QUIT
WRITE !?4,BGPDATA(X)
+5 ;W !
+6 QUIT
+7 ;
OTHSURG ;EP
+1 IF $Y>(BGPIOSL-3)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 WRITE !!?2,"Other Surgery with Anesthesia? "
+3 KILL BGPG
+4 KILL BGPY
SET BGPC=0
SET F=""
+5 KILL BGPG
+6 SET Y="BGPG("
+7 SET X=DFN_"^ALL PROCEDURES;DURING "_$$VD^APCLV(BGPVSIT)_"-"_$$DSCH^BGP1CU(BGPVINP)
SET E=$$START1^APCLDF(X,Y)
+8 SET Y=0
FOR
SET Y=$ORDER(BGPG(Y))
IF Y'=+Y
QUIT
SET X=+$PIECE(BGPG(Y),U,4)
Begin DoDot:1
+9 IF '$DATA(^AUPNVPRC(X,0))
QUIT
+10 IF $PIECE(^AUPNVPRC(X,0),U)=$PIECE(BGPPROC(1),U,2)
QUIT
+11 ;Q:$P(^AUPNVPRC(X,0),U,8)'="Y"
+12 SET D=$SELECT($PIECE(^AUPNVPRC(X,0),U,6)]"":$PIECE(^AUPNVPRC(X,0),U,6),1:$PIECE($PIECE(BGPVSIT0,U),"."))
+13 SET E=$PIECE(BGPPROC(1),U,3)
+14 ;more than 4 days
IF $$ABS^XLFMTH($$FMDIFF^XLFDT(D,E))>4
QUIT
+15 WRITE !?4,$$VAL^XBDIQ1(9000010.08,X,.01)," ",$$DATE^BGP1UTL(D)," ",$$VAL^XBDIQ1(9000010.08,X,.04)
SET F=1
End DoDot:1
+16 IF 'F
QUIT
+17 WRITE !,"NOTE: To determine if patient should be excluded, review patients chart"
+18 WRITE !,"to determine if anesthesia was general or spinal anesthesia and occurred"
+19 WRITE !,"during the specified timeframe."
+20 QUIT
+21 ;
INF ;EP
+1 IF $Y>(BGPIOSL-5)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 WRITE !!?2,"Infection Documented at Time of Surgery? ",$SELECT($PIECE(BGPPROC(1),U,4)="":"NO",1:$PIECE(BGPPROC(1),U,4))
+3 IF BGPPROC(1)=""
QUIT
+4 IF $PIECE(BGPPROC(1),U,4)=""
QUIT
+5 IF $PIECE(BGPPROC(1),U,4)["N"
QUIT
+6 WRITE !,"NOTE: Review patient's chart to determine if patient should be excluded"
+7 WRITE !,"when infection was present to see if infection was documented by "
+8 WRITE !,"physician/APN/PA prior to this surgery."
+9 QUIT
WOTHPROC ;EP
+1 KILL BGPXX
+2 SET BGPC=0
+3 SET BGPB=(9999999-$$DSCH^BGP1CU(BGPVINP))-1
SET BGPE=9999999-$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),".")
+4 FOR
SET BGPB=$ORDER(^AUPNVPRC("AA",DFN,BGPB))
IF BGPB'=+BGPB!(BGPB>BGPE)
QUIT
Begin DoDot:1
+5 SET X=0
FOR
SET X=$ORDER(^AUPNVPRC("AA",DFN,BGPB,X))
IF X'=+X
QUIT
Begin DoDot:2
+6 IF '$DATA(^AUPNVPRC(X,0))
QUIT
+7 IF $PIECE(^AUPNVPRC(X,0),U)=$PIECE(BGPPROC(1),U,2)
QUIT
+8 SET BGPC=BGPC+1
SET BGPXX(BGPC)=$$VAL^XBDIQ1(9000010.08,X,.01)_" "_$$VAL^XBDIQ1(9000010.08,X,.04)
End DoDot:2
End DoDot:1
+9 ;go through visits in a date range for this patient, check cpts
+10 NEW D,BD,ED,Y,D,V
+11 SET BGPB=9999999-$$DSCH^BGP1CU(BGPVINP)
SET BGPE=9999999-$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),".")
+12 FOR
SET BGPB=$ORDER(^AUPNVSIT("AA",DFN,BGPB))
IF BGPB=""!($PIECE(BGPB,".")>BGPE)
QUIT
Begin DoDot:1
+13 SET V=0
FOR
SET V=$ORDER(^AUPNVSIT("AA",DFN,BGPB,V))
IF V'=+V
QUIT
Begin DoDot:2
+14 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+15 IF '$DATA(^AUPNVCPT("AD",V))
QUIT
+16 SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",V,X))
IF X'=+X
QUIT
Begin DoDot:3
+17 SET BGPC=BGPC+1
SET BGPXX(BGPC)=$$VAL^XBDIQ1(9000010.18,X,.01)_" "_$PIECE($$CPT^ICPTCOD($PIECE(^AUPNVCPT(X,0),U),(9999999-BGPB)),U,3)
+18 QUIT
End DoDot:3
+19 QUIT
End DoDot:2
+20 QUIT
End DoDot:1
+21 SET (C,X)=0
FOR
SET X=$ORDER(BGPXX(X))
IF X'=+X
QUIT
SET C=C+1
+22 IF $Y>(BGPIOSL-(C+3))
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+23 WRITE !?2,"Other Procedures for this Visit:"
+24 SET BGPX=0
FOR
SET BGPX=$ORDER(BGPXX(BGPX))
IF BGPX'=+BGPX
QUIT
WRITE !?4,BGPXX(BGPX)
+25 QUIT
+26 ;
WPP1 ;EP
+1 IF $Y>(BGPIOSL-4)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 WRITE !?2,"Principle Procedure: ",$PIECE(BGPPROC(1),U,1)
+3 SET X=1
FOR
SET X=$ORDER(BGPPROC(X))
IF X'=+X
QUIT
WRITE !?23,$PIECE(BGPPROC(X),U,1)
+4 WRITE !?2,$SELECT(BGPPPD<$PIECE($PIECE(BGPVSIT0,U),"."):"*",1:""),"Principle Procedure Date: ",$$DATE^BGP1UTL(BGPPPD)
+5 QUIT
+6 ;
WPP ;EP
+1 IF $Y>(BGPIOSL-3)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 IF '$DATA(BGPNOBA)
WRITE !
WRITE !?2,"Principle Procedure: ",BGPDATA(1)
+3 SET X=1
FOR
SET X=$ORDER(BGPDATA(X))
IF X'=+X
QUIT
WRITE !?23,BGPDATA(X)
+4 QUIT
+5 ;
WDOD(V) ;EP - write dod
+1 IF $Y>(BGPIOSL-2)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 IF $$DOD^AUPNPAT(V)]""
Begin DoDot:1
+3 WRITE !!?2,"*Date of Death: ",$$DATE^BGP1UTL($$DOD^AUPNPAT(V))
End DoDot:1
+4 QUIT
+5 ;
WDT(V) ;EP - write discharge type at column 3
+1 IF $Y>(BGPIOSL-2)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 IF '$DATA(BGPNOBA)
WRITE !
WRITE !?2,"Discharge Type: ",$$VAL^XBDIQ1(9000010.02,V,.06)
+3 QUIT
+4 ;
WTT(V) ;EP - write transferred to
+1 IF $Y>(BGPIOSL-2)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 WRITE !?2,"Transferred to: ",$$VAL^XBDIQ1(9000010.02,V,.09)
+3 QUIT
+4 ;
WPPDPOV(V) ;EP
+1 IF $Y>(BGPIOSL-2)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 IF '$DATA(BGPNOBA)
WRITE !
WRITE !?2,"Primary Discharge POV: "_$$PRIMPOV^APCLV(V,"C")," ",$$PRIMPOV^APCLV(V,"N")
+3 QUIT
+4 ;
+5 ;
OTHDPOVS(V) ;EP write out other discharge povs
+1 NEW X,C
+2 SET (X,C)=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",BGPVSIT,X))
IF X'=+X
QUIT
Begin DoDot:1
+3 IF '$DATA(^AUPNVPOV(X,0))
QUIT
+4 IF $PIECE(^AUPNVPOV(X,0),U,12)="P"
QUIT
+5 SET C=C+1
+6 QUIT
End DoDot:1
+7 IF $Y>(BGPIOSL-(C+2))
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+8 WRITE !!?2,"Other Discharge POVs for this visit:",$SELECT(C=0:" None",1:"")
+9 SET (X,C)=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",BGPVSIT,X))
IF X'=+X
QUIT
Begin DoDot:1
+10 IF '$DATA(^AUPNVPOV(X,0))
QUIT
+11 IF $PIECE(^AUPNVPOV(X,0),U,12)="P"
QUIT
+12 SET C=C+1
+13 SET I=$PIECE(^AUPNVPOV(X,0),U)
SET I=$PIECE($$ICDDX^ICDCODE(I),U,2)
+14 SET N=$$VAL^XBDIQ1(9000010.07,X,.04)
SET N=$$UP^XLFSTR(N)
+15 WRITE !?4,I,?11,N
End DoDot:1
+16 QUIT
GETTXT ;EP - GENERALIZED TEXT PRINTER
+1 SET BGPLETP("DLT")=1
SET BGPLETP("ILN")=75
+2 FOR BGPLETP("Q")=0:0
IF BGPLETP("NRQ")]""&(($LENGTH(BGPLETP("NRQ"))+$LENGTH(BGPLETP("TXT"))+2)<255)
SET BGPLETP("TXT")=$SELECT(BGPLETP("TXT")]"":BGPLETP("TXT")_"; ",1:"")_BGPLETP("NRQ")
SET BGPLETP("NRQ")=""
IF BGPLETP("TXT")=""
QUIT
DO GETTXT2
+3 KILL BGPLETP("ILN"),BGPLETP("DLT"),BGPLETP("F"),BGPLETP("C"),BGPLETP("TXT")
+4 QUIT
GETTXT2 DO GETFRAG
SET BGPLEC=BGPLEC+1
SET BGPLETXT(BGPLEC)=""
FOR X=1:1:BGPLETP("ICL")
SET BGPLETXT(BGPLEC)=BGPLETXT(BGPLEC)_" "
+1 SET BGPLETXT(BGPLEC)=BGPLETXT(BGPLEC)_BGPLETP("F")
SET BGPLETP("ICL")=BGPLETP("ICL")+BGPLETP("DLT")
SET BGPLETP("ILN")=BGPLETP("ILN")-BGPLETP("DLT")
SET BGPLETP("DLT")=0
+2 QUIT
GETFRAG IF $LENGTH(BGPLETP("TXT"))<BGPLETP("ILN")
SET BGPLETP("F")=BGPLETP("TXT")
SET BGPLETP("TXT")=""
QUIT
+1 FOR BGPLETP("C")=BGPLETP("ILN"):-1:1
IF $EXTRACT(BGPLETP("TXT"),BGPLETP("C"))=" "
QUIT
+2 SET BGPLETP("F")=$EXTRACT(BGPLETP("TXT"),1,BGPLETP("C")-1)
SET BGPLETP("TXT")=$EXTRACT(BGPLETP("TXT"),BGPLETP("C")+1,255)
+3 QUIT
