ORMPS3 ;SLC/MKB - Process Pharmacy ORM msgs cont ;03-Jun-2014 11:20;PLS
;;3.0;ORDER ENTRY/RESULTS REPORTING;**213,243,1013**;Dec 17, 1997;Build 242
;Modified - IHS/MSC/MGH - 06/02/2014 - Line UPD+20
PTR(X) ; -- Return ptr to prompt OR GTX X
Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
;
PARENT ; -- create parent order for backdoor complex renewals
; Expects ORIFN, ORIG, ORDIALOG()
;Q:'$$PATCH^XPDUTL("PSJ*5.0*110")
N ORIGDAD,ORIFNDAD,HDR S ORIGDAD=$P($G(^OR(100,ORIG,3)),U,9)
Q:ORIGDAD<1 Q:$$DOSES^ORCACT4(ORIGDAD)'>1 ;cont if complex
S ORIFNDAD=$P($G(^OR(100,ORIGDAD,3)),U,6) I ORIFNDAD<1 D G P1
. N ORIFN D EN^ORCSAVE Q:ORIFN<1
. S $P(^OR(100,ORIFN,3),U,5)=ORIGDAD,$P(^(3),U,8)=1,$P(^(3),U,11)=2
. S $P(^OR(100,ORIGDAD,3),U,6)=ORIFN,ORIFNDAD=ORIFN
. D RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR)
. D SIGSTS^ORCSAVE2(ORIFN,1),DATES^ORCSAVE2(ORIFN,ORSTRT)
. I $P(^OR(100,ORIFN,8,1,0),U,4)=2 S $P(^(0),U,4)="" K ^OR(100,"AS",ORVP,9999999-ORLOG,ORIFN,1) ;sign children instead
. ;STATUS updated in SN2^ORMPS from child orders
P0 ; -- just add conjunction, new dose if DAD already exists
N INST,DA,PTR,ID,P,I,J,X
S INST=$$DOSES^ORCACT4(ORIFNDAD),DA=$O(^OR(100,ORIFNDAD,4.5,"A"),-1)
S PTR=$$PTR("AND/THEN"),ID="CONJ",DA=DA+1
S ^OR(100,ORIFNDAD,4.5,DA,0)=U_PTR_U_INST_U_ID,^(1)="A"
S ^OR(100,ORIFNDAD,4.5,"ID","CONJ",DA)="",INST=INST+1
F P="INSTRUCTIONS","ROUTE","SCHEDULE","DURATION","DOSE","DISPENSE DRUG" D
. S PTR=$$PTR(P) Q:'$L($G(ORDIALOG(PTR,1)))
. S DA=DA+1,ID=$P($G(^ORD(101.41,PTR,1)),U,3)
. S ^OR(100,ORIFNDAD,4.5,DA,0)=U_PTR_U_INST_U_ID,^(1)=ORDIALOG(PTR,1)
. S ^OR(100,ORIFNDAD,4.5,"ID",ID,DA)=""
S $P(^OR(100,ORIFNDAD,4.5,0),U,3,4)=DA_U_DA
S P=$$PTR("SIG"),DA=+$O(^OR(100,ORIFNDAD,4.5,"ID","SIG",0))
S I=+$O(^OR(100,ORIFNDAD,4.5,DA,2,""),-1),X=$G(^(I,0)) S:$L(X) X=X_" AND",^(0)=X
S J=0 F S J=$O(^TMP("ORWORD",$J,PTR,1,J)) Q:J<1 S I=I+1,^OR(100,ORIFNDAD,4.5,DA,2,I,0)=^TMP("ORWORD",$J,PTR,1,J,0)
S $P(^OR(100,ORIFNDAD,4.5,DA,2,0),U,3,4)=I_U_I
; -- rebuild order text w/new SIG
K ^TMP("ORWORD",$J,PTR) M ^TMP("ORWORD",$J,PTR,1)=^OR(100,ORIFNDAD,4.5,DA,2)
K ^OR(100,ORIFNDAD,8,1,.1) D ORDTEXT^ORCSAVE1(ORIFNDAD_";1")
P1 ; -- set up links
S $P(^OR(100,ORIFN,3),U,9)=ORIFNDAD
S HDR=$G(^OR(100,ORIFNDAD,2,0)),^(0)="^100.002PA^"_ORIFN_U_($P(HDR,U,4)+1),^(ORIFN,0)=ORIFN
Q
;
NTE(ID) ; -- Return subscript of NTE|ID segment
N I,SEG,Y S Y="",I=+RXE S:'$G(ID) ID=21
F S I=$O(@ORMSG@(I)) Q:I'>0 S SEG=@ORMSG@(I) Q:$E(SEG,1,3)="ORC" I $P(SEG,"|",1,2)=("NTE|"_ID) S Y=I Q
Q Y
;
NTXT(NTE) ; -- Return string of text in ORMSG(NTE)
N Y,I S NTE=+$G(NTE)
S Y=$P($G(@ORMSG@(NTE)),"|",4),Y=$$UNESC^ORHLESC(Y)
S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I<1 S Y=Y_" "_$$UNESC^ORHLESC(@ORMSG@(NTE,I))
Q Y
;
ZSC() ; -- Return subscript of ZSC segment
N I,SEG,Y S Y="",I=+RXE
F S I=$O(@ORMSG@(I)) Q:I'>0 S SEG=$E(@ORMSG@(I),1,3) Q:SEG="ORC" I SEG="ZSC" S Y=I_U_@ORMSG@(I) Q
Q Y
;
NUMADDS() ; -- count number of additives to determine type
N CNT,I,X S CNT=0,I=+RXE
F S I=$O(@ORMSG@(I)) Q:I'>0 S X=@ORMSG@(I) Q:$P(X,"|")="ORC" I $E(X,1,6)="RXC|A|" S CNT=CNT+1
Q CNT
;
DURATION(X) ; -- Returns "# units" from U# format
N Y,Y1,Y2 I X'?.1U1.N Q ""
S Y1=$E(X),Y2=+$E(X,2,$L(X)) I X=+X S Y1="D",Y2=+X
S Y=Y2_" "_$S(Y1="L":"MONTH",Y1="W":"WEEK",Y1="H":"HOUR",Y1="M":"MINUTE",Y1="S":"SECOND",1:"DAY")_$S(Y2>1:"S",1:"")
Q Y
;
UPD ; -- Compare ORMSG to order, update responses [from SC^ORMPS]
; Also expects ORIFN,ORNP,ORCAT,OR3,RXE,ZRX,PKGIFN
N X,I,ORDER,ZSC,NTE,PI
S ORDER=+$G(ORIFN),I=+$P(ORIFN,";",2) I I<1 D
. S I=+$P(OR3,U,7) Q:I
. S I=$O(^OR(100,+ORIFN,8,"A"),-1)
S X=+$P($G(^OR(100,+ORIFN,8,I,0)),U,3) S:X'=ORNP $P(^(0),U,3)=ORNP
S X=+$P($P(RXE,"|",3),U,4)
I X,X'=+$$VALUE(ORDER,"DRUG") D RESP^ORCSAVE2(ORDER,"OR GTX DISPENSE DRUG",X)
I $G(ORCAT)="I" D Q
. S X=$P($P($P(RXE,"|",2),U,2),"&",2)
. I X'=$$VALUE(ORDER,"ADMIN") D RESP^ORCSAVE2(ORDER,"OR GTX ADMIN TIMES",X)
. ;SCHEDULE TYPE
. S X=$P($P(RXE,"|",2),U,7)
. I X'=$$VALUE(ORDER,"SCHTYPE") D RESP^ORCSAVE2(ORDER,"OR GTX SCHEDULE TYPE",X)
. I $S(X="P":1,X="O":1,X="OC":1,1:0) D
. .D RESP^ORCSAVE2(ORDER,"OR GTX ADMIN TIMES","")
I $G(PKGIFN)'["N" D ;Rx only, not non-VA
. S X=$P(RXE,"|",23) S:$E(X)="D" X=+$E(X,2,99)
. I +X'=+$$VALUE(ORDER,"SUPPLY") D RESP^ORCSAVE2(ORDER,"OR GTX DAYS SUPPLY",X)
. ;IHS/MSC/MGH Patch 1013 Change for backdoor edits
. S X=$$FIND^ORM(+ORC,4)
. I $P(X,U,2)="PS"&(+X) D
.. D RESP^ORCSAVE2(ORDER,"OR GTX DAW",$$GET1^DIQ(52,+X,9999999.25,"I"))
.. D RESP^ORCSAVE2(ORDER,"OR GTX CMF",$$GET1^DIQ(52,+X,9999999.02,"I"))
.. D RESP^ORCSAVE2(ORDER,"OR GTX DSCMED",$$GET1^DIQ(52,+X,9999999.28,"I"))
. ;End mod
. I $P(ZRX,"|",5)'=$$VALUE(ORDER,"PICKUP") D RESP^ORCSAVE2(ORDER,"OR GTX ROUTING",$P(ZRX,"|",5))
. S NTE=$$NTE(7),PI=+$O(^OR(100,ORDER,4.5,"ID","PI",0))
. I NTE,PI,$$NTXT(NTE)'=$$VALTXT(ORDER,PI) D
.. N CNT K ^OR(100,ORDER,4.5,PI,2)
.. S CNT=1,^OR(100,ORDER,4.5,PI,2,1,0)=$$UNESC^ORMPS2($P(@ORMSG@(NTE),"|",4))
.. S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I<1 S CNT=CNT+1,^OR(100,ORDER,4.5,PI,2,CNT,0)=$$UNESC^ORMPS2(@ORMSG@(NTE,I))
.. S ^OR(100,ORDER,4.5,PI,2,0)="^^"_CNT_U_CNT_U_DT_U
S ZSC=$$ZSC I ZSC,$P(ZSC,"|",2)'?2.3U S ^OR(100,ORDER,5)=$TR($P(ZSC,"|",2,7),"|","^") ;1 or 0 instead of [N]SC
Q
;
VALUE(IFN,ID,INST) ; -- Returns value of prompt by identifier ID
I '$G(IFN)!('$D(^OR(100,+$G(IFN),0)))!($G(ID)="") Q ""
N I,Y S I=0,Y="" S:'$G(INST) INST=1
F S I=$O(^OR(100,IFN,4.5,"ID",ID,I)) Q:I'>0 I $P($G(^OR(100,IFN,4.5,+I,0)),U,3)=INST S Y=$G(^(1)) Q
Q Y
;
VALTXT(IFN,ID) ; -- Return string of text for prompt ID [assumes single instance]
; ID may be identifier name or Response IEN
N Y,DA,I S IFN=+$G(IFN),ID=$G(ID)
S DA=$S($G(ID):+ID,$L(ID):+$O(^OR(100,IFN,4.5,"ID",ID,0)),1:0)
S I=+$O(^OR(100,IFN,4.5,DA,2,0)),Y=$G(^(I,0))
F S I=$O(^OR(100,IFN,4.5,DA,2,I)) Q:I<1 S Y=Y_" "_$G(^(I,0))
Q Y
ORMPS3 ;SLC/MKB - Process Pharmacy ORM msgs cont ;03-Jun-2014 11:20;PLS
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**213,243,1013**;Dec 17, 1997;Build 242
+2 ;Modified - IHS/MSC/MGH - 06/02/2014 - Line UPD+20
PTR(X) ; -- Return ptr to prompt OR GTX X
+1 QUIT +$ORDER(^ORD(101.41,"AB","OR GTX "_X,0))
+2 ;
PARENT ; -- create parent order for backdoor complex renewals
+1 ; Expects ORIFN, ORIG, ORDIALOG()
+2 ;Q:'$$PATCH^XPDUTL("PSJ*5.0*110")
+3 NEW ORIGDAD,ORIFNDAD,HDR
SET ORIGDAD=$PIECE($GET(^OR(100,ORIG,3)),U,9)
+4 ;cont if complex
IF ORIGDAD<1
QUIT
IF $$DOSES^ORCACT4(ORIGDAD)'>1
QUIT
+5 SET ORIFNDAD=$PIECE($GET(^OR(100,ORIGDAD,3)),U,6)
IF ORIFNDAD<1
Begin DoDot:1
+6 NEW ORIFN
DO EN^ORCSAVE
IF ORIFN<1
QUIT
+7 SET $PIECE(^OR(100,ORIFN,3),U,5)=ORIGDAD
SET $PIECE(^(3),U,8)=1
SET $PIECE(^(3),U,11)=2
+8 SET $PIECE(^OR(100,ORIGDAD,3),U,6)=ORIFN
SET ORIFNDAD=ORIFN
+9 DO RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR)
+10 DO SIGSTS^ORCSAVE2(ORIFN,1)
DO DATES^ORCSAVE2(ORIFN,ORSTRT)
+11 ;sign children instead
IF $PIECE(^OR(100,ORIFN,8,1,0),U,4)=2
SET $PIECE(^(0),U,4)=""
KILL ^OR(100,"AS",ORVP,9999999-ORLOG,ORIFN,1)
+12 ;STATUS updated in SN2^ORMPS from child orders
End DoDot:1
GOTO P1
P0 ; -- just add conjunction, new dose if DAD already exists
+1 NEW INST,DA,PTR,ID,P,I,J,X
+2 SET INST=$$DOSES^ORCACT4(ORIFNDAD)
SET DA=$ORDER(^OR(100,ORIFNDAD,4.5,"A"),-1)
+3 SET PTR=$$PTR("AND/THEN")
SET ID="CONJ"
SET DA=DA+1
+4 SET ^OR(100,ORIFNDAD,4.5,DA,0)=U_PTR_U_INST_U_ID
SET ^(1)="A"
+5 SET ^OR(100,ORIFNDAD,4.5,"ID","CONJ",DA)=""
SET INST=INST+1
+6 FOR P="INSTRUCTIONS","ROUTE","SCHEDULE","DURATION","DOSE","DISPENSE DRUG"
Begin DoDot:1
+7 SET PTR=$$PTR(P)
IF '$LENGTH($GET(ORDIALOG(PTR,1)))
QUIT
+8 SET DA=DA+1
SET ID=$PIECE($GET(^ORD(101.41,PTR,1)),U,3)
+9 SET ^OR(100,ORIFNDAD,4.5,DA,0)=U_PTR_U_INST_U_ID
SET ^(1)=ORDIALOG(PTR,1)
+10 SET ^OR(100,ORIFNDAD,4.5,"ID",ID,DA)=""
End DoDot:1
+11 SET $PIECE(^OR(100,ORIFNDAD,4.5,0),U,3,4)=DA_U_DA
+12 SET P=$$PTR("SIG")
SET DA=+$ORDER(^OR(100,ORIFNDAD,4.5,"ID","SIG",0))
+13 SET I=+$ORDER(^OR(100,ORIFNDAD,4.5,DA,2,""),-1)
SET X=$GET(^(I,0))
IF $LENGTH(X)
SET X=X_" AND"
SET ^(0)=X
+14 SET J=0
FOR
SET J=$ORDER(^TMP("ORWORD",$JOB,PTR,1,J))
IF J<1
QUIT
SET I=I+1
SET ^OR(100,ORIFNDAD,4.5,DA,2,I,0)=^TMP("ORWORD",$JOB,PTR,1,J,0)
+15 SET $PIECE(^OR(100,ORIFNDAD,4.5,DA,2,0),U,3,4)=I_U_I
+16 ; -- rebuild order text w/new SIG
+17 KILL ^TMP("ORWORD",$JOB,PTR)
MERGE ^TMP("ORWORD",$JOB,PTR,1)=^OR(100,ORIFNDAD,4.5,DA,2)
+18 KILL ^OR(100,ORIFNDAD,8,1,.1)
DO ORDTEXT^ORCSAVE1(ORIFNDAD_";1")
P1 ; -- set up links
+1 SET $PIECE(^OR(100,ORIFN,3),U,9)=ORIFNDAD
+2 SET HDR=$GET(^OR(100,ORIFNDAD,2,0))
SET ^(0)="^100.002PA^"_ORIFN_U_($PIECE(HDR,U,4)+1)
SET ^(ORIFN,0)=ORIFN
+3 QUIT
+4 ;
NTE(ID) ; -- Return subscript of NTE|ID segment
+1 NEW I,SEG,Y
SET Y=""
SET I=+RXE
IF '$GET(ID)
SET ID=21
+2 FOR
SET I=$ORDER(@ORMSG@(I))
IF I'>0
QUIT
SET SEG=@ORMSG@(I)
IF $EXTRACT(SEG,1,3)="ORC"
QUIT
IF $PIECE(SEG,"|",1,2)=("NTE|"_ID)
SET Y=I
QUIT
+3 QUIT Y
+4 ;
NTXT(NTE) ; -- Return string of text in ORMSG(NTE)
+1 NEW Y,I
SET NTE=+$GET(NTE)
+2 SET Y=$PIECE($GET(@ORMSG@(NTE)),"|",4)
SET Y=$$UNESC^ORHLESC(Y)
+3 SET I=0
FOR
SET I=$ORDER(@ORMSG@(NTE,I))
IF I<1
QUIT
SET Y=Y_" "_$$UNESC^ORHLESC(@ORMSG@(NTE,I))
+4 QUIT Y
+5 ;
ZSC() ; -- Return subscript of ZSC segment
+1 NEW I,SEG,Y
SET Y=""
SET I=+RXE
+2 FOR
SET I=$ORDER(@ORMSG@(I))
IF I'>0
QUIT
SET SEG=$EXTRACT(@ORMSG@(I),1,3)
IF SEG="ORC"
QUIT
IF SEG="ZSC"
SET Y=I_U_@ORMSG@(I)
QUIT
+3 QUIT Y
+4 ;
NUMADDS() ; -- count number of additives to determine type
+1 NEW CNT,I,X
SET CNT=0
SET I=+RXE
+2 FOR
SET I=$ORDER(@ORMSG@(I))
IF I'>0
QUIT
SET X=@ORMSG@(I)
IF $PIECE(X,"|")="ORC"
QUIT
IF $EXTRACT(X,1,6)="RXC|A|"
SET CNT=CNT+1
+3 QUIT CNT
+4 ;
DURATION(X) ; -- Returns "# units" from U# format
+1 NEW Y,Y1,Y2
IF X'?.1U1.N
QUIT ""
+2 SET Y1=$EXTRACT(X)
SET Y2=+$EXTRACT(X,2,$LENGTH(X))
IF X=+X
SET Y1="D"
SET Y2=+X
+3 SET Y=Y2_" "_$SELECT(Y1="L":"MONTH",Y1="W":"WEEK",Y1="H":"HOUR",Y1="M":"MINUTE",Y1="S":"SECOND",1:"DAY")_$SELECT(Y2>1:"S",1:"")
+4 QUIT Y
+5 ;
UPD ; -- Compare ORMSG to order, update responses [from SC^ORMPS]
+1 ; Also expects ORIFN,ORNP,ORCAT,OR3,RXE,ZRX,PKGIFN
+2 NEW X,I,ORDER,ZSC,NTE,PI
+3 SET ORDER=+$GET(ORIFN)
SET I=+$PIECE(ORIFN,";",2)
IF I<1
Begin DoDot:1
+4 SET I=+$PIECE(OR3,U,7)
IF I
QUIT
+5 SET I=$ORDER(^OR(100,+ORIFN,8,"A"),-1)
End DoDot:1
+6 SET X=+$PIECE($GET(^OR(100,+ORIFN,8,I,0)),U,3)
IF X'=ORNP
SET $PIECE(^(0),U,3)=ORNP
+7 SET X=+$PIECE($PIECE(RXE,"|",3),U,4)
+8 IF X
IF X'=+$$VALUE(ORDER,"DRUG")
DO RESP^ORCSAVE2(ORDER,"OR GTX DISPENSE DRUG",X)
+9 IF $GET(ORCAT)="I"
Begin DoDot:1
+10 SET X=$PIECE($PIECE($PIECE(RXE,"|",2),U,2),"&",2)
+11 IF X'=$$VALUE(ORDER,"ADMIN")
DO RESP^ORCSAVE2(ORDER,"OR GTX ADMIN TIMES",X)
+12 ;SCHEDULE TYPE
+13 SET X=$PIECE($PIECE(RXE,"|",2),U,7)
+14 IF X'=$$VALUE(ORDER,"SCHTYPE")
DO RESP^ORCSAVE2(ORDER,"OR GTX SCHEDULE TYPE",X)
+15 IF $SELECT(X="P":1,X="O":1,X="OC":1,1:0)
Begin DoDot:2
+16 DO RESP^ORCSAVE2(ORDER,"OR GTX ADMIN TIMES","")
End DoDot:2
End DoDot:1
QUIT
+17 ;Rx only, not non-VA
IF $GET(PKGIFN)'["N"
Begin DoDot:1
+18 SET X=$PIECE(RXE,"|",23)
IF $EXTRACT(X)="D"
SET X=+$EXTRACT(X,2,99)
+19 IF +X'=+$$VALUE(ORDER,"SUPPLY")
DO RESP^ORCSAVE2(ORDER,"OR GTX DAYS SUPPLY",X)
+20 ;IHS/MSC/MGH Patch 1013 Change for backdoor edits
+21 SET X=$$FIND^ORM(+ORC,4)
+22 IF $PIECE(X,U,2)="PS"&(+X)
Begin DoDot:2
+23 DO RESP^ORCSAVE2(ORDER,"OR GTX DAW",$$GET1^DIQ(52,+X,9999999.25,"I"))
+24 DO RESP^ORCSAVE2(ORDER,"OR GTX CMF",$$GET1^DIQ(52,+X,9999999.02,"I"))
+25 DO RESP^ORCSAVE2(ORDER,"OR GTX DSCMED",$$GET1^DIQ(52,+X,9999999.28,"I"))
End DoDot:2
+26 ;End mod
+27 IF $PIECE(ZRX,"|",5)'=$$VALUE(ORDER,"PICKUP")
DO RESP^ORCSAVE2(ORDER,"OR GTX ROUTING",$PIECE(ZRX,"|",5))
+28 SET NTE=$$NTE(7)
SET PI=+$ORDER(^OR(100,ORDER,4.5,"ID","PI",0))
+29 IF NTE
IF PI
IF $$NTXT(NTE)'=$$VALTXT(ORDER,PI)
Begin DoDot:2
+30 NEW CNT
KILL ^OR(100,ORDER,4.5,PI,2)
+31 SET CNT=1
SET ^OR(100,ORDER,4.5,PI,2,1,0)=$$UNESC^ORMPS2($PIECE(@ORMSG@(NTE),"|",4))
+32 SET I=0
FOR
SET I=$ORDER(@ORMSG@(NTE,I))
IF I<1
QUIT
SET CNT=CNT+1
SET ^OR(100,ORDER,4.5,PI,2,CNT,0)=$$UNESC^ORMPS2(@ORMSG@(NTE,I))
+33 SET ^OR(100,ORDER,4.5,PI,2,0)="^^"_CNT_U_CNT_U_DT_U
End DoDot:2
End DoDot:1
+34 ;1 or 0 instead of [N]SC
SET ZSC=$$ZSC
IF ZSC
IF $PIECE(ZSC,"|",2)'?2.3U
SET ^OR(100,ORDER,5)=$TRANSLATE($PIECE(ZSC,"|",2,7),"|","^")
+35 QUIT
+36 ;
VALUE(IFN,ID,INST) ; -- Returns value of prompt by identifier ID
+1 IF '$GET(IFN)!('$DATA(^OR(100,+$GET(IFN),0)))!($GET(ID)="")
QUIT ""
+2 NEW I,Y
SET I=0
SET Y=""
IF '$GET(INST)
SET INST=1
+3 FOR
SET I=$ORDER(^OR(100,IFN,4.5,"ID",ID,I))
IF I'>0
QUIT
IF $PIECE($GET(^OR(100,IFN,4.5,+I,0)),U,3)=INST
SET Y=$GET(^(1))
QUIT
+4 QUIT Y
+5 ;
VALTXT(IFN,ID) ; -- Return string of text for prompt ID [assumes single instance]
+1 ; ID may be identifier name or Response IEN
+2 NEW Y,DA,I
SET IFN=+$GET(IFN)
SET ID=$GET(ID)
+3 SET DA=$SELECT($GET(ID):+ID,$LENGTH(ID):+$ORDER(^OR(100,IFN,4.5,"ID",ID,0)),1:0)
+4 SET I=+$ORDER(^OR(100,IFN,4.5,DA,2,0))
SET Y=$GET(^(I,0))
+5 FOR
SET I=$ORDER(^OR(100,IFN,4.5,DA,2,I))
IF I<1
QUIT
SET Y=Y_" "_$GET(^(I,0))
+6 QUIT Y
