PSXDODH1 ;BIR/HTW-HL7 Message Conversion ;01/15/02 13:10:52
;;2.0;CMOP;**38,45**;11 Apr 97
; Convert CMOP transmission messages from HL7 V 2.3.1 to V 2.1
TESTBT ;test the sequence of the messages in the batch
; stored in ^tmp($j,"PSXDOD","MSG0",I)
S PSXERR="",LSEG="",PTCNT=0,ORDCNT=0
F LNNUM=1:1 S LN=$G(@G@(LNNUM)) Q:LN="" S SEG=$P(LN,"|") S:SEG="NTE" SEG=$P(LN,"|",1,2) D
. Q:SEG="FTS"
. I LNNUM=1,SEG="FHS" S LSEG=SEG,FHS=LN Q
. I '$D(SEGSEQ(LSEG,SEG)) S PSXERR=PSXERR_$S($L(PSXERR):"~",1:"")_"SEQ^"_LSEG_U_SEG S LSEG=SEG Q
. S LSEG=SEG
. I "BHS,MSH,ORC,RXE,ZR1,PID,BTS"[SEG D CHECK
Q
CHECK ;patient safety check
I SEG="BHS" S BATIDB=$P(LN,"|",11),BHS=LN Q
I SEG="MSH" S BATIDM=$P(LN,"|",10),ORDSEQ=$P(BATIDM,"-",3),BATIDM=$P(BATIDM,"-",1,2) I BATIDM'=BATIDB S PSXERR=PSXERR_$S($L(PSXERR):"~",1:"")_"22^"_ORDSEQ D Q
. I $E(IOST)="C" W !,"Order Sequence ",PSXERR,!,BATIDM,?40,BATIDB
I SEG="ORC",LNNUM'=3 S RXIDC=$P(LN,"|",3),RXSEQ=$$GETELM(LN,"5,2","|,^") Q
I SEG="RXE" S RXIDE=$P(LN,"|",16),ORDCNT=ORDCNT+1 I RXIDE'=RXIDC S PSXERR=PSXERR_$S($L(PSXERR):"~",1:"")_"41^"_ORDSEQ_U_RXSEQ D Q
. I $E(IOST)="C" W !,"Prescription Number ",PSXERR,!,RXIDE,?40,RXIDC
I SEG="ZR1" S RXID1=$P(LN,"|",2) I RXID1'=RXIDC S PSXERR=PSXERR_$S($L(PSXERR):"~",1:"")_"44^"_ORDSEQ_U_RXSEQ D Q
. I $E(IOST)="C" W !,"RX Number ",PSXERR,!,RXID1,?40,RXIDC
I SEG="PID" S PTCNT=PTCNT+1 Q
I SEG="BTS" S PTCNTB=$P(LN,"|",2),ORDCNTB=$P(LN,"|",4),BTS=LN D
. I PTCNTB'=PTCNT S PSXERR=PSXERR_$S($L(PSXERR):"~",1:"")_"56^" D
.. I $E(IOST)="C" W !,"Batch Orders ",PSXERR,!,PTCNTB,?40,PTCNT
. I ORDCNTB'=ORDCNT S PSXERR=PSXERR_$S($L(PSXERR):"~",1:"")_"58^" D
.. I $E(IOST)="C" W !,"Batch Totals ",PSXERR,!,ORDCNTB,?40,ORDCNT
Q
;FHS|^~\&|CHCS|BALBOA||CMOP LEAVENWORTH|20020403115125|0124_020931151.TRN
;BHS|^~\&|CHCS||VistA||20020403115100||RAR^RAR||0124-020931151
;ORC|NW||||||||||||||||||||^^^^^^^0124&BALBOA&0124|500 PARK ST^^SAN DIEGO^CA^92130|(858)826-4923
;
;$$XMIT^020931151^BALBOA^CMOP LEAVENWORTH^0124^3020403.115125^DOD Facility^1^8^BALBOA^0124
; NTE|1||673BS\S\CBC-BARTOW\S\673\F\13000 BRUCE B DOWNS BLVD\S\\S\TAMPA\S\FL\S\33612\F\(888) 903-546
; Use document for the mapping of segments & elements between HL7 2.3.1 & CMOP 2.1
; CMOP DOD to Vista Message Mapping 3_24.xls
K XM,NTE1
S FHS=@G@(1),BHS=@G@(2),ORC=@G@(3)
F YY="BATNM^11","FACNM^4","CMOP^6","TRANDTS^7" D PIECE(FHS,"|",YY)
S BATNM=$$GETELM(BHS,"11,2","|,-") ; FHS SEGMENT is file name with "_"
S TRANDTS=$$FMDATE^HLFNC(TRANDTS)
S START=1,END=PTCNTB
S ORC=$P(ORC,"ORC|",2)
S DIVISION=$$GETELM(ORC,"21,8","|,^")
F YY="DIVNUM^1","DIVNM^2","FACNUM^3" D PIECE(DIVISION,"&",YY)
F YY="ADDRESS^22","PHONE^23" D PIECE(ORC,"|",YY)
F YY="ADD1^1","ADD2^2","CITY^3","STATE^4","ZIP^5" D PIECE(ADDRESS,"^",YY)
S DIVNUM="1"_DIVNUM,FACNUM="1"_FACNUM ;****Institution file change
; assemble XM - $$XMIT
S XM="$$XMIT"
F YY="BATNM^2","FACNM^3","CMOP^4","FACNUM^5","TRANDTS^6","START^8","END^9","DIVNM^10","DIVNUM^11" D PUT(.XM,"^",YY)
S $P(XM,"^",7)="DOD Facility"
; change site number for testing to acceptable site number 693
;S XM=$$SETELM(XM,5,"^",693) ;****TESTING
;S XM=$$SETELM(XM,11,"^",693) ;****TESTING
; assemble NTE1(4)
S NTE1DIV="" F YY="DIVNUM^1","DIVNM^2","FACNUM^3" D PUT(.NTE1DIV,"\S\",YY)
S NTE1ADD="" F YY="ADD1^1","ADD2^2","CITY^3","STATE^4","ZIP^5" D PUT(.NTE1ADD,"\S\",YY)
S NTE1LOC="" F YY="NTE1DIV^1","NTE1ADD^2","PHONE^3" D PUT(.NTE1LOC,"\F\",YY)
; assemble NTE1
S NTE1="NTE|1||"_NTE1LOC
; change NTE1 site number to 693 for testing
;S NTE1=$$SETELM(NTE1,"4,1,1","|,\F\,\S\",693) ;****TESTING
;S NTE1=$$SETELM(NTE1,"4,1,3","|,\F\,\S\",693) ;****TESTING
; store $$XMIT,NTE1
Q
BLDSEQ ;build check sequence of SEGMENTS
K SEGSEQ
F I=1:1 S LINE=$P($T(SEGBLD+I),";;",2,99) Q:LINE["$$END" D
. S LSEG=$P(LINE,";;")
. F J=2:1 S SEG=$P(LINE,";;",J) Q:SEG="" S SEGSEQ(LSEG,SEG)="" ;W !,LSEG,?10,SEG
Q
SEGBLD ; data for checking sequence of segments. ZR1 needs special handling.
;;FHS;;BHS
;;BHS;;ORC
;;ORC;;NTE|2;;NTE|3;;NTE|4;;MSH
;;NTE|2;;NTE|2;;NTE|3;;NTE|4;;MSH
;;NTE|3;;NTE|3;;NTE|4;;MSH
;;NTE|4;;NTE|4;;MSH
;;MSH;;PID
;;PID;;NTE|8;;ORC
;;NTE|8;;ORC;;NTE|8;;ZML;;ZSL
;;ZML;;ZML;;ZSL
;;ZSL;;ZSL;;ORC
;;ORC;;RXE
;;RXE;;ZR1;;NTE|7
;;NTE|7;;NTE|7;;ZR1
;;ZR1;;ORC;;BTS;;MSH;;PID
;;BTS;;FTS
;;$$END
PIECE(REC,DLM,XX) ;
; Set VAR = piece I of REC using delimiter DLM
N Y,I S Y=$P(XX,U),I=$P(XX,U,2),@Y=$P(REC,DLM,I)
Q
PUT(REC,DLM,XX) ;
; Set VAR into piece I of REC using delimiter DLM
N Y,I S Y=$P(XX,U),I=$P(XX,U,2)
S $P(REC,DLM,I)=$G(@Y)
Q
GETELM(STR,PIECES,SEPS) ;
; uses STRing and
; returns value of the element located by path of pieces and seperators
; ex: PIECES "3,2,1" SEPS "|,^,&"
N P,S,PI,V S V=STR
F I=1:1 S PI=$P(PIECES,",",I) Q:PI="" S P=I,P(I)=PI,S(I)=$P(SEPS,",",I)
F I=1:1:P S V=$P(V,S(I),P(I))
Q V
SETELM(STR,PIECES,SEPS,VALUE) ;
; gets STRing and
; inserts value into element located by path of pieces and separators
; ex: PIECES "3,2,1" SEPS "|,^,&"
N P,S,PI,V
S (V,V(0))=STR
F I=1:1 S PI=$P(PIECES,",",I) Q:PI="" S P=I,P(I)=PI,S(I)=$P(SEPS,",",I)
F I=1:1:P S (V,V(I))=$P(V,S(I),P(I)) ; unpack
S V(I)=VALUE ; insert value
F I=P:-1:1 S $P(V(I-1),S(I),P(I))=V(I) ; repack
Q V(0)
;
STRBLD(STR0,SEPS) ;
; default separators for all segments, fields, components are | ^ &
; other separators can be passed in SEPS ex: "|,^,&" or "|,\F\,\S\"
; or placed within the field and segment nodes STR0( , , ..,"S")= separator
; ex: for NTE|1 of HL7 2.1
; segment NTE|1 STR0("S")="|"
; facility field STR0(4,"S")="\F\"
; address component STR0(4,2,"S")="\S\"
N P1,P2,P3,S1,S2,S3,STR
S:'$L($G(SEPS)) SEPS="|,^,&"
M STR=STR0
L1 S P1=0,STR=""
I '$D(STR("S")) S STR("S")=$P(SEPS,",",1)
S S1=STR("S")
F S P1=$O(STR(P1)) Q:P1'>0 D
. I +$O(STR(P1,0)) D L2
. S $P(STR,S1,P1)=STR(P1)
Q STR
L2 S P2=0 ; S STR(P1)=""
I '$D(STR(P1,"S")) S STR(P1,"S")=$P(SEPS,",",2)
S S2=STR(P1,"S")
F S P2=$O(STR(P1,P2)) Q:P2'>0 D
. I +$O(STR(P1,P2,0)) D L3
. S $P(STR(P1),S2,P2)=STR(P1,P2)
I STR(P1)'[S2 S STR(P1)=STR(P1)_S2
Q
L3 S P3=0 ; S STR(P1,P2)=""
I '$D(STR(P1,P2,"S")) S STR(P1,P2,"S")=$P(SEPS,",",3)
S S3=STR(P1,P2,"S")
F S P3=$O(STR(P1,P2,P3)) Q:P3'>0 D
. S $P(STR(P1,P2),S3,P3)=STR(P1,P2,P3)
I STR(P1,P2)'[S3 S STR(P1,P2)=STR(P1,P2)_S3
Q
PSXDODH1 ;BIR/HTW-HL7 Message Conversion ;01/15/02 13:10:52
+1 ;;2.0;CMOP;**38,45**;11 Apr 97
+2 ; Convert CMOP transmission messages from HL7 V 2.3.1 to V 2.1
TESTBT ;test the sequence of the messages in the batch
+1 ; stored in ^tmp($j,"PSXDOD","MSG0",I)
+2 SET PSXERR=""
SET LSEG=""
SET PTCNT=0
SET ORDCNT=0
+3 FOR LNNUM=1:1
SET LN=$GET(@G@(LNNUM))
IF LN=""
QUIT
SET SEG=$PIECE(LN,"|")
IF SEG="NTE"
SET SEG=$PIECE(LN,"|",1,2)
Begin DoDot:1
+4 IF SEG="FTS"
QUIT
+5 IF LNNUM=1
IF SEG="FHS"
SET LSEG=SEG
SET FHS=LN
QUIT
+6 IF '$DATA(SEGSEQ(LSEG,SEG))
SET PSXERR=PSXERR_$SELECT($LENGTH(PSXERR):"~",1:"")_"SEQ^"_LSEG_U_SEG
SET LSEG=SEG
QUIT
+7 SET LSEG=SEG
+8 IF "BHS,MSH,ORC,RXE,ZR1,PID,BTS"[SEG
DO CHECK
End DoDot:1
+9 QUIT
CHECK ;patient safety check
+1 IF SEG="BHS"
SET BATIDB=$PIECE(LN,"|",11)
SET BHS=LN
QUIT
+2 IF SEG="MSH"
SET BATIDM=$PIECE(LN,"|",10)
SET ORDSEQ=$PIECE(BATIDM,"-",3)
SET BATIDM=$PIECE(BATIDM,"-",1,2)
IF BATIDM'=BATIDB
SET PSXERR=PSXERR_$SELECT($LENGTH(PSXERR):"~",1:"")_"22^"_ORDSEQ
Begin DoDot:1
+3 IF $EXTRACT(IOST)="C"
WRITE !,"Order Sequence ",PSXERR,!,BATIDM,?40,BATIDB
End DoDot:1
QUIT
+4 IF SEG="ORC"
IF LNNUM'=3
SET RXIDC=$PIECE(LN,"|",3)
SET RXSEQ=$$GETELM(LN,"5,2","|,^")
QUIT
+5 IF SEG="RXE"
SET RXIDE=$PIECE(LN,"|",16)
SET ORDCNT=ORDCNT+1
IF RXIDE'=RXIDC
SET PSXERR=PSXERR_$SELECT($LENGTH(PSXERR):"~",1:"")_"41^"_ORDSEQ_U_RXSEQ
Begin DoDot:1
+6 IF $EXTRACT(IOST)="C"
WRITE !,"Prescription Number ",PSXERR,!,RXIDE,?40,RXIDC
End DoDot:1
QUIT
+7 IF SEG="ZR1"
SET RXID1=$PIECE(LN,"|",2)
IF RXID1'=RXIDC
SET PSXERR=PSXERR_$SELECT($LENGTH(PSXERR):"~",1:"")_"44^"_ORDSEQ_U_RXSEQ
Begin DoDot:1
+8 IF $EXTRACT(IOST)="C"
WRITE !,"RX Number ",PSXERR,!,RXID1,?40,RXIDC
End DoDot:1
QUIT
+9 IF SEG="PID"
SET PTCNT=PTCNT+1
QUIT
+10 IF SEG="BTS"
SET PTCNTB=$PIECE(LN,"|",2)
SET ORDCNTB=$PIECE(LN,"|",4)
SET BTS=LN
Begin DoDot:1
+11 IF PTCNTB'=PTCNT
SET PSXERR=PSXERR_$SELECT($LENGTH(PSXERR):"~",1:"")_"56^"
Begin DoDot:2
+12 IF $EXTRACT(IOST)="C"
WRITE !,"Batch Orders ",PSXERR,!,PTCNTB,?40,PTCNT
End DoDot:2
+13 IF ORDCNTB'=ORDCNT
SET PSXERR=PSXERR_$SELECT($LENGTH(PSXERR):"~",1:"")_"58^"
Begin DoDot:2
+14 IF $EXTRACT(IOST)="C"
WRITE !,"Batch Totals ",PSXERR,!,ORDCNTB,?40,ORDCNT
End DoDot:2
End DoDot:1
+15 QUIT
+1 ;FHS|^~\&|CHCS|BALBOA||CMOP LEAVENWORTH|20020403115125|0124_020931151.TRN
+2 ;BHS|^~\&|CHCS||VistA||20020403115100||RAR^RAR||0124-020931151
+3 ;ORC|NW||||||||||||||||||||^^^^^^^0124&BALBOA&0124|500 PARK ST^^SAN DIEGO^CA^92130|(858)826-4923
+4 ;
+5 ;$$XMIT^020931151^BALBOA^CMOP LEAVENWORTH^0124^3020403.115125^DOD Facility^1^8^BALBOA^0124
+6 ; NTE|1||673BS\S\CBC-BARTOW\S\673\F\13000 BRUCE B DOWNS BLVD\S\\S\TAMPA\S\FL\S\33612\F\(888) 903-546
+7 ; Use document for the mapping of segments & elements between HL7 2.3.1 & CMOP 2.1
+8 ; CMOP DOD to Vista Message Mapping 3_24.xls
+9 KILL XM,NTE1
+10 SET FHS=@G@(1)
SET BHS=@G@(2)
SET ORC=@G@(3)
+11 FOR YY="BATNM^11","FACNM^4","CMOP^6","TRANDTS^7"
DO PIECE(FHS,"|",YY)
+12 ; FHS SEGMENT is file name with "_"
SET BATNM=$$GETELM(BHS,"11,2","|,-")
+13 SET TRANDTS=$$FMDATE^HLFNC(TRANDTS)
+14 SET START=1
SET END=PTCNTB
+15 SET ORC=$PIECE(ORC,"ORC|",2)
+16 SET DIVISION=$$GETELM(ORC,"21,8","|,^")
+17 FOR YY="DIVNUM^1","DIVNM^2","FACNUM^3"
DO PIECE(DIVISION,"&",YY)
+18 FOR YY="ADDRESS^22","PHONE^23"
DO PIECE(ORC,"|",YY)
+19 FOR YY="ADD1^1","ADD2^2","CITY^3","STATE^4","ZIP^5"
DO PIECE(ADDRESS,"^",YY)
+20 ;****Institution file change
SET DIVNUM="1"_DIVNUM
SET FACNUM="1"_FACNUM
+21 ; assemble XM - $$XMIT
+22 SET XM="$$XMIT"
+23 FOR YY="BATNM^2","FACNM^3","CMOP^4","FACNUM^5","TRANDTS^6","START^8","END^9","DIVNM^10","DIVNUM^11"
DO PUT(.XM,"^",YY)
+24 SET $PIECE(XM,"^",7)="DOD Facility"
+25 ; change site number for testing to acceptable site number 693
+26 ;S XM=$$SETELM(XM,5,"^",693) ;****TESTING
+27 ;S XM=$$SETELM(XM,11,"^",693) ;****TESTING
+28 ; assemble NTE1(4)
+29 SET NTE1DIV=""
FOR YY="DIVNUM^1","DIVNM^2","FACNUM^3"
DO PUT(.NTE1DIV,"\S\",YY)
+30 SET NTE1ADD=""
FOR YY="ADD1^1","ADD2^2","CITY^3","STATE^4","ZIP^5"
DO PUT(.NTE1ADD,"\S\",YY)
+31 SET NTE1LOC=""
FOR YY="NTE1DIV^1","NTE1ADD^2","PHONE^3"
DO PUT(.NTE1LOC,"\F\",YY)
+32 ; assemble NTE1
+33 SET NTE1="NTE|1||"_NTE1LOC
+34 ; change NTE1 site number to 693 for testing
+35 ;S NTE1=$$SETELM(NTE1,"4,1,1","|,\F\,\S\",693) ;****TESTING
+36 ;S NTE1=$$SETELM(NTE1,"4,1,3","|,\F\,\S\",693) ;****TESTING
+37 ; store $$XMIT,NTE1
+38 QUIT
BLDSEQ ;build check sequence of SEGMENTS
+1 KILL SEGSEQ
+2 FOR I=1:1
SET LINE=$PIECE($TEXT(SEGBLD+I),";;",2,99)
IF LINE["$$END"
QUIT
Begin DoDot:1
+3 SET LSEG=$PIECE(LINE,";;")
+4 ;W !,LSEG,?10,SEG
FOR J=2:1
SET SEG=$PIECE(LINE,";;",J)
IF SEG=""
QUIT
SET SEGSEQ(LSEG,SEG)=""
End DoDot:1
+5 QUIT
SEGBLD ; data for checking sequence of segments. ZR1 needs special handling.
+1 ;;FHS;;BHS
+2 ;;BHS;;ORC
+3 ;;ORC;;NTE|2;;NTE|3;;NTE|4;;MSH
+4 ;;NTE|2;;NTE|2;;NTE|3;;NTE|4;;MSH
+5 ;;NTE|3;;NTE|3;;NTE|4;;MSH
+6 ;;NTE|4;;NTE|4;;MSH
+7 ;;MSH;;PID
+8 ;;PID;;NTE|8;;ORC
+9 ;;NTE|8;;ORC;;NTE|8;;ZML;;ZSL
+10 ;;ZML;;ZML;;ZSL
+11 ;;ZSL;;ZSL;;ORC
+12 ;;ORC;;RXE
+13 ;;RXE;;ZR1;;NTE|7
+14 ;;NTE|7;;NTE|7;;ZR1
+15 ;;ZR1;;ORC;;BTS;;MSH;;PID
+16 ;;BTS;;FTS
+17 ;;$$END
PIECE(REC,DLM,XX) ;
+1 ; Set VAR = piece I of REC using delimiter DLM
+2 NEW Y,I
SET Y=$PIECE(XX,U)
SET I=$PIECE(XX,U,2)
SET @Y=$PIECE(REC,DLM,I)
+3 QUIT
PUT(REC,DLM,XX) ;
+1 ; Set VAR into piece I of REC using delimiter DLM
+2 NEW Y,I
SET Y=$PIECE(XX,U)
SET I=$PIECE(XX,U,2)
+3 SET $PIECE(REC,DLM,I)=$GET(@Y)
+4 QUIT
GETELM(STR,PIECES,SEPS) ;
+1 ; uses STRing and
+2 ; returns value of the element located by path of pieces and seperators
+3 ; ex: PIECES "3,2,1" SEPS "|,^,&"
+4 NEW P,S,PI,V
SET V=STR
+5 FOR I=1:1
SET PI=$PIECE(PIECES,",",I)
IF PI=""
QUIT
SET P=I
SET P(I)=PI
SET S(I)=$PIECE(SEPS,",",I)
+6 FOR I=1:1:P
SET V=$PIECE(V,S(I),P(I))
+7 QUIT V
SETELM(STR,PIECES,SEPS,VALUE) ;
+1 ; gets STRing and
+2 ; inserts value into element located by path of pieces and separators
+3 ; ex: PIECES "3,2,1" SEPS "|,^,&"
+4 NEW P,S,PI,V
+5 SET (V,V(0))=STR
+6 FOR I=1:1
SET PI=$PIECE(PIECES,",",I)
IF PI=""
QUIT
SET P=I
SET P(I)=PI
SET S(I)=$PIECE(SEPS,",",I)
+7 ; unpack
FOR I=1:1:P
SET (V,V(I))=$PIECE(V,S(I),P(I))
+8 ; insert value
SET V(I)=VALUE
+9 ; repack
FOR I=P:-1:1
SET $PIECE(V(I-1),S(I),P(I))=V(I)
+10 QUIT V(0)
+11 ;
STRBLD(STR0,SEPS) ;
+1 ; default separators for all segments, fields, components are | ^ &
+2 ; other separators can be passed in SEPS ex: "|,^,&" or "|,\F\,\S\"
+3 ; or placed within the field and segment nodes STR0( , , ..,"S")= separator
+4 ; ex: for NTE|1 of HL7 2.1
+5 ; segment NTE|1 STR0("S")="|"
+6 ; facility field STR0(4,"S")="\F\"
+7 ; address component STR0(4,2,"S")="\S\"
+8 NEW P1,P2,P3,S1,S2,S3,STR
+9 IF '$LENGTH($GET(SEPS))
SET SEPS="|,^,&"
+10 MERGE STR=STR0
L1 SET P1=0
SET STR=""
+1 IF '$DATA(STR("S"))
SET STR("S")=$PIECE(SEPS,",",1)
+2 SET S1=STR("S")
+3 FOR
SET P1=$ORDER(STR(P1))
IF P1'>0
QUIT
Begin DoDot:1
+4 IF +$ORDER(STR(P1,0))
DO L2
+5 SET $PIECE(STR,S1,P1)=STR(P1)
End DoDot:1
+6 QUIT STR
L2 ; S STR(P1)=""
SET P2=0
+1 IF '$DATA(STR(P1,"S"))
SET STR(P1,"S")=$PIECE(SEPS,",",2)
+2 SET S2=STR(P1,"S")
+3 FOR
SET P2=$ORDER(STR(P1,P2))
IF P2'>0
QUIT
Begin DoDot:1
+4 IF +$ORDER(STR(P1,P2,0))
DO L3
+5 SET $PIECE(STR(P1),S2,P2)=STR(P1,P2)
End DoDot:1
+6 IF STR(P1)'[S2
SET STR(P1)=STR(P1)_S2
+7 QUIT
L3 ; S STR(P1,P2)=""
SET P3=0
+1 IF '$DATA(STR(P1,P2,"S"))
SET STR(P1,P2,"S")=$PIECE(SEPS,",",3)
+2 SET S3=STR(P1,P2,"S")
+3 FOR
SET P3=$ORDER(STR(P1,P2,P3))
IF P3'>0
QUIT
Begin DoDot:1
+4 SET $PIECE(STR(P1,P2),S3,P3)=STR(P1,P2,P3)
End DoDot:1
+5 IF STR(P1,P2)'[S3
SET STR(P1,P2)=STR(P1,P2)_S3
+6 QUIT
