- 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 ;