- 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 Jan 18, 2025@03:00:19 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 ""