Routine: OCXOCMPJ

OCXOCMPJ ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Build LIST Function Code cont...) ;10/29/98  12:37

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997

 ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998

LAST(ROOT,ELEM,INDEX,PARAM,CD) ;

 Q:$G(OCXWARN) 1

 N VARNDX,VARVAL,VARCNT,VARLIM

 I '$L($G(ROOT)) D WARN^OCXOCMPV("'LAST' Function array root not defined.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN

 I '$L($G(ELEM)) D WARN^OCXOCMPV("'LAST' Function element not defined.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN

 I ($L(PARAM," ")>4) D WARN^OCXOCMPV("'LAST' Function with too many parameters.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN

 S VARNDX="OCXLX"_(+INDEX),VARVAL="OCXLV"_(+INDEX),VARCNT="OCXLC"_(+INDEX),VARLIM="OCXLB"_(+INDEX)

 I '$O(CD(0)),'$L(PARAM) D                     ;  SIMPLE

.;

 .S CD(1)="; LAST SIMPLE"

 .S CD(2)="S "_VARNDX_"=$O("_ROOT_"""C"","_ELEM_",""""),-1) I "_VARNDX_" D @@@@ K "_VARNDX

 I '$O(CD(0)),($L(PARAM," ")=1),'($P(PARAM," ",1)=+$P(PARAM," ",1)) D              ;  FIELD NAME

 .N FIELD

 .S FIELD=$P(PARAM," ",1)

.;

 .I '($E(FIELD,1)="|")!'($E(FIELD,$L(FIELD))="|") D  Q

 ..D WARN^OCXOCMPV("'LAST' Function field name missing in parameter list.",2,OCXD0,$P($T(+1)," ",1)) Q

 .S FIELD=+$P(FIELD,"|",2)

.;

 .S CD(1)="; LAST FIELD NAME"

 .S CD(2)="S "_VARVAL_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_",""""),-1) I $L("_VARVAL_") D  K "_VARVAL

 .S CD(3)=".S "_VARNDX_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_","_VARVAL_","_VARNDX_",""""),-1) I "_VARNDX_" D @@@@ K "_VARNDX

 I '$O(CD(0)),($L(PARAM," ")=1),($P(PARAM," ",1)=+$P(PARAM," ",1)) D              ;  RANGE OF INSTANCES

.;

 .N VSTOP S VSTOP=+$P(PARAM," ",1)

.;

 .S CD(1)="; LAST RANGE OF INSTANCES"

 .S CD(2)="S "_VARNDX_"="""" D  K "_VARNDX

 .S CD(3)=".F "_VARCNT_"=1:1:"_VSTOP_" S "_VARNDX_"=$O("_ROOT_"""C"","_ELEM_","_VARNDX_"),-1) I "_VARNDX_" D @@@@"

 ;  FIELD NAME AND RANGE OF INSTANCES

 I '$O(CD(0)),($L(PARAM," ")=2),'($P(PARAM," ",1)=+$P(PARAM," ",1)),($P(PARAM," ",2)=+$P(PARAM," ",2)) D

 .N FIELD,VSTOP

 .S FIELD=$P(PARAM," ",1),VSTOP=+$P(PARAM," ",2)

.;

 .I '($E(FIELD,1)="|")!'($E(FIELD,$L(FIELD))="|") D  Q

 ..D WARN^OCXOCMPV("'LAST' Function field name missing in parameter list.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN

 .S FIELD=+$P(FIELD,"|",2)

.;

 .S CD(1)="; LAST FIELD NAME AND RANGE OF INSTANCES"

 .S CD(2)="S ("_VARVAL_","_VARNDX_")="""","_VARCNT_"="_VSTOP_" D  K "_VARVAL_","_VARNDX_","_VARCNT

 .S CD(3)=".F  Q:'("_VARCNT_")  S "_VARVAL_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_",""""),-1) Q:'$L("_VARVAL_")  D"

 .S CD(4)="..F  Q:'("_VARCNT_")  S "_VARNDX_"="""

 .S CD(4)=CD(4)_" S "_VARNDX_"=$O("_ROOT_"""D"","_ELEM_","_VARVAL_","_VARNDX_"),-1) I "_VARNDX_" S "_VARCNT_"="_VARCNT_"-1 D @@@@"

 I '$O(CD(0)) D WARN^OCXOCMPV("'LAST' Function with invalid parameter list.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN

 Q OCXWARN

FIRST(ROOT,ELEM,INDEX,PARAM,CD) ;

 Q:$G(OCXWARN) 1

 I '$L($G(ROOT)) D WARN^OCXOCMPV("'FIRST' Function array root not defined.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN

 I '$L($G(ELEM)) D WARN^OCXOCMPV("'FIRST' Function element not defined.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN

 I ($L(PARAM," ")>4) D WARN^OCXOCMPV("'FIRST' Function with too many parameters.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN

 S VARNDX="OCXLX"_(+INDEX),VARVAL="OCXLV"_(+INDEX),VARCNT="OCXLC"_(+INDEX),VARLIM="OCXLB"_(+INDEX)

 I '$O(CD(0)),'$L(PARAM) D                     ;  SIMPLE

.;

 .S CD(1)="; FIRST SIMPLE"

 .S CD(2)="S "_VARNDX_"=$O("_ROOT_"""C"","_ELEM_","""")) I "_VARNDX_" D @@@@ K "_VARNDX

 I '$O(CD(0)),($L(PARAM," ")=1),'($P(PARAM," ",1)=+$P(PARAM," ",1)) D              ;  FIELD NAME

 .N FIELD

 .S FIELD=$P(PARAM," ",1)

.;

 .I '($E(FIELD,1)="|")!'($E(FIELD,$L(FIELD))="|") D  Q

 ..D WARN^OCXOCMPV("'FIRST' Function field name missing in parameter list.",2,OCXD0,$P($T(+1)," ",1)) Q

 .S FIELD=+$P(FIELD,"|",2)

.;

 .S CD(1)="; FIRST FIELD NAME"

 .S CD(2)="S "_VARVAL_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_","""")) I $L("_VARVAL_") D  K "_VARVAL

 .S CD(3)=".S "_VARNDX_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_","_VARVAL_","_VARNDX_","""")) I "_VARNDX_" D @@@@ K "_VARNDX

 I '$O(CD(0)),($L(PARAM," ")=1),($P(PARAM," ",1)=+$P(PARAM," ",1)) D              ;  RANGE OF INSTANCES

.;

 .N VSTOP S VSTOP=+$P(PARAM," ",1)

.;

 .S CD(1)="; FIRST RANGE OF INSTANCES"

 .S CD(2)="S "_VARNDX_"="""" D  K "_VARNDX

 .S CD(3)=".F "_VARCNT_"=1:1:"_VSTOP_" S "_VARNDX_"=$O("_ROOT_"""C"","_ELEM_","_VARNDX_")) I "_VARNDX_" D @@@@"

 ;  FIELD NAME AND RANGE OF INSTANCES

 I '$O(CD(0)),($L(PARAM," ")=2),'($P(PARAM," ",1)=+$P(PARAM," ",1)),($P(PARAM," ",2)=+$P(PARAM," ",2)) D

 .N FIELD,VSTOP

 .S FIELD=$P(PARAM," ",1),VSTOP=+$P(PARAM," ",2)

.;

 .I '($E(FIELD,1)="|")!'($E(FIELD,$L(FIELD))="|") D  Q

 ..D WARN^OCXOCMPV("'FIRST' Function field name missing in parameter list.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN

 .S FIELD=+$P(FIELD,"|",2)

.;

 .S CD(1)="; FIRST FIELD NAME AND RANGE OF INSTANCES"

 .S CD(2)="S ("_VARVAL_","_VARNDX_")="""","_VARCNT_"="_VSTOP_" D  K "_VARVAL_","_VARNDX_","_VARCNT

 .S CD(3)=".F  Q:'("_VARCNT_")  S "_VARVAL_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_","""")) Q:'$L("_VARVAL_")  D"

 .S CD(4)="..F  Q:'("_VARCNT_")  S "_VARNDX_"="""

 .S CD(4)=CD(4)_" S "_VARNDX_"=$O("_ROOT_"""D"","_ELEM_","_VARVAL_","_VARNDX_")) I "_VARNDX_" S "_VARCNT_"="_VARCNT_"-1 D @@@@"

 I '$O(CD(0)) D WARN^OCXOCMPV("'FIRST' Function with invalid parameter list.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN

 Q OCXWARN

OCXOCMPJ  ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Build LIST Function Code cont...) ;10/29/98  12:37

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997

 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998

 +3       ;

 +4        QUIT

 +5       ;

LAST(ROOT,ELEM,INDEX,PARAM,CD) ;

 +1       ;

 +2        IF $GET(OCXWARN)

               QUIT 1

 +3       ;

 +4        NEW VARNDX,VARVAL,VARCNT,VARLIM

 +5        IF '$LENGTH($GET(ROOT))

               DO WARN^OCXOCMPV("'LAST' Function array root not defined.",2,OCXD0,$PIECE($TEXT(+1)," ",1))

               QUIT OCXWARN

 +6        IF '$LENGTH($GET(ELEM))

               DO WARN^OCXOCMPV("'LAST' Function element not defined.",2,OCXD0,$PIECE($TEXT(+1)," ",1))

               QUIT OCXWARN

 +7        IF ($LENGTH(PARAM," ")>4)

               DO WARN^OCXOCMPV("'LAST' Function with too many parameters.",2,OCXD0,$PIECE($TEXT(+1)," ",1))

               QUIT OCXWARN

 +8        SET VARNDX="OCXLX"_(+INDEX)

           SET VARVAL="OCXLV"_(+INDEX)

           SET VARCNT="OCXLC"_(+INDEX)

           SET VARLIM="OCXLB"_(+INDEX)

 +9       ;

 +10      ;  SIMPLE

           IF '$ORDER(CD(0))

               IF '$LENGTH(PARAM)

                   Begin DoDot:1

 +11      ;

 +12                   SET CD(1)="; LAST SIMPLE"

 +13                   SET CD(2)="S "_VARNDX_"=$O("_ROOT_"""C"","_ELEM_",""""),-1) I "_VARNDX_" D @@@@ K "_VARNDX

                   End DoDot:1

 +14      ;

 +15      ;  FIELD NAME

           IF '$ORDER(CD(0))

               IF ($LENGTH(PARAM," ")=1)

                   IF '($PIECE(PARAM," ",1)=+$PIECE(PARAM," ",1))

                       Begin DoDot:1

 +16                       NEW FIELD

 +17                       SET FIELD=$PIECE(PARAM," ",1)

 +18      ;

 +19                       IF '($EXTRACT(FIELD,1)="|")!'($EXTRACT(FIELD,$LENGTH(FIELD))="|")

                               Begin DoDot:2

 +20                               DO WARN^OCXOCMPV("'LAST' Function field name missing in parameter list.",2,OCXD0,$PIECE($TEXT(+1)," ",1))

                                   QUIT

                               End DoDot:2

                               QUIT

 +21                       SET FIELD=+$PIECE(FIELD,"|",2)

 +22      ;

 +23                       SET CD(1)="; LAST FIELD NAME"

 +24                       SET CD(2)="S "_VARVAL_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_",""""),-1) I $L("_VARVAL_") D  K "_VARVAL

 +25                       SET CD(3)=".S "_VARNDX_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_","_VARVAL_","_VARNDX_",""""),-1) I "_VARNDX_" D @@@@ K "_VARNDX

                       End DoDot:1

 +26      ;

 +27      ;  RANGE OF INSTANCES

           IF '$ORDER(CD(0))

               IF ($LENGTH(PARAM," ")=1)

                   IF ($PIECE(PARAM," ",1)=+$PIECE(PARAM," ",1))

                       Begin DoDot:1

 +28      ;

 +29                       NEW VSTOP

                           SET VSTOP=+$PIECE(PARAM," ",1)

 +30      ;

 +31                       SET CD(1)="; LAST RANGE OF INSTANCES"

 +32                       SET CD(2)="S "_VARNDX_"="""" D  K "_VARNDX

 +33                       SET CD(3)=".F "_VARCNT_"=1:1:"_VSTOP_" S "_VARNDX_"=$O("_ROOT_"""C"","_ELEM_","_VARNDX_"),-1) I "_VARNDX_" D @@@@"

                       End DoDot:1

 +34      ;

 +35      ;  FIELD NAME AND RANGE OF INSTANCES

 +36      ;

 +37       IF '$ORDER(CD(0))

               IF ($LENGTH(PARAM," ")=2)

                   IF '($PIECE(PARAM," ",1)=+$PIECE(PARAM," ",1))

                       IF ($PIECE(PARAM," ",2)=+$PIECE(PARAM," ",2))

                           Begin DoDot:1

 +38                           NEW FIELD,VSTOP

 +39                           SET FIELD=$PIECE(PARAM," ",1)

                               SET VSTOP=+$PIECE(PARAM," ",2)

 +40      ;

 +41                           IF '($EXTRACT(FIELD,1)="|")!'($EXTRACT(FIELD,$LENGTH(FIELD))="|")

                                   Begin DoDot:2

 +42                                   DO WARN^OCXOCMPV("'LAST' Function field name missing in parameter list.",2,OCXD0,$PIECE($TEXT(+1)," ",1))

                                       QUIT OCXWARN

                                   End DoDot:2

                                   QUIT

 +43                           SET FIELD=+$PIECE(FIELD,"|",2)

 +44      ;

 +45                           SET CD(1)="; LAST FIELD NAME AND RANGE OF INSTANCES"

 +46                           SET CD(2)="S ("_VARVAL_","_VARNDX_")="""","_VARCNT_"="_VSTOP_" D  K "_VARVAL_","_VARNDX_","_VARCNT

 +47                           SET CD(3)=".F  Q:'("_VARCNT_")  S "_VARVAL_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_",""""),-1) Q:'$L("_VARVAL_")  D"

 +48                           SET CD(4)="..F  Q:'("_VARCNT_")  S "_VARNDX_"="""

 +49                           SET CD(4)=CD(4)_" S "_VARNDX_"=$O("_ROOT_"""D"","_ELEM_","_VARVAL_","_VARNDX_"),-1) I "_VARNDX_" S "_VARCNT_"="_VARCNT_"-1 D @@@@"

                           End DoDot:1

 +50      ;

 +51       IF '$ORDER(CD(0))

               DO WARN^OCXOCMPV("'LAST' Function with invalid parameter list.",2,OCXD0,$PIECE($TEXT(+1)," ",1))

               QUIT OCXWARN

 +52      ;

 +53       QUIT OCXWARN

 +54      ;

FIRST(ROOT,ELEM,INDEX,PARAM,CD) ;

 +1       ;

 +2        IF $GET(OCXWARN)

               QUIT 1

 +3        IF '$LENGTH($GET(ROOT))

               DO WARN^OCXOCMPV("'FIRST' Function array root not defined.",2,OCXD0,$PIECE($TEXT(+1)," ",1))

               QUIT OCXWARN

 +4        IF '$LENGTH($GET(ELEM))

               DO WARN^OCXOCMPV("'FIRST' Function element not defined.",2,OCXD0,$PIECE($TEXT(+1)," ",1))

               QUIT OCXWARN

 +5        IF ($LENGTH(PARAM," ")>4)

               DO WARN^OCXOCMPV("'FIRST' Function with too many parameters.",2,OCXD0,$PIECE($TEXT(+1)," ",1))

               QUIT OCXWARN

 +6        SET VARNDX="OCXLX"_(+INDEX)

           SET VARVAL="OCXLV"_(+INDEX)

           SET VARCNT="OCXLC"_(+INDEX)

           SET VARLIM="OCXLB"_(+INDEX)

 +7       ;

 +8       ;  SIMPLE

           IF '$ORDER(CD(0))

               IF '$LENGTH(PARAM)

                   Begin DoDot:1

 +9       ;

 +10                   SET CD(1)="; FIRST SIMPLE"

 +11                   SET CD(2)="S "_VARNDX_"=$O("_ROOT_"""C"","_ELEM_","""")) I "_VARNDX_" D @@@@ K "_VARNDX

                   End DoDot:1

 +12      ;

 +13      ;  FIELD NAME

           IF '$ORDER(CD(0))

               IF ($LENGTH(PARAM," ")=1)

                   IF '($PIECE(PARAM," ",1)=+$PIECE(PARAM," ",1))

                       Begin DoDot:1

 +14                       NEW FIELD

 +15                       SET FIELD=$PIECE(PARAM," ",1)

 +16      ;

 +17                       IF '($EXTRACT(FIELD,1)="|")!'($EXTRACT(FIELD,$LENGTH(FIELD))="|")

                               Begin DoDot:2

 +18                               DO WARN^OCXOCMPV("'FIRST' Function field name missing in parameter list.",2,OCXD0,$PIECE($TEXT(+1)," ",1))

                                   QUIT

                               End DoDot:2

                               QUIT

 +19                       SET FIELD=+$PIECE(FIELD,"|",2)

 +20      ;

 +21                       SET CD(1)="; FIRST FIELD NAME"

 +22                       SET CD(2)="S "_VARVAL_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_","""")) I $L("_VARVAL_") D  K "_VARVAL

 +23                       SET CD(3)=".S "_VARNDX_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_","_VARVAL_","_VARNDX_","""")) I "_VARNDX_" D @@@@ K "_VARNDX

                       End DoDot:1

 +24      ;

 +25      ;  RANGE OF INSTANCES

           IF '$ORDER(CD(0))

               IF ($LENGTH(PARAM," ")=1)

                   IF ($PIECE(PARAM," ",1)=+$PIECE(PARAM," ",1))

                       Begin DoDot:1

 +26      ;

 +27                       NEW VSTOP

                           SET VSTOP=+$PIECE(PARAM," ",1)

 +28      ;

 +29                       SET CD(1)="; FIRST RANGE OF INSTANCES"

 +30                       SET CD(2)="S "_VARNDX_"="""" D  K "_VARNDX

 +31                       SET CD(3)=".F "_VARCNT_"=1:1:"_VSTOP_" S "_VARNDX_"=$O("_ROOT_"""C"","_ELEM_","_VARNDX_")) I "_VARNDX_" D @@@@"

                       End DoDot:1

 +32      ;

 +33      ;  FIELD NAME AND RANGE OF INSTANCES

 +34      ;

 +35       IF '$ORDER(CD(0))

               IF ($LENGTH(PARAM," ")=2)

                   IF '($PIECE(PARAM," ",1)=+$PIECE(PARAM," ",1))

                       IF ($PIECE(PARAM," ",2)=+$PIECE(PARAM," ",2))

                           Begin DoDot:1

 +36                           NEW FIELD,VSTOP

 +37                           SET FIELD=$PIECE(PARAM," ",1)

                               SET VSTOP=+$PIECE(PARAM," ",2)

 +38      ;

 +39                           IF '($EXTRACT(FIELD,1)="|")!'($EXTRACT(FIELD,$LENGTH(FIELD))="|")

                                   Begin DoDot:2

 +40                                   DO WARN^OCXOCMPV("'FIRST' Function field name missing in parameter list.",2,OCXD0,$PIECE($TEXT(+1)," ",1))

                                       QUIT OCXWARN

                                   End DoDot:2

                                   QUIT

 +41                           SET FIELD=+$PIECE(FIELD,"|",2)

 +42      ;

 +43                           SET CD(1)="; FIRST FIELD NAME AND RANGE OF INSTANCES"

 +44                           SET CD(2)="S ("_VARVAL_","_VARNDX_")="""","_VARCNT_"="_VSTOP_" D  K "_VARVAL_","_VARNDX_","_VARCNT

 +45                           SET CD(3)=".F  Q:'("_VARCNT_")  S "_VARVAL_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_","""")) Q:'$L("_VARVAL_")  D"

 +46                           SET CD(4)="..F  Q:'("_VARCNT_")  S "_VARNDX_"="""

 +47                           SET CD(4)=CD(4)_" S "_VARNDX_"=$O("_ROOT_"""D"","_ELEM_","_VARVAL_","_VARNDX_")) I "_VARNDX_" S "_VARCNT_"="_VARCNT_"-1 D @@@@"

                           End DoDot:1

 +48      ;

 +49       IF '$ORDER(CD(0))

               DO WARN^OCXOCMPV("'FIRST' Function with invalid parameter list.",2,OCXD0,$PIECE($TEXT(+1)," ",1))

               QUIT OCXWARN

 +50      ;

 +51       QUIT OCXWARN

OCXOCMPJ.m