BJPNPRNT ;GDIT/HS/BEE-Prenatal Care Module Print Handling Calls ; 08 May 2012 12:00 PM
;;2.0;PRENATAL CARE MODULE;;Feb 24, 2015;Build 63
;
Q
;
GDFLT(DATA,LOC) ;BJPN GET DEF PRNT
;
;Returns current default printer for user
;
S LOC=+$G(LOC)
;
NEW UID,II,RET
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BJPNPRNT",UID))
K @DATA
I $G(DT)=""!($G(U)="") D DT^DICRW
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNPRNT D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
;
S II=II+1,@DATA@(II)="T00050IEN_NAME"_$C(30)
;
;Call CIAV API
D PRTGETDF^CIAVUTIO(.RET,LOC)
;
S II=II+1,@DATA@(II)=$G(RET)_$C(30)
;
XGDF S II=II+1,@DATA@(II)=$C(31)
Q
;
SDFLT(DATA,DEV) ;BJPN SET DEF PRNT
;
;Sets the current default printer for user
;
S DEV=$G(DEV)
;
NEW UID,II,RET
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BJPNPRNT",UID))
K @DATA
I $G(DT)=""!($G(U)="") D DT^DICRW
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNPRNT D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
;
S II=II+1,@DATA@(II)="T00050RESULT"_$C(30)
;
;Call CIAV API
S RET=1 I $G(DEV)]"" D PRTSETDF^CIAVUTIO(.RET,DEV)
;
S II=II+1,@DATA@(II)=+$G(RET)_$C(30)
;
XSDF S II=II+1,@DATA@(II)=$C(31)
Q
;
DEVICE(DATA,FAKE) ;BJPN GET PRINTER LIST
;
;Returns the device list
;
NEW UID,II,RET,TMP
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BJPNPRNT",UID))
S TMP=$NA(^TMP("BJPNPRT",UID))
K @DATA,@TMP
I $G(DT)=""!($G(U)="") D DT^DICRW
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNPRNT D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
;
S II=II+1,@DATA@(II)="T00050IEN_NAME^T00100DISPLAY_NAME^T00050LOCATION^I00099RIGHT_MARGIN^I00099PAGE_LENGTH"_$C(30)
;
;Call CIAV API - Retrieve up to 2000 printers
D DEVICE^CIAVUTIO(.RET,"",1,2000)
;
;Copy to return global
S RET="" F S RET=$O(RET(RET)) Q:RET="" S II=II+1,@DATA@(II)=RET(RET)_$C(30)
;
XDEV K @TMP
S II=II+1,@DATA@(II)=$C(31)
Q
;
DETPRT(DATA,PIPIEN,DEVICE,CP,RM,PL) ;BJPN PRINT DETAIL
;
;Prints the specific problem detail to the selected device
;
;Input:
; PIPIEN - Pointer to PIP problem
; DEVICE - Device to print on (IEN_NAME value)
; CP - Number of Copies
; RM - Right Margin
; PL - Page Length
;
NEW UID,II,RET,HDR,FTR,SPACE,PNAME,AGE,DOB,PAD,DFN,H2,%,NOW,PNOW,CTMAX
NEW COPY,DIEN,HRN,REPT
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BJPNPRNT",UID))
S REPT=$NA(^TMP("BJPNPBDT",UID))
K @DATA,@REPT
I $G(DT)=""!($G(U)="") D DT^DICRW
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNPRNT D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
;
;Define Header
S II=II+1,@DATA@(II)="T00001RESULT^T00080ERROR_MESSAGE"_$C(30)
;
D NOW^%DTC S NOW=%,PNOW=$P($$FMTE^BJPNPRL(NOW),":",1,2)
;
;Data Validation
I $G(PIPIEN)="" S II=II+1,@DATA@(II)="-1^INVALID PIPIEN"_$C(30) G XPRT
I $G(DEVICE)="" S II=II+1,@DATA@(II)="-1^INVALID DEVICE"_$C(30) G XPRT
S DIEN=$P(DEVICE,";")
S CP=$G(CP) S:'CP CP=1
S:$G(RM)="" RM=$$GET1^DIQ(3.5,DIEN_",",9,"E") S:RM="" RM=80
S:$G(PL)="" PL=$$GET1^DIQ(3.5,DIEN_",",11,"E") S:PL="" PL=65
S CTMAX=PL-3
;
;Retrieve Patient Info
S DFN=$$GET1^DIQ(90680.01,PIPIEN_",",".02","I")
S PNAME=$$GET1^DIQ(2,DFN_",",".01","E")
S DOB=$$FMTE^BJPNPRL($$GET1^DIQ(2,DFN_",",.03,"I"))
S AGE=$$AGE^AUPNPAT(DFN,,1),H2=DOB_" ("_AGE_")"
S HRN=$$HRN^AUPNPAT(DFN,DUZ(2),"")
;
;Retrieve Detail
D DET^BJPNPBDT("",PIPIEN)
;
;Define Report Header
S SPACE=" ",$P(SPACE," ",RM)=" ",LINE="_",$P(LINE,"_",RM)="_"
S PAD=(RM-$L("Prenatal Problem Detail"))\2
S HDR(1)=$E(SPACE,1,PAD)_"Prenatal Problem Detail"
S HDR(2)=PNAME_" "_HRN,PAD=RM-$L(HDR(2))-$L(H2),HDR(2)=HDR(2)_$E(SPACE,1,PAD)_H2
S HDR(3)=LINE
S HDR(4)="*** WORK COPY ONLY ***",PAD=RM-$L(HDR(4))-$L(PNOW)-9,HDR(4)=HDR(4)_$E(SPACE,1,PAD)_"Printed: "_PNOW
;
;Define Report Footer
S FTR(1)=LINE
S FTR(2)="Page "
S FTR(3)=HDR(4)
;
;Print each copy
F COPY=1:1:CP D PRINT(.HDR,.FTR,RM,CTMAX)
;
;Record success
S II=II+1,@DATA@(II)="1^"_$C(30)
;
Q
;
XPRT S II=II+1,@DATA@(II)=$C(31)
Q
;
PRINT(HDR,FTR,RM,CTMAX) ;EP - Print each copy
;
NEW CTL,PAGE,RLINE,OUT,PGBK,TTL,INDT
;
;Select (and skip) first line - Quit if no line
S RLINE=$O(@REPT@("")) I RLINE="" Q
S PAGE=1
;
F D I $O(@REPT@(RLINE))="" Q
. ;
. ;Assemble Header
. NEW REP,CT
. S REP(1)=HDR(1)
. S REP(2)=HDR(2)
. S REP(3)=HDR(3)
. S REP(4)=HDR(4)
. ;
. ;Add Report Data Lines
. S CT=4 F D Q:(CT=CTMAX) Q:($O(@REPT@(RLINE))="")
.. ;
.. NEW VALUE,WRAP,CNTL
.. ;
.. ;Pull Next Line
.. S RLINE=$O(@REPT@(RLINE)),VALUE=@REPT@(RLINE)
.. F CNTL=13,10,30,31 S VALUE=$TR(VALUE,$C(CNTL))
.. ;
.. ;Wrap the Line
.. D WRAP(.WRAP,VALUE,RM)
.. ;
.. ;Process each wrapped line
.. S WRAP="" F S WRAP=$O(WRAP(WRAP)) Q:WRAP="" D
... S CT=CT+1,REP(CT)=WRAP(WRAP)
. ;
. ;Assemble Footer
. S REP(CT+1)=FTR(1)
. S REP(CT+2)=FTR(2)_PAGE
. S REP(CT+3)=FTR(3)
. ;I $O(@REPT@(RLINE))]"" S REP(CT+4)="**PAGE BREAK**"
. ;
. ;Define CTL
. I PAGE=1 S CTL=0
. ;
. ;Final Parameters
. S (TTL,DEV,PGBK,INDT)=""
. I $O(@REPT@(RLINE))="" D
.. S DEV=DEVICE
.. S TTL="Prenatal Problem Detail"
.. S PGBK=""
.. S INDT=0
. ;
. ;Output Report
. D PRINT^CIAVUTIO(.OUT,CTL,.REP,DEV,PGBK,INDT)
. S CTL=+$G(OUT)
. ;
. ;Update Page
. S PAGE=PAGE+1
;
Q
;
WRAP(OUT,TEXT,RM,IND) ;EP - Wrap the text and insert in array
;
NEW SP
;
I $G(TEXT)="" S OUT(1)="" Q
I $G(RM)="" Q
I $G(IND)="" S IND=0
S $P(SP," ",80)=" "
;
;Strip out $c(10)
S TEXT=$TR(TEXT,$C(10))
;
F I $L(TEXT)>0 D Q:$L(TEXT)=0
. NEW PIECE,SPACE,LINE
. S PIECE=$E(TEXT,1,RM)
. ;
. ;Handle Line feeds
. I PIECE[$C(13) D Q
.. NEW LINE,I
.. S LINE=$P(PIECE,$C(13)) S:LINE="" LINE=" "
.. S OUT=$G(OUT)+1,OUT(OUT)=LINE
.. F I=1:1:$L(PIECE) I $E(PIECE,I)=$C(13) Q
.. S TEXT=$E(SP,1,IND)_$$STZ($E(TEXT,I+1,9999999999))
. ;
. ;Check if line is less than right margin
. I $L(PIECE)<RM S OUT=$G(OUT)+1,OUT(OUT)=PIECE,TEXT="" Q
. ;
. ;Locate last space in line and handle if no space
. F SPACE=$L(PIECE):-1:(IND+1) I $E(PIECE,SPACE)=" " Q
. I (SPACE=(IND+1)) D S:TEXT]"" TEXT=$E(SP,1,IND)_TEXT Q
.. S LINE=PIECE,OUT=$G(OUT)+1,OUT(OUT)=LINE,TEXT=$$STZ($E(TEXT,RM+1,999999999))
. ;
. ;Handle line with space
. S LINE=$E(PIECE,1,SPACE-1),OUT=$G(OUT)+1,OUT(OUT)=LINE,TEXT=$$STZ($E(TEXT,SPACE+1,999999999))
. S:TEXT]"" TEXT=$E(SP,1,IND)_TEXT
;
Q
;
STZ(TEXT) ;EP - Strip Leading Spaces
NEW START
F START=1:1:$L(TEXT) I $E(TEXT,START)'=" " Q
Q $E(TEXT,START,9999999999)
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S II=$G(II)+1,@DATA@(II)="-1"_$C(31)
Q
BJPNPRNT ;GDIT/HS/BEE-Prenatal Care Module Print Handling Calls ; 08 May 2012 12:00 PM
+1 ;;2.0;PRENATAL CARE MODULE;;Feb 24, 2015;Build 63
+2 ;
+3 QUIT
+4 ;
GDFLT(DATA,LOC) ;BJPN GET DEF PRNT
+1 ;
+2 ;Returns current default printer for user
+3 ;
+4 SET LOC=+$GET(LOC)
+5 ;
+6 NEW UID,II,RET
+7 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+8 SET DATA=$NAME(^TMP("BJPNPRNT",UID))
+9 KILL @DATA
+10 IF $GET(DT)=""!($GET(U)="")
DO DT^DICRW
+11 ;
+12 SET II=0
+13 ; SAC 2009 2.2.3.17
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BJPNPRNT D UNWIND^%ZTER"
+14 ;
+15 SET II=II+1
SET @DATA@(II)="T00050IEN_NAME"_$CHAR(30)
+16 ;
+17 ;Call CIAV API
+18 DO PRTGETDF^CIAVUTIO(.RET,LOC)
+19 ;
+20 SET II=II+1
SET @DATA@(II)=$GET(RET)_$CHAR(30)
+21 ;
XGDF SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
SDFLT(DATA,DEV) ;BJPN SET DEF PRNT
+1 ;
+2 ;Sets the current default printer for user
+3 ;
+4 SET DEV=$GET(DEV)
+5 ;
+6 NEW UID,II,RET
+7 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+8 SET DATA=$NAME(^TMP("BJPNPRNT",UID))
+9 KILL @DATA
+10 IF $GET(DT)=""!($GET(U)="")
DO DT^DICRW
+11 ;
+12 SET II=0
+13 ; SAC 2009 2.2.3.17
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BJPNPRNT D UNWIND^%ZTER"
+14 ;
+15 SET II=II+1
SET @DATA@(II)="T00050RESULT"_$CHAR(30)
+16 ;
+17 ;Call CIAV API
+18 SET RET=1
IF $GET(DEV)]""
DO PRTSETDF^CIAVUTIO(.RET,DEV)
+19 ;
+20 SET II=II+1
SET @DATA@(II)=+$GET(RET)_$CHAR(30)
+21 ;
XSDF SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
DEVICE(DATA,FAKE) ;BJPN GET PRINTER LIST
+1 ;
+2 ;Returns the device list
+3 ;
+4 NEW UID,II,RET,TMP
+5 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+6 SET DATA=$NAME(^TMP("BJPNPRNT",UID))
+7 SET TMP=$NAME(^TMP("BJPNPRT",UID))
+8 KILL @DATA,@TMP
+9 IF $GET(DT)=""!($GET(U)="")
DO DT^DICRW
+10 ;
+11 SET II=0
+12 ; SAC 2009 2.2.3.17
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BJPNPRNT D UNWIND^%ZTER"
+13 ;
+14 SET II=II+1
SET @DATA@(II)="T00050IEN_NAME^T00100DISPLAY_NAME^T00050LOCATION^I00099RIGHT_MARGIN^I00099PAGE_LENGTH"_$CHAR(30)
+15 ;
+16 ;Call CIAV API - Retrieve up to 2000 printers
+17 DO DEVICE^CIAVUTIO(.RET,"",1,2000)
+18 ;
+19 ;Copy to return global
+20 SET RET=""
FOR
SET RET=$ORDER(RET(RET))
IF RET=""
QUIT
SET II=II+1
SET @DATA@(II)=RET(RET)_$CHAR(30)
+21 ;
XDEV KILL @TMP
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
DETPRT(DATA,PIPIEN,DEVICE,CP,RM,PL) ;BJPN PRINT DETAIL
+1 ;
+2 ;Prints the specific problem detail to the selected device
+3 ;
+4 ;Input:
+5 ; PIPIEN - Pointer to PIP problem
+6 ; DEVICE - Device to print on (IEN_NAME value)
+7 ; CP - Number of Copies
+8 ; RM - Right Margin
+9 ; PL - Page Length
+10 ;
+11 NEW UID,II,RET,HDR,FTR,SPACE,PNAME,AGE,DOB,PAD,DFN,H2,%,NOW,PNOW,CTMAX
+12 NEW COPY,DIEN,HRN,REPT
+13 ;
+14 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+15 SET DATA=$NAME(^TMP("BJPNPRNT",UID))
+16 SET REPT=$NAME(^TMP("BJPNPBDT",UID))
+17 KILL @DATA,@REPT
+18 IF $GET(DT)=""!($GET(U)="")
DO DT^DICRW
+19 ;
+20 SET II=0
+21 ; SAC 2009 2.2.3.17
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BJPNPRNT D UNWIND^%ZTER"
+22 ;
+23 ;Define Header
+24 SET II=II+1
SET @DATA@(II)="T00001RESULT^T00080ERROR_MESSAGE"_$CHAR(30)
+25 ;
+26 DO NOW^%DTC
SET NOW=%
SET PNOW=$PIECE($$FMTE^BJPNPRL(NOW),":",1,2)
+27 ;
+28 ;Data Validation
+29 IF $GET(PIPIEN)=""
SET II=II+1
SET @DATA@(II)="-1^INVALID PIPIEN"_$CHAR(30)
GOTO XPRT
+30 IF $GET(DEVICE)=""
SET II=II+1
SET @DATA@(II)="-1^INVALID DEVICE"_$CHAR(30)
GOTO XPRT
+31 SET DIEN=$PIECE(DEVICE,";")
+32 SET CP=$GET(CP)
IF 'CP
SET CP=1
+33 IF $GET(RM)=""
SET RM=$$GET1^DIQ(3.5,DIEN_",",9,"E")
IF RM=""
SET RM=80
+34 IF $GET(PL)=""
SET PL=$$GET1^DIQ(3.5,DIEN_",",11,"E")
IF PL=""
SET PL=65
+35 SET CTMAX=PL-3
+36 ;
+37 ;Retrieve Patient Info
+38 SET DFN=$$GET1^DIQ(90680.01,PIPIEN_",",".02","I")
+39 SET PNAME=$$GET1^DIQ(2,DFN_",",".01","E")
+40 SET DOB=$$FMTE^BJPNPRL($$GET1^DIQ(2,DFN_",",.03,"I"))
+41 SET AGE=$$AGE^AUPNPAT(DFN,,1)
SET H2=DOB_" ("_AGE_")"
+42 SET HRN=$$HRN^AUPNPAT(DFN,DUZ(2),"")
+43 ;
+44 ;Retrieve Detail
+45 DO DET^BJPNPBDT("",PIPIEN)
+46 ;
+47 ;Define Report Header
+48 SET SPACE=" "
SET $PIECE(SPACE," ",RM)=" "
SET LINE="_"
SET $PIECE(LINE,"_",RM)="_"
+49 SET PAD=(RM-$LENGTH("Prenatal Problem Detail"))\2
+50 SET HDR(1)=$EXTRACT(SPACE,1,PAD)_"Prenatal Problem Detail"
+51 SET HDR(2)=PNAME_" "_HRN
SET PAD=RM-$LENGTH(HDR(2))-$LENGTH(H2)
SET HDR(2)=HDR(2)_$EXTRACT(SPACE,1,PAD)_H2
+52 SET HDR(3)=LINE
+53 SET HDR(4)="*** WORK COPY ONLY ***"
SET PAD=RM-$LENGTH(HDR(4))-$LENGTH(PNOW)-9
SET HDR(4)=HDR(4)_$EXTRACT(SPACE,1,PAD)_"Printed: "_PNOW
+54 ;
+55 ;Define Report Footer
+56 SET FTR(1)=LINE
+57 SET FTR(2)="Page "
+58 SET FTR(3)=HDR(4)
+59 ;
+60 ;Print each copy
+61 FOR COPY=1:1:CP
DO PRINT(.HDR,.FTR,RM,CTMAX)
+62 ;
+63 ;Record success
+64 SET II=II+1
SET @DATA@(II)="1^"_$CHAR(30)
+65 ;
+66 QUIT
+67 ;
XPRT SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
PRINT(HDR,FTR,RM,CTMAX) ;EP - Print each copy
+1 ;
+2 NEW CTL,PAGE,RLINE,OUT,PGBK,TTL,INDT
+3 ;
+4 ;Select (and skip) first line - Quit if no line
+5 SET RLINE=$ORDER(@REPT@(""))
IF RLINE=""
QUIT
+6 SET PAGE=1
+7 ;
+8 FOR
Begin DoDot:1
+9 ;
+10 ;Assemble Header
+11 NEW REP,CT
+12 SET REP(1)=HDR(1)
+13 SET REP(2)=HDR(2)
+14 SET REP(3)=HDR(3)
+15 SET REP(4)=HDR(4)
+16 ;
+17 ;Add Report Data Lines
+18 SET CT=4
FOR
Begin DoDot:2
+19 ;
+20 NEW VALUE,WRAP,CNTL
+21 ;
+22 ;Pull Next Line
+23 SET RLINE=$ORDER(@REPT@(RLINE))
SET VALUE=@REPT@(RLINE)
+24 FOR CNTL=13,10,30,31
SET VALUE=$TRANSLATE(VALUE,$CHAR(CNTL))
+25 ;
+26 ;Wrap the Line
+27 DO WRAP(.WRAP,VALUE,RM)
+28 ;
+29 ;Process each wrapped line
+30 SET WRAP=""
FOR
SET WRAP=$ORDER(WRAP(WRAP))
IF WRAP=""
QUIT
Begin DoDot:3
+31 SET CT=CT+1
SET REP(CT)=WRAP(WRAP)
End DoDot:3
End DoDot:2
IF (CT=CTMAX)
QUIT
IF ($ORDER(@REPT@(RLINE))="")
QUIT
+32 ;
+33 ;Assemble Footer
+34 SET REP(CT+1)=FTR(1)
+35 SET REP(CT+2)=FTR(2)_PAGE
+36 SET REP(CT+3)=FTR(3)
+37 ;I $O(@REPT@(RLINE))]"" S REP(CT+4)="**PAGE BREAK**"
+38 ;
+39 ;Define CTL
+40 IF PAGE=1
SET CTL=0
+41 ;
+42 ;Final Parameters
+43 SET (TTL,DEV,PGBK,INDT)=""
+44 IF $ORDER(@REPT@(RLINE))=""
Begin DoDot:2
+45 SET DEV=DEVICE
+46 SET TTL="Prenatal Problem Detail"
+47 SET PGBK=""
+48 SET INDT=0
End DoDot:2
+49 ;
+50 ;Output Report
+51 DO PRINT^CIAVUTIO(.OUT,CTL,.REP,DEV,PGBK,INDT)
+52 SET CTL=+$GET(OUT)
+53 ;
+54 ;Update Page
+55 SET PAGE=PAGE+1
End DoDot:1
IF $ORDER(@REPT@(RLINE))=""
QUIT
+56 ;
+57 QUIT
+58 ;
WRAP(OUT,TEXT,RM,IND) ;EP - Wrap the text and insert in array
+1 ;
+2 NEW SP
+3 ;
+4 IF $GET(TEXT)=""
SET OUT(1)=""
QUIT
+5 IF $GET(RM)=""
QUIT
+6 IF $GET(IND)=""
SET IND=0
+7 SET $PIECE(SP," ",80)=" "
+8 ;
+9 ;Strip out $c(10)
+10 SET TEXT=$TRANSLATE(TEXT,$CHAR(10))
+11 ;
+12 FOR
IF $LENGTH(TEXT)>0
Begin DoDot:1
+13 NEW PIECE,SPACE,LINE
+14 SET PIECE=$EXTRACT(TEXT,1,RM)
+15 ;
+16 ;Handle Line feeds
+17 IF PIECE[$CHAR(13)
Begin DoDot:2
+18 NEW LINE,I
+19 SET LINE=$PIECE(PIECE,$CHAR(13))
IF LINE=""
SET LINE=" "
+20 SET OUT=$GET(OUT)+1
SET OUT(OUT)=LINE
+21 FOR I=1:1:$LENGTH(PIECE)
IF $EXTRACT(PIECE,I)=$CHAR(13)
QUIT
+22 SET TEXT=$EXTRACT(SP,1,IND)_$$STZ($EXTRACT(TEXT,I+1,9999999999))
End DoDot:2
QUIT
+23 ;
+24 ;Check if line is less than right margin
+25 IF $LENGTH(PIECE)<RM
SET OUT=$GET(OUT)+1
SET OUT(OUT)=PIECE
SET TEXT=""
QUIT
+26 ;
+27 ;Locate last space in line and handle if no space
+28 FOR SPACE=$LENGTH(PIECE):-1:(IND+1)
IF $EXTRACT(PIECE,SPACE)=" "
QUIT
+29 IF (SPACE=(IND+1))
Begin DoDot:2
+30 SET LINE=PIECE
SET OUT=$GET(OUT)+1
SET OUT(OUT)=LINE
SET TEXT=$$STZ($EXTRACT(TEXT,RM+1,999999999))
End DoDot:2
IF TEXT]""
SET TEXT=$EXTRACT(SP,1,IND)_TEXT
QUIT
+31 ;
+32 ;Handle line with space
+33 SET LINE=$EXTRACT(PIECE,1,SPACE-1)
SET OUT=$GET(OUT)+1
SET OUT(OUT)=LINE
SET TEXT=$$STZ($EXTRACT(TEXT,SPACE+1,999999999))
+34 IF TEXT]""
SET TEXT=$EXTRACT(SP,1,IND)_TEXT
End DoDot:1
IF $LENGTH(TEXT)=0
QUIT
+35 ;
+36 QUIT
+37 ;
STZ(TEXT) ;EP - Strip Leading Spaces
+1 NEW START
+2 FOR START=1:1:$LENGTH(TEXT)
IF $EXTRACT(TEXT,START)'=" "
QUIT
+3 QUIT $EXTRACT(TEXT,START,9999999999)
+4 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET II=$GET(II)+1
SET @DATA@(II)="-1"_$CHAR(31)
+5 QUIT
