OCXOCMPK ;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
;
RANGE(ROOT,ELEM,INDEX,PARAM,CD) ;
;
Q:$G(OCXWARN) 1
N OCXDTYP,FIELD,VARNDX,VARVAL,VARCNT,VSTRT,VSTOP
S FIELD=$P(PARAM," ",1),VSTRT=$P(PARAM," ",3),VSTOP=$P(PARAM," ",5)
S VARNDX="OCXLX"_(+INDEX),VARVAL="OCXLV"_(+INDEX),VARCNT="OCXLC"_(+INDEX),VARLIM="OCXLB"_(+INDEX)
;
I '$L($G(ROOT)) D WARN^OCXOCMPV("'RANGE' Function array root not defined.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
I '$L($G(ELEM)) D WARN^OCXOCMPV("'RANGE' Function element not defined.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
I ($L(PARAM," ")>5) D WARN^OCXOCMPV("'RANGE' Function with too many parameters.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
;
S FIELD=$P(PARAM," ",1) I '($E(FIELD,1)="|")!'($E(FIELD,$L(FIELD))="|") D Q OCXWARN
.D WARN^OCXOCMPV("'RANGE' Function field name missing in parameter list.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
S FIELD=+$P(FIELD,"|",2),OCXDTYP=$$GETDTYP^OCXOCMPI(FIELD)
;
I '$L(VSTRT) D Q OCXWARN
.D WARN^OCXOCMPV("'RANGE' Function start value missing in parameter list.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
I '$L(VSTOP) D Q OCXWARN
.D WARN^OCXOCMPV("'RANGE' Function stop value missing in parameter list.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
S VSTRT=""""_VSTRT_"""",VSTOP=""""_VSTOP_""""
I (OCXDTYP="DATE/TIME") S VSTRT="$$INT2DT("_VSTRT_")",VSTOP="$$INT2DT("_VSTOP_")"
;
S CD(1)="; RANGE"
S CD(2)="S "_VARVAL_"="_VSTRT_","_VARLIM_"="_VSTOP_" D K "_VARVAL_","_VARLIM_","_VARNDX
S CD(3)=".D:$L("_VARVAL_") F S "_VARVAL_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_","_VARVAL_")) Q:'$L("_VARVAL_") Q:("_VARVAL_"]"_VARLIM_") D"
S CD(4)="..S "_VARNDX_"="""" F S "_VARNDX_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_","_VARVAL_","_VARNDX_")) Q:'"_VARNDX_" D @@@@"
Q OCXWARN
;
ANY(ROOT,ELEM,INDEX,PARAM,CD) ;
;
N OCXDTYP
I '$L($G(ROOT)) D WARN^OCXOCMPV("'ANY' Function array root not defined.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
I '$L($G(ELEM)) D WARN^OCXOCMPV("'ANY' Function element not defined.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
I $L(PARAM) D WARN^OCXOCMPV("'ANY' Function does not require parameters.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
S VARNDX="OCXLX"_(+INDEX)
;
S CD(1)="; ANY"
S CD(2)="S "_(VARNDX)_"="""" F "_(VARNDX)_"=$O("_ROOT_"""C"","_ELEM_","_(VARNDX)_")) Q:'"_(VARNDX)_" D @@@@ K "_VARNDX
;
Q OCXWARN
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOCMPK 2516 printed Dec 13, 2024@02:24:56 Page 2
OCXOCMPK ;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 ;
RANGE(ROOT,ELEM,INDEX,PARAM,CD) ;
+1 ;
+2 if $GET(OCXWARN)
QUIT 1
+3 NEW OCXDTYP,FIELD,VARNDX,VARVAL,VARCNT,VSTRT,VSTOP
+4 SET FIELD=$PIECE(PARAM," ",1)
SET VSTRT=$PIECE(PARAM," ",3)
SET VSTOP=$PIECE(PARAM," ",5)
+5 SET VARNDX="OCXLX"_(+INDEX)
SET VARVAL="OCXLV"_(+INDEX)
SET VARCNT="OCXLC"_(+INDEX)
SET VARLIM="OCXLB"_(+INDEX)
+6 ;
+7 IF '$LENGTH($GET(ROOT))
DO WARN^OCXOCMPV("'RANGE' Function array root not defined.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT OCXWARN
+8 IF '$LENGTH($GET(ELEM))
DO WARN^OCXOCMPV("'RANGE' Function element not defined.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT OCXWARN
+9 IF ($LENGTH(PARAM," ")>5)
DO WARN^OCXOCMPV("'RANGE' Function with too many parameters.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT OCXWARN
+10 ;
+11 SET FIELD=$PIECE(PARAM," ",1)
IF '($EXTRACT(FIELD,1)="|")!'($EXTRACT(FIELD,$LENGTH(FIELD))="|")
Begin DoDot:1
+12 DO WARN^OCXOCMPV("'RANGE' Function field name missing in parameter list.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT OCXWARN
End DoDot:1
QUIT OCXWARN
+13 SET FIELD=+$PIECE(FIELD,"|",2)
SET OCXDTYP=$$GETDTYP^OCXOCMPI(FIELD)
+14 ;
+15 IF '$LENGTH(VSTRT)
Begin DoDot:1
+16 DO WARN^OCXOCMPV("'RANGE' Function start value missing in parameter list.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT OCXWARN
End DoDot:1
QUIT OCXWARN
+17 IF '$LENGTH(VSTOP)
Begin DoDot:1
+18 DO WARN^OCXOCMPV("'RANGE' Function stop value missing in parameter list.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT OCXWARN
End DoDot:1
QUIT OCXWARN
+19 SET VSTRT=""""_VSTRT_""""
SET VSTOP=""""_VSTOP_""""
+20 IF (OCXDTYP="DATE/TIME")
SET VSTRT="$$INT2DT("_VSTRT_")"
SET VSTOP="$$INT2DT("_VSTOP_")"
+21 ;
+22 SET CD(1)="; RANGE"
+23 SET CD(2)="S "_VARVAL_"="_VSTRT_","_VARLIM_"="_VSTOP_" D K "_VARVAL_","_VARLIM_","_VARNDX
+24 SET CD(3)=".D:$L("_VARVAL_") F S "_VARVAL_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_","_VARVAL_")) Q:'$L("_VARVAL_") Q:("_VARVAL_"]"_VARLIM_") D"
+25 SET CD(4)="..S "_VARNDX_"="""" F S "_VARNDX_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_","_VARVAL_","_VARNDX_")) Q:'"_VARNDX_" D @@@@"
+26 QUIT OCXWARN
+27 ;
ANY(ROOT,ELEM,INDEX,PARAM,CD) ;
+1 ;
+2 NEW OCXDTYP
+3 IF '$LENGTH($GET(ROOT))
DO WARN^OCXOCMPV("'ANY' Function array root not defined.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT OCXWARN
+4 IF '$LENGTH($GET(ELEM))
DO WARN^OCXOCMPV("'ANY' Function element not defined.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT OCXWARN
+5 IF $LENGTH(PARAM)
DO WARN^OCXOCMPV("'ANY' Function does not require parameters.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT OCXWARN
+6 SET VARNDX="OCXLX"_(+INDEX)
+7 ;
+8 SET CD(1)="; ANY"
+9 SET CD(2)="S "_(VARNDX)_"="""" F "_(VARNDX)_"=$O("_ROOT_"""C"","_ELEM_","_(VARNDX)_")) Q:'"_(VARNDX)_" D @@@@ K "_VARNDX
+10 ;
+11 QUIT OCXWARN
+12 ;
