Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLOPRSR3

HLOPRSR3.m

Go to the documentation of this file.
  1. 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
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;
  1. SETUP(PARMS,MSG,POS,SEG) ;
  1. N I,TMP,TOP,BOT,QUIT
  1. S TMP=$G(PARMS("ARY"))
  1. Q:'$L(TMP) 0
  1. S TOP=$G(PARMS("TOP"))
  1. Q:'TOP 0
  1. S BOT=$G(PARMS("BOT"))
  1. Q:'BOT 0
  1. D PREP^XGF
  1. ;D TEST^XGKB
  1. D ENS^%ZISS
  1. 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
  1. .S QUIT=1
  1. .Q:'$L(IOXY)
  1. .Q:'$$TEST^DDBRT
  1. .S QUIT=0
  1. S IOTM=1,IOBM=IOSL-11
  1. I (BOT-TOP)<100 D
  1. .S MSG="MSG"
  1. E D
  1. .S MSG=$NA(^TMP($J,"HLO MSG"))
  1. F I=TOP:1:BOT S @MSG@(I-TOP+1)=$G(@TMP@(I,0)) ;get msg from ListManager array
  1. ;GET DELIMITERS
  1. S FLD=$E($G(@MSG@(1)),4)
  1. S DELIM=$P($G(@MSG@(1)),FLD,2)
  1. S COMP=$E(DELIM,1)
  1. S REP=$E(DELIM,2)
  1. S ESC=$E(DELIM,3)
  1. S SUB=$E(DELIM,4)
  1. S DELIM=FLD_COMP_REP_SUB
  1. S SEGTYPE=$E($G(@MSG@(1)),1,3)
  1. ;get version id
  1. D
  1. .N HDR,FS,CS,SUBCOMP,ESCAPE
  1. .S FS=FLD,CS=COMP,SUBCOMP=SUB,ESCAPE=ESC
  1. .S I=0
  1. .F S I=$O(@MSG@(I)) Q:'I Q:$G(SEGLINE(I))>1 S HDR(I)=$G(@MSG@(I))
  1. .D SPLITHDR^HLOSRVR1(.HDR)
  1. .S VERSION=$$DESCAPE^HLOPRS($P($P(HDR(2),FLD,7),COMP))
  1. S I=0
  1. F S I=$O(PARMS(I)) Q:'I S SEG(I)=PARMS(I)-TOP+1,SEGLINE(SEG(I))=I
  1. I $$LINE(1),$$X(1),$$SEG(1)
  1. D:$$FLD(0) D:$$REP(0) D:$$COMP(0) D:$$SUB(0)
  1. .;
  1. S POS("TOP")=1
  1. S POS("CURRENT DELIMITER")="1^0"
  1. S POS("NEXT DELIMITER")="1^4"
  1. S I=0 F S I=$O(@MSG@(I)) Q:'I Q:(I>IOBM) D WRITELN^HLOPRSR1(I,I)
  1. D IOXY(IOBM+1,1)
  1. W IORVON," Q:quit ?:help [Up/Down/Left/Right Arrow]:navigation ",IORVOFF
  1. W @IOSTBM
  1. D DESCRIBE
  1. D HILITE^HLOPRSR2(1,1,1,3)
  1. S LASTPART(1)=1,LASTPART(1,1)=1,LASTPART(1,1,1)=1
  1. S LASTPART(2)=1,LASTPART(2,1)=1,LASTPART(2,1,1)=1
  1. Q 1
  1. ;
  1. DESCRIBE ;
  1. N I,MSG2,VAL
  1. S DESCRIBE=$S($G(DESCRIBE)="MSG1":"MSG2",1:"MSG1")
  1. K @DESCRIBE
  1. S OLD=$S(DESCRIBE="MSG1":"MSG2",1:"MSG1")
  1. I $L(SEGTYPE) D
  1. .I $$GETSEG(.VAL,SEGTYPE,$G(VERSION))
  1. .S @DESCRIBE@(1)=IOINHI_"Segment"_IOINORM_": #"_$$SEG_" "_SEGTYPE_" "_$$LJ(VAL("NAME"),50)
  1. .Q:$$FLD<1
  1. .I (SEGTYPE="MSH")!(SEGTYPE="BHS"),($$FLD=1)!($$FLD=2) D
  1. ..S @DESCRIBE@(2)=" Field Separator: "_FLD
  1. ..S @DESCRIBE@(3)=" Component Separator: "_COMP
  1. ..S @DESCRIBE@(4)=" Repetition Separator: "_REP
  1. ..S @DESCRIBE@(5)=" Escape Character: "_ESC
  1. ..S @DESCRIBE@(6)=" Subcomponent Separator: "_SUB
  1. .E D
  1. ..N REPEAPT
  1. ..I $$GETFLD(.VAL,SEGTYPE,$G(VERSION),$$FLD)
  1. ..S @DESCRIBE@(2)=IOINHI_" Field"_IOINORM_": #"_$$LJ($$FLD,3)_" "_$$LJ(VAL("NAME"),47)_$$LJ(" Repetition: #"_$$REP,7)
  1. ..S REPEAT=VAL("REPETITION")
  1. ..S REPEAT=$S(REPEAT="False":"no",REPEAT="True":"yes",1:REPEAT)
  1. ..S @DESCRIBE@(3)=" Repeating: "_$$LJ(REPEAT,4)_" MaxLength: "_$$LJ(VAL("MAX LENGTH"),5)_" Item #: "_$$LJ(VAL("ID"),6)
  1. ..;remove 'optionality' for now, put it back in a future patch
  1. ..;S @DESCRIBE@(4)=" DataType: "_$$LJ(VAL("DATA TYPE"),3)_" Optionality: "_$$LJ($$OPTIONAL(VAL("OPTIONALITY")),11)_" Table: "_$$LJ(VAL("TABLE"),4)
  1. ..S @DESCRIBE@(4)=" DataType: "_$$LJ(VAL("DATA TYPE"),3)_" Table: "_$$LJ(VAL("TABLE"),4)
  1. ..D
  1. ...N NEXT
  1. ...S NEXT=$E($G(@MSG@(+POS("NEXT DELIMITER"))),$P(POS("NEXT DELIMITER"),"^",2))
  1. ...I '$$GETCOMP(.VAL,SEGTYPE,$G(VERSION),$$FLD,$$COMP),$$COMP=1,NEXT'=SUB,NEXT'=COMP Q
  1. ...S @DESCRIBE@(5)=IOINHI_" Comp"_IOINORM_": #"_$$LJ($$COMP,4)_" "_$$LJ(VAL("NAME"),50)
  1. ...;remove 'optionality' for now - put it back in a future patch
  1. ...;S @DESCRIBE@(6)=" DataType: "_$$LJ(VAL("DATA TYPE"),3)_" Optionality: "_$$LJ($$OPTIONAL(VAL("OPTIONALITY")),11)_" Table: "_$$LJ(VAL("TABLE"),4)
  1. ...S @DESCRIBE@(6)=" DataType: "_$$LJ(VAL("DATA TYPE"),3)_" Table: "_$$LJ(VAL("TABLE"),4)
  1. ...D
  1. ....I '$$GETSUB(.VAL,SEGTYPE,$G(VERSION),$$FLD,$$COMP,$$SUB),$$SUB=1,$E($G(@MSG@(+POS("NEXT DELIMITER"))),$P(POS("NEXT DELIMITER"),"^",2))'=SUB Q
  1. ....S @DESCRIBE@(7)=IOINHI_" Sub"_IOINORM_": #"_$$LJ($$SUB,21)_" "_$$LJ(VAL("NAME"),50)
  1. ....;remove 'optionality for now, put it back in a future patch
  1. ....;S @DESCRIBE@(8)=" DataType: "_$$LJ(VAL("DATA TYPE"),3)_" Optionality: "_$$LJ($$OPTIONAL(VAL("OPTIONALITY")),11)_" Table: "_$$LJ(VAL("TABLE"),4)
  1. ....S @DESCRIBE@(8)=" DataType: "_$$LJ(VAL("DATA TYPE"),3)_" Table: "_$$LJ(VAL("TABLE"),4)
  1. ..I $$FLD D
  1. ...N VAL
  1. ...S VAL=$$DESCAPE^HLOPRS1(VALUE,FLD,COMP,SUB,REP,ESC)
  1. ...S @DESCRIBE@(10)=IOINHI_"Value"_IOINORM_": "_$S(VAL="""""":""""" (NULL value)",1:$$LJ(VAL,73))
  1. E D
  1. .F I=1:1:10 S @DESCRIBE@(I)=""
  1. 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)
  1. K @OLD
  1. Q
  1. LJ(STRING,LENGTH) ;
  1. Q $$LJ^XLFSTR(STRING,LENGTH)
  1. ;
  1. GETSEG(VALUE,SEG,VERSION) ;
  1. N NODE
  1. S VALUE("NAME")=""
  1. S SEGIEN=""
  1. S:$L($G(VERSION)) SEGIEN=$O(^HLD(779.5,"C",SEG,VERSION,0))
  1. S:'SEGIEN SEGIEN=$O(^HLD(779.5,"B",SEG,999999),-1)
  1. Q:'SEGIEN 0
  1. S NODE=$G(^HLD(779.5,SEGIEN,0))
  1. S VALUE("NAME")=$P(NODE,"^",2)
  1. Q 1
  1. GETFLD(VALUE,SEG,VERSION,FLD) ;
  1. K VALUES
  1. N NODE,SEGIEN,FLDIEN
  1. F NODE="NAME","DATA TYPE","MAX LENGTH","REPETITION","OPTIONALITY","TABLE","ID" S VALUE(NODE)=""
  1. S SEGIEN=""
  1. S:$L($G(VERSION)) SEGIEN=$O(^HLD(779.5,"C",SEG,VERSION,0))
  1. S:'SEGIEN SEGIEN=$O(^HLD(779.5,"B",SEG,999999),-1)
  1. Q:'SEGIEN 0
  1. S FLDIEN=$O(^HLD(779.5,SEGIEN,1,"B",FLD,0))
  1. Q:'FLDIEN 0
  1. S NODE=$G(^HLD(779.5,SEGIEN,1,FLDIEN,0))
  1. S VALUE("NAME")=$P(NODE,"^",2)
  1. S VALUE("MAX LENGTH")=$P(NODE,"^",3)
  1. S VALUE("DATA TYPE")=$P(NODE,"^",4)
  1. S VALUE("OPTIONALITY")=$P(NODE,"^",5)
  1. S VALUE("REPETITION")=$P(NODE,"^",6)
  1. S VALUE("TABLE")=$P(NODE,"^",7)
  1. S VALUE("ID")=$P(NODE,"^",8)
  1. Q 1
  1. GETCOMP(VALUE,SEG,VERSION,FLD,COMP) ;
  1. K VALUES
  1. N NODE,SEGIEN,FLDIEN,COMPIEN
  1. F NODE="NAME","DATA TYPE","OPTIONALITY","TABLE" S VALUE(NODE)=""
  1. S SEGIEN=""
  1. S:$L($G(VERSION)) SEGIEN=$O(^HLD(779.5,"C",SEG,VERSION,0))
  1. S:'SEGIEN SEGIEN=$O(^HLD(779.5,"B",SEG,999999),-1)
  1. Q:'SEGIEN 0
  1. S FLDIEN=$O(^HLD(779.5,SEGIEN,1,"B",FLD,0))
  1. Q:'FLDIEN 0
  1. S COMPIEN=$O(^HLD(779.5,SEGIEN,1,FLDIEN,2,"B",COMP,0))
  1. Q:'COMPIEN 0
  1. S NODE=$G(^HLD(779.5,SEGIEN,1,FLDIEN,2,COMPIEN,0))
  1. S VALUE("NAME")=$P(NODE,"^",2)
  1. S VALUE("DATA TYPE")=$P(NODE,"^",3)
  1. S VALUE("OPTIONALITY")=$P(NODE,"^",4)
  1. S VALUE("TABLE")=$P(NODE,"^",7)
  1. Q 1
  1. GETSUB(VALUE,SEG,VERSION,FLD,COMP,SUB) ;
  1. K VALUES
  1. N NODE,SEGIEN,FLDIEN,COMPIEN,SUBIEN
  1. F NODE="NAME","DATA TYPE","OPTIONALITY","TABLE" S VALUE(NODE)=""
  1. S SEGIEN=""
  1. S:$L($G(VERSION)) SEGIEN=$O(^HLD(779.5,"C",SEG,VERSION,0))
  1. S:'SEGIEN SEGIEN=$O(^HLD(779.5,"B",SEG,999999),-1)
  1. Q:'SEGIEN 0
  1. S FLDIEN=$O(^HLD(779.5,SEGIEN,1,"B",FLD,0))
  1. Q:'FLDIEN 0
  1. S COMPIEN=$O(^HLD(779.5,SEGIEN,1,FLDIEN,2,"B",COMP,0))
  1. Q:'COMPIEN 0
  1. S SUBIEN=$O(^HLD(779.5,SEGIEN,1,FLDIEN,2,COMPIEN,3,"B",SUB,0))
  1. Q:'SUBIEN 0
  1. S NODE=$G(^HLD(779.5,SEGIEN,1,FLDIEN,2,COMPIEN,3,SUBIEN,0))
  1. S VALUE("NAME")=$P(NODE,"^",2)
  1. S VALUE("DATA TYPE")=$P(NODE,"^",3)
  1. S VALUE("OPTIONALITY")=$P(NODE,"^",4)
  1. S VALUE("TABLE")=$P(NODE,"^",7)
  1. Q 1
  1. HELP ;
  1. N I
  1. S DESCRIBE="MSG1"
  1. K MSG1,MSG2
  1. S MSG1(1)="Navigation Keys"
  1. S MSG(2)=""
  1. S MSG1(3)=IOINHI_"[Left Arrow] [Right Arrow]"_IOINORM_" : move left and right through a segment"
  1. S MSG1(4)=IOINHI_"[Up Arrow] [Down Arrow]"_IOINORM_" : move up and down through the segments"
  1. S MSG1(5)=IOINHI_"[Q]"_IOINORM_" : quit the parser"
  1. S MSG1(6)=IOINHI_"[?]"_IOINORM_" : help for navigation keys"
  1. F I=1:1:10 D IOXY(IOBM+I+1,1) W $$LJ($G(MSG1(I)),80)
  1. D IOXY($$Y(+POS("CURRENT DELIMITER")),$$X($P(POS("CURRENT DELIMITER"),"^",2)))
  1. Q
  1. ;
  1. LINE(TO,INC) ;msg line
  1. Q $$LINE^HLOPRSR1(.TO,.INC)
  1. ;
  1. X(TO,INC) ;current position within the line
  1. ;
  1. Q $$X^HLOPRSR1(.TO,.INC)
  1. Y(LINE) ;screen line of msg line = LINE
  1. Q $$Y^HLOPRSR1(.LINE)
  1. SEG(INC) ;returns the current segement #
  1. Q $$SEG^HLOPRSR1(.INC)
  1. FLD(SET) ;returns the currrent field #
  1. Q $$FLD^HLOPRSR1(.SET)
  1. REP(SET) ;returns the current repetition #
  1. Q $$REP^HLOPRSR1(.SET)
  1. COMP(SET) ;returns the current component #
  1. Q $$COMP^HLOPRSR1(.SET)
  1. ;
  1. SUB(SET) ;returns the current sub-component #
  1. Q $$SUB^HLOPRSR1(.SET)
  1. ;
  1. SEGSTART(SEGMENT) ;
  1. Q $$SEGSTART^HLOPRSR1(.SEGMENT)
  1. ;
  1. IOXY(Y,X) ; moves to screen position line=Y, col=X
  1. D IOXY^HLOPRSR1(.Y,.X)
  1. Q
  1. OPTIONAL(CODE) ;
  1. ;changes the code into text
  1. Q:CODE="" ""
  1. Q:CODE="O" "optional"
  1. Q:CODE="R" "required"
  1. Q:CODE="C" "conditional"
  1. Q:CODE="B" "obsolete"
  1. Q:CODE="X" "N/A"
  1. Q ""