HLOPRSR3 ;ALB/CJM - Visual Parser 12 JUN 1997 10:00 am ;08/29/2008
;;1.6;HEALTH LEVEL SEVEN;**138**;Oct 13, 1995;Build 34
;Per VHA Directive 2004-038, this routine should not be modified.
;
;
SETUP(PARMS,MSG,POS,SEG) ;
N I,TMP,TOP,BOT,QUIT
S TMP=$G(PARMS("ARY"))
Q:'$L(TMP) 0
S TOP=$G(PARMS("TOP"))
Q:'TOP 0
S BOT=$G(PARMS("BOT"))
Q:'BOT 0
D PREP^XGF
;D TEST^XGKB
D ENS^%ZISS
D I QUIT W !,"Sorry, your terminal is not configured to support this option!",!,"If working from a PC, you might try selecting a VT-series device type" D PAUSE^VALM1 Q 0
.S QUIT=1
.Q:'$L(IOXY)
.Q:'$$TEST^DDBRT
.S QUIT=0
S IOTM=1,IOBM=IOSL-11
I (BOT-TOP)<100 D
.S MSG="MSG"
E D
.S MSG=$NA(^TMP($J,"HLO MSG"))
F I=TOP:1:BOT S @MSG@(I-TOP+1)=$G(@TMP@(I,0)) ;get msg from ListManager array
;GET DELIMITERS
S FLD=$E($G(@MSG@(1)),4)
S DELIM=$P($G(@MSG@(1)),FLD,2)
S COMP=$E(DELIM,1)
S REP=$E(DELIM,2)
S ESC=$E(DELIM,3)
S SUB=$E(DELIM,4)
S DELIM=FLD_COMP_REP_SUB
S SEGTYPE=$E($G(@MSG@(1)),1,3)
;get version id
D
.N HDR,FS,CS,SUBCOMP,ESCAPE
.S FS=FLD,CS=COMP,SUBCOMP=SUB,ESCAPE=ESC
.S I=0
.F S I=$O(@MSG@(I)) Q:'I Q:$G(SEGLINE(I))>1 S HDR(I)=$G(@MSG@(I))
.D SPLITHDR^HLOSRVR1(.HDR)
.S VERSION=$$DESCAPE^HLOPRS($P($P(HDR(2),FLD,7),COMP))
S I=0
F S I=$O(PARMS(I)) Q:'I S SEG(I)=PARMS(I)-TOP+1,SEGLINE(SEG(I))=I
I $$LINE(1),$$X(1),$$SEG(1)
D:$$FLD(0) D:$$REP(0) D:$$COMP(0) D:$$SUB(0)
.;
S POS("TOP")=1
S POS("CURRENT DELIMITER")="1^0"
S POS("NEXT DELIMITER")="1^4"
S I=0 F S I=$O(@MSG@(I)) Q:'I Q:(I>IOBM) D WRITELN^HLOPRSR1(I,I)
D IOXY(IOBM+1,1)
W IORVON," Q:quit ?:help [Up/Down/Left/Right Arrow]:navigation ",IORVOFF
W @IOSTBM
D DESCRIBE
D HILITE^HLOPRSR2(1,1,1,3)
S LASTPART(1)=1,LASTPART(1,1)=1,LASTPART(1,1,1)=1
S LASTPART(2)=1,LASTPART(2,1)=1,LASTPART(2,1,1)=1
Q 1
;
DESCRIBE ;
N I,MSG2,VAL
S DESCRIBE=$S($G(DESCRIBE)="MSG1":"MSG2",1:"MSG1")
K @DESCRIBE
S OLD=$S(DESCRIBE="MSG1":"MSG2",1:"MSG1")
I $L(SEGTYPE) D
.I $$GETSEG(.VAL,SEGTYPE,$G(VERSION))
.S @DESCRIBE@(1)=IOINHI_"Segment"_IOINORM_": #"_$$SEG_" "_SEGTYPE_" "_$$LJ(VAL("NAME"),50)
.Q:$$FLD<1
.I (SEGTYPE="MSH")!(SEGTYPE="BHS"),($$FLD=1)!($$FLD=2) D
..S @DESCRIBE@(2)=" Field Separator: "_FLD
..S @DESCRIBE@(3)=" Component Separator: "_COMP
..S @DESCRIBE@(4)=" Repetition Separator: "_REP
..S @DESCRIBE@(5)=" Escape Character: "_ESC
..S @DESCRIBE@(6)=" Subcomponent Separator: "_SUB
.E D
..N REPEAPT
..I $$GETFLD(.VAL,SEGTYPE,$G(VERSION),$$FLD)
..S @DESCRIBE@(2)=IOINHI_" Field"_IOINORM_": #"_$$LJ($$FLD,3)_" "_$$LJ(VAL("NAME"),47)_$$LJ(" Repetition: #"_$$REP,7)
..S REPEAT=VAL("REPETITION")
..S REPEAT=$S(REPEAT="False":"no",REPEAT="True":"yes",1:REPEAT)
..S @DESCRIBE@(3)=" Repeating: "_$$LJ(REPEAT,4)_" MaxLength: "_$$LJ(VAL("MAX LENGTH"),5)_" Item #: "_$$LJ(VAL("ID"),6)
..;remove 'optionality' for now, put it back in a future patch
..;S @DESCRIBE@(4)=" DataType: "_$$LJ(VAL("DATA TYPE"),3)_" Optionality: "_$$LJ($$OPTIONAL(VAL("OPTIONALITY")),11)_" Table: "_$$LJ(VAL("TABLE"),4)
..S @DESCRIBE@(4)=" DataType: "_$$LJ(VAL("DATA TYPE"),3)_" Table: "_$$LJ(VAL("TABLE"),4)
..D
...N NEXT
...S NEXT=$E($G(@MSG@(+POS("NEXT DELIMITER"))),$P(POS("NEXT DELIMITER"),"^",2))
...I '$$GETCOMP(.VAL,SEGTYPE,$G(VERSION),$$FLD,$$COMP),$$COMP=1,NEXT'=SUB,NEXT'=COMP Q
...S @DESCRIBE@(5)=IOINHI_" Comp"_IOINORM_": #"_$$LJ($$COMP,4)_" "_$$LJ(VAL("NAME"),50)
...;remove 'optionality' for now - put it back in a future patch
...;S @DESCRIBE@(6)=" DataType: "_$$LJ(VAL("DATA TYPE"),3)_" Optionality: "_$$LJ($$OPTIONAL(VAL("OPTIONALITY")),11)_" Table: "_$$LJ(VAL("TABLE"),4)
...S @DESCRIBE@(6)=" DataType: "_$$LJ(VAL("DATA TYPE"),3)_" Table: "_$$LJ(VAL("TABLE"),4)
...D
....I '$$GETSUB(.VAL,SEGTYPE,$G(VERSION),$$FLD,$$COMP,$$SUB),$$SUB=1,$E($G(@MSG@(+POS("NEXT DELIMITER"))),$P(POS("NEXT DELIMITER"),"^",2))'=SUB Q
....S @DESCRIBE@(7)=IOINHI_" Sub"_IOINORM_": #"_$$LJ($$SUB,21)_" "_$$LJ(VAL("NAME"),50)
....;remove 'optionality for now, put it back in a future patch
....;S @DESCRIBE@(8)=" DataType: "_$$LJ(VAL("DATA TYPE"),3)_" Optionality: "_$$LJ($$OPTIONAL(VAL("OPTIONALITY")),11)_" Table: "_$$LJ(VAL("TABLE"),4)
....S @DESCRIBE@(8)=" DataType: "_$$LJ(VAL("DATA TYPE"),3)_" Table: "_$$LJ(VAL("TABLE"),4)
..I $$FLD D
...N VAL
...S VAL=$$DESCAPE^HLOPRS1(VALUE,FLD,COMP,SUB,REP,ESC)
...S @DESCRIBE@(10)=IOINHI_"Value"_IOINORM_": "_$S(VAL="""""":""""" (NULL value)",1:$$LJ(VAL,73))
E D
.F I=1:1:10 S @DESCRIBE@(I)=""
F I=1:1:10 I ($G(@DESCRIBE@(I))="")!$G(@DESCRIBE@(I))'=$G(@OLD@(I)) D IOXY(IOBM+I+1,1) W $$LJ($G(@DESCRIBE@(I)),80)
K @OLD
Q
LJ(STRING,LENGTH) ;
Q $$LJ^XLFSTR(STRING,LENGTH)
;
GETSEG(VALUE,SEG,VERSION) ;
N NODE
S VALUE("NAME")=""
S SEGIEN=""
S:$L($G(VERSION)) SEGIEN=$O(^HLD(779.5,"C",SEG,VERSION,0))
S:'SEGIEN SEGIEN=$O(^HLD(779.5,"B",SEG,999999),-1)
Q:'SEGIEN 0
S NODE=$G(^HLD(779.5,SEGIEN,0))
S VALUE("NAME")=$P(NODE,"^",2)
Q 1
GETFLD(VALUE,SEG,VERSION,FLD) ;
K VALUES
N NODE,SEGIEN,FLDIEN
F NODE="NAME","DATA TYPE","MAX LENGTH","REPETITION","OPTIONALITY","TABLE","ID" S VALUE(NODE)=""
S SEGIEN=""
S:$L($G(VERSION)) SEGIEN=$O(^HLD(779.5,"C",SEG,VERSION,0))
S:'SEGIEN SEGIEN=$O(^HLD(779.5,"B",SEG,999999),-1)
Q:'SEGIEN 0
S FLDIEN=$O(^HLD(779.5,SEGIEN,1,"B",FLD,0))
Q:'FLDIEN 0
S NODE=$G(^HLD(779.5,SEGIEN,1,FLDIEN,0))
S VALUE("NAME")=$P(NODE,"^",2)
S VALUE("MAX LENGTH")=$P(NODE,"^",3)
S VALUE("DATA TYPE")=$P(NODE,"^",4)
S VALUE("OPTIONALITY")=$P(NODE,"^",5)
S VALUE("REPETITION")=$P(NODE,"^",6)
S VALUE("TABLE")=$P(NODE,"^",7)
S VALUE("ID")=$P(NODE,"^",8)
Q 1
GETCOMP(VALUE,SEG,VERSION,FLD,COMP) ;
K VALUES
N NODE,SEGIEN,FLDIEN,COMPIEN
F NODE="NAME","DATA TYPE","OPTIONALITY","TABLE" S VALUE(NODE)=""
S SEGIEN=""
S:$L($G(VERSION)) SEGIEN=$O(^HLD(779.5,"C",SEG,VERSION,0))
S:'SEGIEN SEGIEN=$O(^HLD(779.5,"B",SEG,999999),-1)
Q:'SEGIEN 0
S FLDIEN=$O(^HLD(779.5,SEGIEN,1,"B",FLD,0))
Q:'FLDIEN 0
S COMPIEN=$O(^HLD(779.5,SEGIEN,1,FLDIEN,2,"B",COMP,0))
Q:'COMPIEN 0
S NODE=$G(^HLD(779.5,SEGIEN,1,FLDIEN,2,COMPIEN,0))
S VALUE("NAME")=$P(NODE,"^",2)
S VALUE("DATA TYPE")=$P(NODE,"^",3)
S VALUE("OPTIONALITY")=$P(NODE,"^",4)
S VALUE("TABLE")=$P(NODE,"^",7)
Q 1
GETSUB(VALUE,SEG,VERSION,FLD,COMP,SUB) ;
K VALUES
N NODE,SEGIEN,FLDIEN,COMPIEN,SUBIEN
F NODE="NAME","DATA TYPE","OPTIONALITY","TABLE" S VALUE(NODE)=""
S SEGIEN=""
S:$L($G(VERSION)) SEGIEN=$O(^HLD(779.5,"C",SEG,VERSION,0))
S:'SEGIEN SEGIEN=$O(^HLD(779.5,"B",SEG,999999),-1)
Q:'SEGIEN 0
S FLDIEN=$O(^HLD(779.5,SEGIEN,1,"B",FLD,0))
Q:'FLDIEN 0
S COMPIEN=$O(^HLD(779.5,SEGIEN,1,FLDIEN,2,"B",COMP,0))
Q:'COMPIEN 0
S SUBIEN=$O(^HLD(779.5,SEGIEN,1,FLDIEN,2,COMPIEN,3,"B",SUB,0))
Q:'SUBIEN 0
S NODE=$G(^HLD(779.5,SEGIEN,1,FLDIEN,2,COMPIEN,3,SUBIEN,0))
S VALUE("NAME")=$P(NODE,"^",2)
S VALUE("DATA TYPE")=$P(NODE,"^",3)
S VALUE("OPTIONALITY")=$P(NODE,"^",4)
S VALUE("TABLE")=$P(NODE,"^",7)
Q 1
HELP ;
N I
S DESCRIBE="MSG1"
K MSG1,MSG2
S MSG1(1)="Navigation Keys"
S MSG(2)=""
S MSG1(3)=IOINHI_"[Left Arrow] [Right Arrow]"_IOINORM_" : move left and right through a segment"
S MSG1(4)=IOINHI_"[Up Arrow] [Down Arrow]"_IOINORM_" : move up and down through the segments"
S MSG1(5)=IOINHI_"[Q]"_IOINORM_" : quit the parser"
S MSG1(6)=IOINHI_"[?]"_IOINORM_" : help for navigation keys"
F I=1:1:10 D IOXY(IOBM+I+1,1) W $$LJ($G(MSG1(I)),80)
D IOXY($$Y(+POS("CURRENT DELIMITER")),$$X($P(POS("CURRENT DELIMITER"),"^",2)))
Q
;
LINE(TO,INC) ;msg line
Q $$LINE^HLOPRSR1(.TO,.INC)
;
X(TO,INC) ;current position within the line
;
Q $$X^HLOPRSR1(.TO,.INC)
Y(LINE) ;screen line of msg line = LINE
Q $$Y^HLOPRSR1(.LINE)
SEG(INC) ;returns the current segement #
Q $$SEG^HLOPRSR1(.INC)
FLD(SET) ;returns the currrent field #
Q $$FLD^HLOPRSR1(.SET)
REP(SET) ;returns the current repetition #
Q $$REP^HLOPRSR1(.SET)
COMP(SET) ;returns the current component #
Q $$COMP^HLOPRSR1(.SET)
;
SUB(SET) ;returns the current sub-component #
Q $$SUB^HLOPRSR1(.SET)
;
SEGSTART(SEGMENT) ;
Q $$SEGSTART^HLOPRSR1(.SEGMENT)
;
IOXY(Y,X) ; moves to screen position line=Y, col=X
D IOXY^HLOPRSR1(.Y,.X)
Q
OPTIONAL(CODE) ;
;changes the code into text
Q:CODE="" ""
Q:CODE="O" "optional"
Q:CODE="R" "required"
Q:CODE="C" "conditional"
Q:CODE="B" "obsolete"
Q:CODE="X" "N/A"
Q ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOPRSR3 8703 printed Dec 13, 2024@01:59:04 Page 2
HLOPRSR3 ;ALB/CJM - Visual Parser 12 JUN 1997 10:00 am ;08/29/2008
+1 ;;1.6;HEALTH LEVEL SEVEN;**138**;Oct 13, 1995;Build 34
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;
SETUP(PARMS,MSG,POS,SEG) ;
+1 NEW I,TMP,TOP,BOT,QUIT
+2 SET TMP=$GET(PARMS("ARY"))
+3 if '$LENGTH(TMP)
QUIT 0
+4 SET TOP=$GET(PARMS("TOP"))
+5 if 'TOP
QUIT 0
+6 SET BOT=$GET(PARMS("BOT"))
+7 if 'BOT
QUIT 0
+8 DO PREP^XGF
+9 ;D TEST^XGKB
+10 DO ENS^%ZISS
+11 Begin DoDot:1
+12 SET QUIT=1
+13 if '$LENGTH(IOXY)
QUIT
+14 if '$$TEST^DDBRT
QUIT
+15 SET QUIT=0
End DoDot:1
IF QUIT
WRITE !,"Sorry, your terminal is not configured to support this option!",!,"If working from a PC, you might try selecting a VT-series device type"
DO PAUSE^VALM1
QUIT 0
+16 SET IOTM=1
SET IOBM=IOSL-11
+17 IF (BOT-TOP)<100
Begin DoDot:1
+18 SET MSG="MSG"
End DoDot:1
+19 IF '$TEST
Begin DoDot:1
+20 SET MSG=$NAME(^TMP($JOB,"HLO MSG"))
End DoDot:1
+21 ;get msg from ListManager array
FOR I=TOP:1:BOT
SET @MSG@(I-TOP+1)=$GET(@TMP@(I,0))
+22 ;GET DELIMITERS
+23 SET FLD=$EXTRACT($GET(@MSG@(1)),4)
+24 SET DELIM=$PIECE($GET(@MSG@(1)),FLD,2)
+25 SET COMP=$EXTRACT(DELIM,1)
+26 SET REP=$EXTRACT(DELIM,2)
+27 SET ESC=$EXTRACT(DELIM,3)
+28 SET SUB=$EXTRACT(DELIM,4)
+29 SET DELIM=FLD_COMP_REP_SUB
+30 SET SEGTYPE=$EXTRACT($GET(@MSG@(1)),1,3)
+31 ;get version id
+32 Begin DoDot:1
+33 NEW HDR,FS,CS,SUBCOMP,ESCAPE
+34 SET FS=FLD
SET CS=COMP
SET SUBCOMP=SUB
SET ESCAPE=ESC
+35 SET I=0
+36 FOR
SET I=$ORDER(@MSG@(I))
if 'I
QUIT
if $GET(SEGLINE(I))>1
QUIT
SET HDR(I)=$GET(@MSG@(I))
+37 DO SPLITHDR^HLOSRVR1(.HDR)
+38 SET VERSION=$$DESCAPE^HLOPRS($PIECE($PIECE(HDR(2),FLD,7),COMP))
End DoDot:1
+39 SET I=0
+40 FOR
SET I=$ORDER(PARMS(I))
if 'I
QUIT
SET SEG(I)=PARMS(I)-TOP+1
SET SEGLINE(SEG(I))=I
+41 IF $$LINE(1)
IF $$X(1)
IF $$SEG(1)
+42 if $$FLD(0)
Begin DoDot:1
+43 ;
End DoDot:1
if $$REP(0)
Begin DoDot:1
End DoDot:1
if $$COMP(0)
Begin DoDot:1
End DoDot:1
if $$SUB(0)
Begin DoDot:1
End DoDot:1
+44 SET POS("TOP")=1
+45 SET POS("CURRENT DELIMITER")="1^0"
+46 SET POS("NEXT DELIMITER")="1^4"
+47 SET I=0
FOR
SET I=$ORDER(@MSG@(I))
if 'I
QUIT
if (I>IOBM)
QUIT
DO WRITELN^HLOPRSR1(I,I)
+48 DO IOXY(IOBM+1,1)
+49 WRITE IORVON," Q:quit ?:help [Up/Down/Left/Right Arrow]:navigation ",IORVOFF
+50 WRITE @IOSTBM
+51 DO DESCRIBE
+52 DO HILITE^HLOPRSR2(1,1,1,3)
+53 SET LASTPART(1)=1
SET LASTPART(1,1)=1
SET LASTPART(1,1,1)=1
+54 SET LASTPART(2)=1
SET LASTPART(2,1)=1
SET LASTPART(2,1,1)=1
+55 QUIT 1
+56 ;
DESCRIBE ;
+1 NEW I,MSG2,VAL
+2 SET DESCRIBE=$SELECT($GET(DESCRIBE)="MSG1":"MSG2",1:"MSG1")
+3 KILL @DESCRIBE
+4 SET OLD=$SELECT(DESCRIBE="MSG1":"MSG2",1:"MSG1")
+5 IF $LENGTH(SEGTYPE)
Begin DoDot:1
+6 IF $$GETSEG(.VAL,SEGTYPE,$GET(VERSION))
+7 SET @DESCRIBE@(1)=IOINHI_"Segment"_IOINORM_": #"_$$SEG_" "_SEGTYPE_" "_$$LJ(VAL("NAME"),50)
+8 if $$FLD<1
QUIT
+9 IF (SEGTYPE="MSH")!(SEGTYPE="BHS")
IF ($$FLD=1)!($$FLD=2)
Begin DoDot:2
+10 SET @DESCRIBE@(2)=" Field Separator: "_FLD
+11 SET @DESCRIBE@(3)=" Component Separator: "_COMP
+12 SET @DESCRIBE@(4)=" Repetition Separator: "_REP
+13 SET @DESCRIBE@(5)=" Escape Character: "_ESC
+14 SET @DESCRIBE@(6)=" Subcomponent Separator: "_SUB
End DoDot:2
+15 IF '$TEST
Begin DoDot:2
+16 NEW REPEAPT
+17 IF $$GETFLD(.VAL,SEGTYPE,$GET(VERSION),$$FLD)
+18 SET @DESCRIBE@(2)=IOINHI_" Field"_IOINORM_": #"_$$LJ($$FLD,3)_" "_$$LJ(VAL("NAME"),47)_$$LJ(" Repetition: #"_$$REP,7)
+19 SET REPEAT=VAL("REPETITION")
+20 SET REPEAT=$SELECT(REPEAT="False":"no",REPEAT="True":"yes",1:REPEAT)
+21 SET @DESCRIBE@(3)=" Repeating: "_$$LJ(REPEAT,4)_" MaxLength: "_$$LJ(VAL("MAX LENGTH"),5)_" Item #: "_$$LJ(VAL("ID"),6)
+22 ;remove 'optionality' for now, put it back in a future patch
+23 ;S @DESCRIBE@(4)=" DataType: "_$$LJ(VAL("DATA TYPE"),3)_" Optionality: "_$$LJ($$OPTIONAL(VAL("OPTIONALITY")),11)_" Table: "_$$LJ(VAL("TABLE"),4)
+24 SET @DESCRIBE@(4)=" DataType: "_$$LJ(VAL("DATA TYPE"),3)_" Table: "_$$LJ(VAL("TABLE"),4)
+25 Begin DoDot:3
+26 NEW NEXT
+27 SET NEXT=$EXTRACT($GET(@MSG@(+POS("NEXT DELIMITER"))),$PIECE(POS("NEXT DELIMITER"),"^",2))
+28 IF '$$GETCOMP(.VAL,SEGTYPE,$GET(VERSION),$$FLD,$$COMP)
IF $$COMP=1
IF NEXT'=SUB
IF NEXT'=COMP
QUIT
+29 SET @DESCRIBE@(5)=IOINHI_" Comp"_IOINORM_": #"_$$LJ($$COMP,4)_" "_$$LJ(VAL("NAME"),50)
+30 ;remove 'optionality' for now - put it back in a future patch
+31 ;S @DESCRIBE@(6)=" DataType: "_$$LJ(VAL("DATA TYPE"),3)_" Optionality: "_$$LJ($$OPTIONAL(VAL("OPTIONALITY")),11)_" Table: "_$$LJ(VAL("TABLE"),4)
+32 SET @DESCRIBE@(6)=" DataType: "_$$LJ(VAL("DATA TYPE"),3)_" Table: "_$$LJ(VAL("TABLE"),4)
+33 Begin DoDot:4
+34 IF '$$GETSUB(.VAL,SEGTYPE,$GET(VERSION),$$FLD,$$COMP,$$SUB)
IF $$SUB=1
IF $EXTRACT($GET(@MSG@(+POS("NEXT DELIMITER"))),$PIECE(POS("NEXT DELIMITER"),"^",2))'=SUB
QUIT
+35 SET @DESCRIBE@(7)=IOINHI_" Sub"_IOINORM_": #"_$$LJ($$SUB,21)_" "_$$LJ(VAL("NAME"),50)
+36 ;remove 'optionality for now, put it back in a future patch
+37 ;S @DESCRIBE@(8)=" DataType: "_$$LJ(VAL("DATA TYPE"),3)_" Optionality: "_$$LJ($$OPTIONAL(VAL("OPTIONALITY")),11)_" Table: "_$$LJ(VAL("TABLE"),4)
+38 SET @DESCRIBE@(8)=" DataType: "_$$LJ(VAL("DATA TYPE"),3)_" Table: "_$$LJ(VAL("TABLE"),4)
End DoDot:4
End DoDot:3
+39 IF $$FLD
Begin DoDot:3
+40 NEW VAL
+41 SET VAL=$$DESCAPE^HLOPRS1(VALUE,FLD,COMP,SUB,REP,ESC)
+42 SET @DESCRIBE@(10)=IOINHI_"Value"_IOINORM_": "_$SELECT(VAL="""""":""""" (NULL value)",1:$$LJ(VAL,73))
End DoDot:3
End DoDot:2
End DoDot:1
+43 IF '$TEST
Begin DoDot:1
+44 FOR I=1:1:10
SET @DESCRIBE@(I)=""
End DoDot:1
+45 FOR I=1:1:10
IF ($GET(@DESCRIBE@(I))="")!$GET(@DESCRIBE@(I))'=$GET(@OLD@(I))
DO IOXY(IOBM+I+1,1)
WRITE $$LJ($GET(@DESCRIBE@(I)),80)
+46 KILL @OLD
+47 QUIT
LJ(STRING,LENGTH) ;
+1 QUIT $$LJ^XLFSTR(STRING,LENGTH)
+2 ;
GETSEG(VALUE,SEG,VERSION) ;
+1 NEW NODE
+2 SET VALUE("NAME")=""
+3 SET SEGIEN=""
+4 if $LENGTH($GET(VERSION))
SET SEGIEN=$ORDER(^HLD(779.5,"C",SEG,VERSION,0))
+5 if 'SEGIEN
SET SEGIEN=$ORDER(^HLD(779.5,"B",SEG,999999),-1)
+6 if 'SEGIEN
QUIT 0
+7 SET NODE=$GET(^HLD(779.5,SEGIEN,0))
+8 SET VALUE("NAME")=$PIECE(NODE,"^",2)
+9 QUIT 1
GETFLD(VALUE,SEG,VERSION,FLD) ;
+1 KILL VALUES
+2 NEW NODE,SEGIEN,FLDIEN
+3 FOR NODE="NAME","DATA TYPE","MAX LENGTH","REPETITION","OPTIONALITY","TABLE","ID"
SET VALUE(NODE)=""
+4 SET SEGIEN=""
+5 if $LENGTH($GET(VERSION))
SET SEGIEN=$ORDER(^HLD(779.5,"C",SEG,VERSION,0))
+6 if 'SEGIEN
SET SEGIEN=$ORDER(^HLD(779.5,"B",SEG,999999),-1)
+7 if 'SEGIEN
QUIT 0
+8 SET FLDIEN=$ORDER(^HLD(779.5,SEGIEN,1,"B",FLD,0))
+9 if 'FLDIEN
QUIT 0
+10 SET NODE=$GET(^HLD(779.5,SEGIEN,1,FLDIEN,0))
+11 SET VALUE("NAME")=$PIECE(NODE,"^",2)
+12 SET VALUE("MAX LENGTH")=$PIECE(NODE,"^",3)
+13 SET VALUE("DATA TYPE")=$PIECE(NODE,"^",4)
+14 SET VALUE("OPTIONALITY")=$PIECE(NODE,"^",5)
+15 SET VALUE("REPETITION")=$PIECE(NODE,"^",6)
+16 SET VALUE("TABLE")=$PIECE(NODE,"^",7)
+17 SET VALUE("ID")=$PIECE(NODE,"^",8)
+18 QUIT 1
GETCOMP(VALUE,SEG,VERSION,FLD,COMP) ;
+1 KILL VALUES
+2 NEW NODE,SEGIEN,FLDIEN,COMPIEN
+3 FOR NODE="NAME","DATA TYPE","OPTIONALITY","TABLE"
SET VALUE(NODE)=""
+4 SET SEGIEN=""
+5 if $LENGTH($GET(VERSION))
SET SEGIEN=$ORDER(^HLD(779.5,"C",SEG,VERSION,0))
+6 if 'SEGIEN
SET SEGIEN=$ORDER(^HLD(779.5,"B",SEG,999999),-1)
+7 if 'SEGIEN
QUIT 0
+8 SET FLDIEN=$ORDER(^HLD(779.5,SEGIEN,1,"B",FLD,0))
+9 if 'FLDIEN
QUIT 0
+10 SET COMPIEN=$ORDER(^HLD(779.5,SEGIEN,1,FLDIEN,2,"B",COMP,0))
+11 if 'COMPIEN
QUIT 0
+12 SET NODE=$GET(^HLD(779.5,SEGIEN,1,FLDIEN,2,COMPIEN,0))
+13 SET VALUE("NAME")=$PIECE(NODE,"^",2)
+14 SET VALUE("DATA TYPE")=$PIECE(NODE,"^",3)
+15 SET VALUE("OPTIONALITY")=$PIECE(NODE,"^",4)
+16 SET VALUE("TABLE")=$PIECE(NODE,"^",7)
+17 QUIT 1
GETSUB(VALUE,SEG,VERSION,FLD,COMP,SUB) ;
+1 KILL VALUES
+2 NEW NODE,SEGIEN,FLDIEN,COMPIEN,SUBIEN
+3 FOR NODE="NAME","DATA TYPE","OPTIONALITY","TABLE"
SET VALUE(NODE)=""
+4 SET SEGIEN=""
+5 if $LENGTH($GET(VERSION))
SET SEGIEN=$ORDER(^HLD(779.5,"C",SEG,VERSION,0))
+6 if 'SEGIEN
SET SEGIEN=$ORDER(^HLD(779.5,"B",SEG,999999),-1)
+7 if 'SEGIEN
QUIT 0
+8 SET FLDIEN=$ORDER(^HLD(779.5,SEGIEN,1,"B",FLD,0))
+9 if 'FLDIEN
QUIT 0
+10 SET COMPIEN=$ORDER(^HLD(779.5,SEGIEN,1,FLDIEN,2,"B",COMP,0))
+11 if 'COMPIEN
QUIT 0
+12 SET SUBIEN=$ORDER(^HLD(779.5,SEGIEN,1,FLDIEN,2,COMPIEN,3,"B",SUB,0))
+13 if 'SUBIEN
QUIT 0
+14 SET NODE=$GET(^HLD(779.5,SEGIEN,1,FLDIEN,2,COMPIEN,3,SUBIEN,0))
+15 SET VALUE("NAME")=$PIECE(NODE,"^",2)
+16 SET VALUE("DATA TYPE")=$PIECE(NODE,"^",3)
+17 SET VALUE("OPTIONALITY")=$PIECE(NODE,"^",4)
+18 SET VALUE("TABLE")=$PIECE(NODE,"^",7)
+19 QUIT 1
HELP ;
+1 NEW I
+2 SET DESCRIBE="MSG1"
+3 KILL MSG1,MSG2
+4 SET MSG1(1)="Navigation Keys"
+5 SET MSG(2)=""
+6 SET MSG1(3)=IOINHI_"[Left Arrow] [Right Arrow]"_IOINORM_" : move left and right through a segment"
+7 SET MSG1(4)=IOINHI_"[Up Arrow] [Down Arrow]"_IOINORM_" : move up and down through the segments"
+8 SET MSG1(5)=IOINHI_"[Q]"_IOINORM_" : quit the parser"
+9 SET MSG1(6)=IOINHI_"[?]"_IOINORM_" : help for navigation keys"
+10 FOR I=1:1:10
DO IOXY(IOBM+I+1,1)
WRITE $$LJ($GET(MSG1(I)),80)
+11 DO IOXY($$Y(+POS("CURRENT DELIMITER")),$$X($PIECE(POS("CURRENT DELIMITER"),"^",2)))
+12 QUIT
+13 ;
LINE(TO,INC) ;msg line
+1 QUIT $$LINE^HLOPRSR1(.TO,.INC)
+2 ;
X(TO,INC) ;current position within the line
+1 ;
+2 QUIT $$X^HLOPRSR1(.TO,.INC)
Y(LINE) ;screen line of msg line = LINE
+1 QUIT $$Y^HLOPRSR1(.LINE)
SEG(INC) ;returns the current segement #
+1 QUIT $$SEG^HLOPRSR1(.INC)
FLD(SET) ;returns the currrent field #
+1 QUIT $$FLD^HLOPRSR1(.SET)
REP(SET) ;returns the current repetition #
+1 QUIT $$REP^HLOPRSR1(.SET)
COMP(SET) ;returns the current component #
+1 QUIT $$COMP^HLOPRSR1(.SET)
+2 ;
SUB(SET) ;returns the current sub-component #
+1 QUIT $$SUB^HLOPRSR1(.SET)
+2 ;
SEGSTART(SEGMENT) ;
+1 QUIT $$SEGSTART^HLOPRSR1(.SEGMENT)
+2 ;
IOXY(Y,X) ; moves to screen position line=Y, col=X
+1 DO IOXY^HLOPRSR1(.Y,.X)
+2 QUIT
OPTIONAL(CODE) ;
+1 ;changes the code into text
+2 if CODE=""
QUIT ""
+3 if CODE="O"
QUIT "optional"
+4 if CODE="R"
QUIT "required"
+5 if CODE="C"
QUIT "conditional"
+6 if CODE="B"
QUIT "obsolete"
+7 if CODE="X"
QUIT "N/A"
+8 QUIT ""
