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
;
Q
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOCMPJ 5550 printed Dec 13, 2024@02:24:55 Page 2
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
