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

OCXOCMPR.m

Go to the documentation of this file.
  1. 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
  1. ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
  1. ;
  1. EN ;
  1. ;
  1. N CODE,D0,D1,IOP,LINLAB,NODE0
  1. ;
  1. D ^%ZIS Q:POP
  1. ;
  1. U IO S D0=0 F S D0=$O(^OCXS(860.8,D0)) Q:'D0 D
  1. .S NODE0=$G(^OCXS(860.8,D0,0)) Q:'$L(NODE0)
  1. .S LINLAB=$P(NODE0,U,2) Q:'$L(LINLAB)
  1. .W !!,$P(NODE0,U,1)
  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
  1. .W !,?5,CODE
  1. ;
  1. U IO W $C(12) D ^%ZISC
  1. ;
  1. Q
  1. ;
  1. DT(X,%DT) N Y D ^%DT Q +Y
  1. ;
  1. REPORT ;
  1. ;
  1. N FNAM S FNAM="" F S FNAM=$O(^OCXS(860.8,"C",FNAM)) Q:'$L(FNAM) D
  1. .N D0
  1. .S D0=0 F S D0=$O(^OCXS(860.8,"C",FNAM,D0)) Q:'D0 D
  1. ..N D1,OCXCALL,OCXHDR,OCXLAB,OCXREC M OCXREC=^OCXS(860.8,D0)
  1. ..S OCXLAB=$P(OCXREC(0),U,2),OCXHDR=""
  1. ..S D1=0 F S D1=$O(OCXREC("CODE",D1)) Q:'D1 D
  1. ...N OCXPC,OCXLINE S OCXLINE=OCXREC("CODE",D1,0)
  1. ...I (OCXLINE[(";"_OCXLAB_"(")) S OCXHDR=$P($P(OCXLINE,";",2),")",1)_")"
  1. ...I (OCXLINE["$$") F OCXPC=2:1:$L(OCXLINE,"$$") D
  1. ....N OCXFUNC,OCXPIEC
  1. ....S OCXPIEC=$P($P(OCXLINE,"$$",OCXPC),")",1)_")",OCXFUNC=$P(OCXPIEC,"(",1)
  1. ....S OCXCALL((OCXFUNC[U)+1,OCXFUNC)=OCXPIEC
  1. ..;
  1. ..W !!,OCXHDR," ;",D0,"; ",$P(OCXREC(0),U,1)
  1. ..S D1=0 F S D1=$O(OCXCALL(D1)) Q:'D1 D
  1. ...N D2 S D2="" F S D2=$O(OCXCALL(D1,D2)) Q:'$L(D2) D
  1. ....N OCXFUNC S OCXFUNC=OCXCALL(D1,D2)
  1. ....I '(D2[U) W !,?8,"Internal Call --> ",D2
  1. ....E W !,?5,"External Call --> ",OCXFUNC
  1. Q
  1. ;
  1. SCAN ;
  1. ;
  1. N OCXVAL,GLREF,COUNT,ANS
  1. W !!,"Enter value to scan for: " R OCXVAL:DTIME E Q
  1. S GLREF="^OCX" F COUNT=1:1 S GLREF=$Q(@GLREF) Q:'$L(GLREF) D
  1. .W:($X>70) ! W:'(COUNT#20) "."
  1. .I (@GLREF[OCXVAL) W !!,GLREF," = ",@GLREF," press <CR> to continue... " R ANS:DTIME W !
  1. Q
  1. ;
  1. ERROR ;
  1. Q
  1. ;