Changeset 623 for WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSULRHL1.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSULRHL1.m (modified) (1 diff)

WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSULRHL1.m

@@ -1 @@
-PSULRHL1        ;HCIOFO/BH/RDC - Process real time HL7 Lab messages ; 8/1/07 11:26am
-        ;;4.0;PHARMACY BENEFITS MANAGEMENT;**3,11**;MARCH, 2005;Build 8
-        ;
-        ; DBIA 3565 to subscribe to the LR7O ALL EVSEND RESULTS protocol
-        ; DBIA 998 to dig through ^DPT(i,"LR" go get the ien to file #63
-        ; DBIA 91-A to dig through ^LAB(60 to get the name of the test
-        ; DBIA 3630 to call the HL7 PID builder
-        ; DBIA 4727 to call EN^HLOCNRT
-        ; DBIA 3646 to call API: $$EMPL^DGSEC4
-        ; DBIA 4658 to call API: $$TSTRES^LRRPU
-        ;
-        ; This program is called when a lab test is verified. If it is for a
-        ; chemistry test, and not for an employee, an HL7 message will be
-        ; created and sent to the CMOP-NAT server.
-        ;
-        ;
-HL7     ; Entry point for PBM processing - triggered by lab protocol 
-        ; LR7O ALL EVSEND RESULTS.
-        ;
-        N ARR,FIRST,LRDFN,PSUEXT,PSUHLFS,PSUHLECH,PSUHLCS
-        ;
-        ;  OREMSG is the pointer reference to the global that contains the
-        ;  lab data and is passed in by the LR7O ALL EVSEND RESULTS protocol.
-        ;  
-        I '$D(@OREMSG) Q
-        ;
-        ; Get Lab parameters
-        ;
-        D INIT^HLFNC2("PSU-SITE-DRIVER",.PSUHL)
-        ;
-        ; Set up CS delimeter for the Pharmacy message
-        ;
-        S PSUHL("CS")=$E(PSUHL("ECH"),1)
-        ;
-        ; Set up segment processing parameters 
-        ;
-        S PSUEXT("PSUBUF")=$NA(^TMP("HLS",$J))
-        S PSUEXT("PSUPTR")=0
-        ;
-        ; Get the delimiters that the passed in lab data is using
-        ;
-        D PARAMS
-        S PSUHLECH=$G(ARR("PSUHLECH"),"^~\&")
-        S PSUHLCS=$E(PSUHLECH,1)
-        ;
-        ; Quit if no DFN
-        ;
-        I '$D(ARR) Q
-        I ARR("DFN")=0!(ARR("DFN")="") Q
-        ;
-        ; Quit if patient is an employee
-        ;
-        I $$EMPL^DGSEC4(ARR("DFN"),"PS") Q
-        ;
-        ; Get Lab's equivalent of a DFN (LRDFN)
-        ;
-        S LRDFN=$P(^DPT(ARR("DFN"),"LR"),"^")  ; DBIA 998 to get file #63 ien
-        ;
-        ; Loop through the lab data 
-        ;
-        S FIRST=1
-        D LOOP
-        ;
-        ; Generate an HL7 if data exists to be sent
-        ;
-        I 'FIRST D GENERATE
-        ;
-        K PSUHL,ERR,OPTNS,ERR
-        ;
-        Q
-        ;
-LOOP    ;
-        N CNT,LRIDT,LRSS,PREV1,PREV2,QUIT1,QUIT2,REC,REC1,REC2,SEG,SEG1,SEG2,STR1
-        K ^TMP("HLS",$J)
-        S CNT=0
-        F  Q:CNT=""  S CNT=$O(@OREMSG@(CNT)) Q:'CNT  D
-        . S REC=@OREMSG@(CNT)
-        . S REC=$$STRING(REC,CNT)
-        . S SEG=$P(REC,PSUHLFS,1)
-        . I SEG'="ORC" Q
-        . S STR1=$P(REC,PSUHLFS,4)
-        . S STR1=$P(STR1,PSUHLCS,1)
-        . S LRSS=$P(STR1,";",4)
-        . ;
-        . ; Quit if data is not for Chemistry
-        . ;
-        . I LRSS'="CH" Q
-        . S LRIDT=$P(STR1,";",5)
-        . S QUIT1=0
-        . F  Q:QUIT1!(CNT="")  S PREV1=CNT,CNT=$O(@OREMSG@(CNT)) Q:'CNT  D
-        . . S REC1=@OREMSG@(CNT)
-        . . S REC1=$$STRING(REC1,CNT)
-        . . S SEG1=$P(REC1,PSUHLFS,1)
-        . . I SEG1="ORC" S CNT=PREV1,QUIT1=1 Q
-        . . I SEG1'="OBR" Q
-        . . ; If this is the first OBR being processed i.e. this is valid 
-        . . ; chemistry data set the PID segment
-        . . I FIRST D PID S FIRST=0
-        . . D OBR(REC1)
-        . . S QUIT2=0
-        . . F  Q:QUIT2  S PREV2=CNT,CNT=$O(@OREMSG@(CNT)) Q:'CNT  D
-        . . . S REC2=@OREMSG@(CNT)
-        . . . S REC2=$$STRING(REC2,CNT)
-        . . . S SEG2=$P(REC2,PSUHLFS,1)
-        . . . I SEG2="OBR"!(SEG2="ORC") S CNT=PREV2,QUIT2=1 Q
-        . . . I SEG2'="OBX" Q
-        . . . D OBX(REC2)
-        Q
-        ;
-PID     ;  Create the PID segment using the standard builder
-        ;
-        N K1,NEWSEG,SEG
-        S SEG="SEG"
-        D BLDPID^VAFCQRY(ARR("DFN"),1,"1,2,3",.SEG,.PSUHL,.ERR)
-        ;
-        ; Loop through the returned array just in case the data is spread over
-        ; more than one node
-        ;
-        S K1="",NEWSEG=""
-        F  S K1=$O(SEG(K1)) Q:'K1  D
-        . S NEWSEG=NEWSEG_SEG(K1)
-        ;
-        ; Set the data string into the PBM HL7 array
-        ;
-        D SETSEG(NEWSEG)
-        ;
-        Q
-        ;
-OBR(REC)        ;  Re-forms lab OBR to only send required data
-        ;
-        N OBRSEG,SITE,SPECDATE
-        S OBRSEG="OBR"
-        S SPECDATE=$P(REC,PSUHLFS,8)
-        S SITE=$P(REC,PSUHLFS,16)
-        S SITE=$TR(SITE,PSUHLCS,PSUHL("CS"))
-        ;
-        ; Create new OBR Segment and pass to SETSEG
-        ;
-        S $P(OBRSEG,PSUHL("FS"),8)=SPECDATE
-        S $P(OBRSEG,PSUHL("FS"),16)=SITE
-        ;
-        ; Set the data string into the PBM HL7 array
-        ;
-        D SETSEG(OBRSEG)
-        ;
-        Q
-        ;
-OBX(REC)        ;  Reforms lab OBX to only send the data needed
-        N CODES,HRANGE,LABS,LNAME,LR60,LRANGE,LRDN,LOINC,LOINCS,P2,P3,P12,RANGE,RES,RESULTS,SEG,UNITS
-        ;
-        S P2=$P(REC,PSUHLFS,2)
-        S P3=$P(REC,PSUHLFS,3)
-        S P12=$P(REC,PSUHLFS,12)
-        S RESULTS=$P(REC,PSUHLFS,6)
-        S UNITS=$P(REC,PSUHLFS,7)
-        S LABS=$P(REC,PSUHLFS,4)
-        S LR60=$P(LABS,"^",4)
-        I LR60']"" Q
-        S LRDN=$G(^LAB(60,LR60,0))
-        S LRDN=$P($P(LRDN,"^",5),";",2)   ;  DBIA 91 for data name
-        ;
-        ; Make the call to LRRPU to get the LOINC code for this test
-        ;
-        I LRDN']"" Q
-        S RES=$$TSTRES^LRRPU(LRDFN,LRSS,LRIDT,LRDN,LR60,1)
-        ;
-        S CODES=$P(RES,U,8),LOINCS=$P(CODES,"!",3)
-        S LOINC=$P(LOINCS,";",1),LNAME=$P(LOINCS,";",2)
-        S LRANGE=$P(RES,U,3),HRANGE=$P(RES,U,4)
-        S RANGE=LRANGE_"-"_HRANGE I RANGE="-" S RANGE=""
-        ;
-        ; Use the Pharmacy HL7 delimeters
-        ;
-        S LABS=$TR(LABS,PSUHLCS,PSUHL("CS"))
-        ;
-        ; Add LOINC to the list of Labs if it exists
-        ;
-        I LOINC'="" D
-        . ;
-        . ; Append the LOINC data using the pharmacy delimiters
-        . S LABS=LABS_PSUHL("CS")_LOINC_PSUHL("CS")_LNAME_PSUHL("CS")_"99LN"
-        ;
-        ; Put the data in the string
-        ;
-        S SEG="OBX"
-        S $P(SEG,PSUHL("FS"),2)=P2
-        S $P(SEG,PSUHL("FS"),3)=P3
-        S $P(SEG,PSUHL("FS"),4)=LABS
-        S $P(SEG,PSUHL("FS"),6)=RESULTS
-        S $P(SEG,PSUHL("FS"),7)=UNITS
-        S $P(SEG,PSUHL("FS"),8)=RANGE
-        S $P(SEG,PSUHL("FS"),12)=P12
-        ;
-        ; Put the string into the PBM HL7 global
-        ;
-        D SETSEG(SEG)
-        ;
-        Q
-        ;
-STRING(HLSTR,CNT)       ;  Loops through sub nodes to create a full data string
-        N J
-        S J=""
-        F  S J=$O(@OREMSG@(CNT,J))  Q:J=""  S HLSTR=HLSTR_@OREMSG@(CNT,J)
-        Q HLSTR
-        ;
-PARAMS  ; Get the delimiters used in the lab data
-        ;
-        N CNT,ID,QUIT,REC,RES
-        K ARR
-        S (QUIT,CNT)=0,RES=""
-        F  S CNT=$O(@OREMSG@(CNT)) Q:'CNT!(QUIT=2)  D
-        . S REC=@OREMSG@(CNT)
-        . I $E(REC,1,3)="MSH" D  Q
-        . . S PSUHLFS=$E(REC,4,4)
-        . . S ARR("PSUHLECH")=$P(REC,PSUHLFS,2),QUIT=QUIT+1
-        . I $P(REC,PSUHLFS,1)="PID" D  Q
-        . . S ARR("DFN")=$P(REC,PSUHLFS,4)
-        . . S QUIT=QUIT+1
-        Q
-        ;
-GENERATE        ; Generate HL7 message
-        ;
-        ; D GENERATE^HLMA("PSU-SITE-DRIVER","GM",1,.RESULT,"",.OPTNS)
-        S OPTNS("QUEUE")="PBM LAB"
-        S RESULT=$$EN^HLOCNRT("PSU-SITE-DRIVER","GM",.OPTNS)
-        I +RESULT'=RESULT D
-        . S ^XTMP("PBM/HLO",DT,$J)=RESULT
-        K ^TMP("HLS",$J)
-        Q
-        ;
-        ;
-SETSEG(SEG)     ;
-        ;
-        ;***** STORES THE SEGMENT INTO THE ^TMP("HLS",$J) BUFFER
-        ;
-        ; SEG           HL7 segment
-        ;
-        ; The SETSEG procedure stores the HL7 segment into the
-        ; standard HL7 buffer ^TMP("HLS",$J). The <TAB>, <CR> and <LF>
-        ; characters are replaced with spaces. Long segments are split among 
-        ; sub-nodes of the main segment node.
-        ;
-        ; The PSUEXT array must be initialized before
-        ; calling this function.
-        ;
-        N I1,I2,MAXLEN,NODE,PTR,PTR1,SID,SL
-        S NODE=PSUEXT("PSUBUF"),PTR=$G(PSUEXT("PSUPTR"))+1
-        S SL=$L(SEG),MAXLEN=245  K @NODE@(PTR)
-        ;--- Store the segment
-        S @NODE@(PTR)=$TR($E(SEG,1,MAXLEN),$C(9,10,13),"   ")
-        ;
-        ;--- Split the segment into sub-nodes if necessary
-        D:SL>MAXLEN
-        . S I2=MAXLEN
-        . F PTR1=1:1  S I1=I2+1,I2=I1+MAXLEN-1  Q:I1>SL  D
-        . . S @NODE@(PTR,PTR1)=$TR($E(SEG,I1,I2),$C(9,10,13),"   ")
-        ;--- Save the pointer
-        S PSUEXT("PSUPTR")=PTR
-        Q
+PSULRHL1 ;HCIOFO/BH/RDC - Process real time HL7 Lab messages ; 5/15/04 3:10pm
+ ;;4.0;PHARMACY BENEFITS MANAGEMENT;**3**;MARCH, 2005
+ ;
+ ; DBIA 3565 to subscribe to the LR7O ALL EVSEND RESULTS protocol
+ ; DBIA 998 to dig through ^DPT(i,"LR" go get the ien to file #63
+ ; DBIA 91-A to dig through ^LAB(60 to get the name of the test
+ ; DBIA 3630 to call the HL7 PID builder
+ ; DBIA 4727 to call EN^HLOCNRT
+ ; DBIA 3646 to call API: $$EMPL^DGSEC4
+ ; DBIA 4658 to call API: $$TSTRES^LRRPU
+ ;
+ ; This program is called when a lab test is verified. If it is for a
+ ; chemistry test, and not for an employee, an HL7 message will be
+ ; created and sent to the CMOP-NAT server.
+ ;
+ ;
+HL7 ; Entry point for PBM processing - triggered by lab protocol 
+ ; LR7O ALL EVSEND RESULTS.
+ ;
+ N ARR,FIRST,LRDFN,PSUEXT,PSUHLFS,PSUHLECH,PSUHLCS
+ ;
+ ;  OREMSG is the pointer reference to the global that contains the
+ ;  lab data and is passed in by the LR7O ALL EVSEND RESULTS protocol.
+ ;  
+ I '$D(@OREMSG) Q
+ ;
+ ; Get Lab parameters
+ ;
+ D INIT^HLFNC2("PSU-SITE-DRIVER",.PSUHL)
+ ;
+ ; Set up CS delimeter for the Pharmacy message
+ ;
+ S PSUHL("CS")=$E(PSUHL("ECH"),1)
+ ;
+ ; Set up segment processing parameters 
+ ;
+ S PSUEXT("PSUBUF")=$NA(^TMP("HLS",$J))
+ S PSUEXT("PSUPTR")=0
+ ;
+ ; Get the delimiters that the passed in lab data is using
+ ;
+ D PARAMS
+ S PSUHLECH=$G(ARR("PSUHLECH"),"^~\&")
+ S PSUHLCS=$E(PSUHLECH,1)
+ ;
+ ; Quit if no DFN
+ ;
+ I '$D(ARR) Q
+ I ARR("DFN")=0!(ARR("DFN")="") Q
+ ;
+ ; Quit if patient is an employee
+ ;
+ I $$EMPL^DGSEC4(ARR("DFN"),"PS") Q
+ ;
+ ; Get Lab's equivalent of a DFN (LRDFN)
+ ;
+ S LRDFN=$P(^DPT(ARR("DFN"),"LR"),"^")  ; DBIA 998 to get file #63 ien
+ ;
+ ; Loop through the lab data 
+ ;
+ S FIRST=1
+ D LOOP
+ ;
+ ; Generate an HL7 if data exists to be sent
+ ;
+ I 'FIRST D GENERATE
+ ;
+ K PSUHL,ERR,OPTNS,ERR
+ ;
+ Q
+ ;
+LOOP ;
+ N CNT,LRIDT,LRSS,PREV1,PREV2,QUIT1,QUIT2,REC,REC1,REC2,SEG,SEG1,SEG2,STR1
+ K ^TMP("HLS",$J)
+ S CNT=0
+ F  Q:CNT=""  S CNT=$O(@OREMSG@(CNT)) Q:'CNT  D
+ . S REC=@OREMSG@(CNT)
+ . S REC=$$STRING(REC,CNT)
+ . S SEG=$P(REC,PSUHLFS,1)
+ . I SEG'="ORC" Q
+ . S STR1=$P(REC,PSUHLFS,4)
+ . S STR1=$P(STR1,PSUHLCS,1)
+ . S LRSS=$P(STR1,";",4)
+ . ;
+ . ; Quit if data is not for Chemistry
+ . ;
+ . I LRSS'="CH" Q
+ . S LRIDT=$P(STR1,";",5)
+ . S QUIT1=0
+ . F  Q:QUIT1!(CNT="")  S PREV1=CNT,CNT=$O(@OREMSG@(CNT)) Q:'CNT  D
+ . . S REC1=@OREMSG@(CNT)
+ . . S REC1=$$STRING(REC1,CNT)
+ . . S SEG1=$P(REC1,PSUHLFS,1)
+ . . I SEG1="ORC" S CNT=PREV1,QUIT1=1 Q
+ . . I SEG1'="OBR" Q
+ . . ; If this is the first OBR being processed i.e. this is valid 
+ . . ; chemistry data set the PID segment
+ . . I FIRST D PID S FIRST=0
+ . . D OBR(REC1)
+ . . S QUIT2=0
+ . . F  Q:QUIT2  S PREV2=CNT,CNT=$O(@OREMSG@(CNT)) Q:'CNT  D
+ . . . S REC2=@OREMSG@(CNT)
+ . . . S REC2=$$STRING(REC2,CNT)
+ . . . S SEG2=$P(REC2,PSUHLFS,1)
+ . . . I SEG2="OBR"!(SEG2="ORC") S CNT=PREV2,QUIT2=1 Q
+ . . . I SEG2'="OBX" Q
+ . . . D OBX(REC2)
+ Q
+ ;
+PID ;  Create the PID segment using the standard builder
+ ;
+ N K1,NEWSEG,SEG
+ S SEG="SEG"
+ D BLDPID^VAFCQRY(ARR("DFN"),1,"1,2,3",.SEG,.PSUHL,.ERR)
+ ;
+ ; Loop through the returned array just in case the data is spread over
+ ; more than one node
+ ;
+ S K1="",NEWSEG=""
+ F  S K1=$O(SEG(K1)) Q:'K1  D
+ . S NEWSEG=NEWSEG_SEG(K1)
+ ;
+ ; Set the data string into the PBM HL7 array
+ ;
+ D SETSEG(NEWSEG)
+ ;
+ Q
+ ;
+OBR(REC) ;  Re-forms lab OBR to only send required data
+ ;
+ N OBRSEG,SITE,SPECDATE
+ S OBRSEG="OBR"
+ S SPECDATE=$P(REC,PSUHLFS,8)
+ S SITE=$P(REC,PSUHLFS,16)
+ S SITE=$TR(SITE,PSUHLCS,PSUHL("CS"))
+ ;
+ ; Create new OBR Segment and pass to SETSEG
+ ;
+ S $P(OBRSEG,PSUHL("FS"),8)=SPECDATE
+ S $P(OBRSEG,PSUHL("FS"),16)=SITE
+ ;
+ ; Set the data string into the PBM HL7 array
+ ;
+ D SETSEG(OBRSEG)
+ ;
+ Q
+ ;
+OBX(REC) ;  Reforms lab OBX to only send the data needed
+ N CODES,HRANGE,LABS,LNAME,LR60,LRANGE,LRDN,LOINC,LOINCS,P2,P3,P12,RANGE,RES,RESULTS,SEG,UNITS
+ ;
+ S P2=$P(REC,PSUHLFS,2)
+ S P3=$P(REC,PSUHLFS,3)
+ S P12=$P(REC,PSUHLFS,12)
+ S RESULTS=$P(REC,PSUHLFS,6)
+ S UNITS=$P(REC,PSUHLFS,7)
+ S LABS=$P(REC,PSUHLFS,4)
+ S LR60=$P(LABS,"^",4)
+ S LRDN=$G(^LAB(60,LR60,0))
+ S LRDN=$P($P(LRDN,"^",5),";",2)   ;  DBIA 91 for data name
+ ;
+ ; Make the call to LRRPU to get the LOINC code for this test
+ ;
+ S RES=$$TSTRES^LRRPU(LRDFN,LRSS,LRIDT,LRDN,LR60,1)
+ ;
+ S CODES=$P(RES,U,8),LOINCS=$P(CODES,"!",3)
+ S LOINC=$P(LOINCS,";",1),LNAME=$P(LOINCS,";",2)
+ S LRANGE=$P(RES,U,3),HRANGE=$P(RES,U,4)
+ S RANGE=LRANGE_"-"_HRANGE I RANGE="-" S RANGE=""
+ ;
+ ; Use the Pharmacy HL7 delimeters
+ ;
+ S LABS=$TR(LABS,PSUHLCS,PSUHL("CS"))
+ ;
+ ; Add LOINC to the list of Labs if it exists
+ ;
+ I LOINC'="" D
+ . ;
+ . ; Append the LOINC data using the pharmacy delimiters
+ . S LABS=LABS_PSUHL("CS")_LOINC_PSUHL("CS")_LNAME_PSUHL("CS")_"99LN"
+ ;
+ ; Put the data in the string
+ ;
+ S SEG="OBX"
+ S $P(SEG,PSUHL("FS"),2)=P2
+ S $P(SEG,PSUHL("FS"),3)=P3
+ S $P(SEG,PSUHL("FS"),4)=LABS
+ S $P(SEG,PSUHL("FS"),6)=RESULTS
+ S $P(SEG,PSUHL("FS"),7)=UNITS
+ S $P(SEG,PSUHL("FS"),8)=RANGE
+ S $P(SEG,PSUHL("FS"),12)=P12
+ ;
+ ; Put the string into the PBM HL7 global
+ ;
+ D SETSEG(SEG)
+ ;
+ Q
+ ;
+STRING(HLSTR,CNT) ;  Loops through sub nodes to create a full data string
+ N J
+ S J=""
+ F  S J=$O(@OREMSG@(CNT,J))  Q:J=""  S HLSTR=HLSTR_@OREMSG@(CNT,J)
+ Q HLSTR
+ ;
+PARAMS ; Get the delimiters used in the lab data
+ ;
+ N CNT,ID,QUIT,REC,RES
+ K ARR
+ S (QUIT,CNT)=0,RES=""
+ F  S CNT=$O(@OREMSG@(CNT)) Q:'CNT!(QUIT=2)  D
+ . S REC=@OREMSG@(CNT)
+ . I $E(REC,1,3)="MSH" D  Q
+ . . S PSUHLFS=$E(REC,4,4)
+ . . S ARR("PSUHLECH")=$P(REC,PSUHLFS,2),QUIT=QUIT+1
+ . I $P(REC,PSUHLFS,1)="PID" D  Q
+ . . S ARR("DFN")=$P(REC,PSUHLFS,4)
+ . . S QUIT=QUIT+1
+ Q
+ ;
+GENERATE ; Generate HL7 message
+ ;
+ ; D GENERATE^HLMA("PSU-SITE-DRIVER","GM",1,.RESULT,"",.OPTNS)
+ S OPTNS("QUEUE")="PBM LAB"
+ S RESULT=$$EN^HLOCNRT("PSU-SITE-DRIVER","GM",.OPTNS)
+ I +RESULT'=RESULT D
+ . S ^XTMP("PBM/HLO",DT,$J)=RESULT
+ K ^TMP("HLS",$J)
+ Q
+ ;
+ ;
+SETSEG(SEG) ;
+ ;
+ ;***** STORES THE SEGMENT INTO THE ^TMP("HLS",$J) BUFFER
+ ;
+ ; SEG           HL7 segment
+ ;
+ ; The SETSEG procedure stores the HL7 segment into the
+ ; standard HL7 buffer ^TMP("HLS",$J). The <TAB>, <CR> and <LF>
+ ; characters are replaced with spaces. Long segments are split among 
+ ; sub-nodes of the main segment node.
+ ;
+ ; The PSUEXT array must be initialized before
+ ; calling this function.
+ ;
+ N I1,I2,MAXLEN,NODE,PTR,PTR1,SID,SL
+ S NODE=PSUEXT("PSUBUF"),PTR=$G(PSUEXT("PSUPTR"))+1
+ S SL=$L(SEG),MAXLEN=245  K @NODE@(PTR)
+ ;--- Store the segment
+ S @NODE@(PTR)=$TR($E(SEG,1,MAXLEN),$C(9,10,13),"   ")
+ ;
+ ;--- Split the segment into sub-nodes if necessary
+ D:SL>MAXLEN
+ . S I2=MAXLEN
+ . F PTR1=1:1  S I1=I2+1,I2=I1+MAXLEN-1  Q:I1>SL  D
+ . . S @NODE@(PTR,PTR1)=$TR($E(SEG,I1,I2),$C(9,10,13),"   ")
+ ;--- Save the pointer
+ S PSUEXT("PSUPTR")=PTR
+ Q