OCXOCMPR ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Function Library Report and code edit) ;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
;
EN ;
;
N CODE,D0,D1,IOP,LINLAB,NODE0
;
D ^%ZIS Q:POP
;
U IO S D0=0 F S D0=$O(^OCXS(860.8,D0)) Q:'D0 D
.S NODE0=$G(^OCXS(860.8,D0,0)) Q:'$L(NODE0)
.S LINLAB=$P(NODE0,U,2) Q:'$L(LINLAB)
.W !!,$P(NODE0,U,1)
.S LINLAB=LINLAB_"(",D1=0 F S D1=$O(^OCXS(860.8,D0,"CODE",D1)) Q:'D1 I (^(D1,0)[LINLAB) S CODE=$P($P(^(0),";",2)," ",1) Q
.W !,?5,CODE
;
U IO W $C(12) D ^%ZISC
;
Q
;
DT(X,%DT) N Y D ^%DT Q +Y
;
REPORT ;
;
N FNAM S FNAM="" F S FNAM=$O(^OCXS(860.8,"C",FNAM)) Q:'$L(FNAM) D
.N D0
.S D0=0 F S D0=$O(^OCXS(860.8,"C",FNAM,D0)) Q:'D0 D
..N D1,OCXCALL,OCXHDR,OCXLAB,OCXREC M OCXREC=^OCXS(860.8,D0)
..S OCXLAB=$P(OCXREC(0),U,2),OCXHDR=""
..S D1=0 F S D1=$O(OCXREC("CODE",D1)) Q:'D1 D
...N OCXPC,OCXLINE S OCXLINE=OCXREC("CODE",D1,0)
...I (OCXLINE[(";"_OCXLAB_"(")) S OCXHDR=$P($P(OCXLINE,";",2),")",1)_")"
...I (OCXLINE["$$") F OCXPC=2:1:$L(OCXLINE,"$$") D
....N OCXFUNC,OCXPIEC
....S OCXPIEC=$P($P(OCXLINE,"$$",OCXPC),")",1)_")",OCXFUNC=$P(OCXPIEC,"(",1)
....S OCXCALL((OCXFUNC[U)+1,OCXFUNC)=OCXPIEC
..;
..W !!,OCXHDR," ;",D0,"; ",$P(OCXREC(0),U,1)
..S D1=0 F S D1=$O(OCXCALL(D1)) Q:'D1 D
...N D2 S D2="" F S D2=$O(OCXCALL(D1,D2)) Q:'$L(D2) D
....N OCXFUNC S OCXFUNC=OCXCALL(D1,D2)
....I '(D2[U) W !,?8,"Internal Call --> ",D2
....E W !,?5,"External Call --> ",OCXFUNC
Q
;
SCAN ;
;
N OCXVAL,GLREF,COUNT,ANS
W !!,"Enter value to scan for: " R OCXVAL:DTIME E Q
S GLREF="^OCX" F COUNT=1:1 S GLREF=$Q(@GLREF) Q:'$L(GLREF) D
.W:($X>70) ! W:'(COUNT#20) "."
.I (@GLREF[OCXVAL) W !!,GLREF," = ",@GLREF," press <CR> to continue... " R ANS:DTIME W !
Q
;
ERROR ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOCMPR 1906 printed Jan 18, 2025@03:26:14 Page 2
OCXOCMPR ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Function Library Report and code edit) ;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 ;
EN ;
+1 ;
+2 NEW CODE,D0,D1,IOP,LINLAB,NODE0
+3 ;
+4 DO ^%ZIS
if POP
QUIT
+5 ;
+6 USE IO
SET D0=0
FOR
SET D0=$ORDER(^OCXS(860.8,D0))
if 'D0
QUIT
Begin DoDot:1
+7 SET NODE0=$GET(^OCXS(860.8,D0,0))
if '$LENGTH(NODE0)
QUIT
+8 SET LINLAB=$PIECE(NODE0,U,2)
if '$LENGTH(LINLAB)
QUIT
+9 WRITE !!,$PIECE(NODE0,U,1)
+10 SET LINLAB=LINLAB_"("
SET D1=0
FOR
SET D1=$ORDER(^OCXS(860.8,D0,"CODE",D1))
if 'D1
QUIT
IF (^(D1,0)[LINLAB)
SET CODE=$PIECE($PIECE(^(0),";",2)," ",1)
QUIT
+11 WRITE !,?5,CODE
End DoDot:1
+12 ;
+13 USE IO
WRITE $CHAR(12)
DO ^%ZISC
+14 ;
+15 QUIT
+16 ;
DT(X,%DT) NEW Y
DO ^%DT
QUIT +Y
+1 ;
REPORT ;
+1 ;
+2 NEW FNAM
SET FNAM=""
FOR
SET FNAM=$ORDER(^OCXS(860.8,"C",FNAM))
if '$LENGTH(FNAM)
QUIT
Begin DoDot:1
+3 NEW D0
+4 SET D0=0
FOR
SET D0=$ORDER(^OCXS(860.8,"C",FNAM,D0))
if 'D0
QUIT
Begin DoDot:2
+5 NEW D1,OCXCALL,OCXHDR,OCXLAB,OCXREC
MERGE OCXREC=^OCXS(860.8,D0)
+6 SET OCXLAB=$PIECE(OCXREC(0),U,2)
SET OCXHDR=""
+7 SET D1=0
FOR
SET D1=$ORDER(OCXREC("CODE",D1))
if 'D1
QUIT
Begin DoDot:3
+8 NEW OCXPC,OCXLINE
SET OCXLINE=OCXREC("CODE",D1,0)
+9 IF (OCXLINE[(";"_OCXLAB_"("))
SET OCXHDR=$PIECE($PIECE(OCXLINE,";",2),")",1)_")"
+10 IF (OCXLINE["$$")
FOR OCXPC=2:1:$LENGTH(OCXLINE,"$$")
Begin DoDot:4
+11 NEW OCXFUNC,OCXPIEC
+12 SET OCXPIEC=$PIECE($PIECE(OCXLINE,"$$",OCXPC),")",1)_")"
SET OCXFUNC=$PIECE(OCXPIEC,"(",1)
+13 SET OCXCALL((OCXFUNC[U)+1,OCXFUNC)=OCXPIEC
End DoDot:4
End DoDot:3
+14 ;
+15 WRITE !!,OCXHDR," ;",D0,"; ",$PIECE(OCXREC(0),U,1)
+16 SET D1=0
FOR
SET D1=$ORDER(OCXCALL(D1))
if 'D1
QUIT
Begin DoDot:3
+17 NEW D2
SET D2=""
FOR
SET D2=$ORDER(OCXCALL(D1,D2))
if '$LENGTH(D2)
QUIT
Begin DoDot:4
+18 NEW OCXFUNC
SET OCXFUNC=OCXCALL(D1,D2)
+19 IF '(D2[U)
WRITE !,?8,"Internal Call --> ",D2
+20 IF '$TEST
WRITE !,?5,"External Call --> ",OCXFUNC
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
SCAN ;
+1 ;
+2 NEW OCXVAL,GLREF,COUNT,ANS
+3 WRITE !!,"Enter value to scan for: "
READ OCXVAL:DTIME
IF '$TEST
QUIT
+4 SET GLREF="^OCX"
FOR COUNT=1:1
SET GLREF=$QUERY(@GLREF)
if '$LENGTH(GLREF)
QUIT
Begin DoDot:1
+5 if ($X>70)
WRITE !
if '(COUNT#20)
WRITE "."
+6 IF (@GLREF[OCXVAL)
WRITE !!,GLREF," = ",@GLREF," press <CR> to continue... "
READ ANS:DTIME
WRITE !
End DoDot:1
+7 QUIT
+8 ;
ERROR ;
+1 QUIT
+2 ;
