OCXLOG1 ;SLC/RJS,CLA - Rule Display (Expert System - Data Field Frequency in OCXLog Report) ;8/04/98 16:01
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
S ;
;
K OCXTOTL,OCXPROG,OCXGETC,OCXGETN,OCXCOD2,OCXERR,OCXDF,OXCDFN
K OCXTOT,OCXNAM,OCXPARM,OCXPATH,OCXCON,OCXDPTR,OCXREC
K ^TMP("OCXDF",$J) S OCXWARN=0
S ^TMP("OCXDF",$J)=($P($H,",",2)+($H*86400)+(2*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
;
W !!," Generating Data Navigation code..." D WAIT^DICD
;
D S OCXDFN="" F S OCXDFN=$O(^OCXS(860.4,"B",OCXDFN)) Q:'$L(OCXDFN) D Q:OCXWARN
.Q S OCXDF=0 F S OCXDF=$O(^OCXS(860.4,"B",OCXDFN,OCXDF)) Q:'OCXDF D Q:OCXWARN
..I $D(^OCXS(860.4,OCXDF,0)) K OCXREC(4) M OCXREC(4)=^OCXS(860.4,OCXDF)
..E Q
..W:($X>60) ! W "."
..S OCXCON=0 F S OCXCON=$O(OCXREC(4,"LINK",OCXCON)) Q:'OCXCON D Q:OCXWARN
...S OCXWARN=0
...Q:$P($G(^OCXS(860.6,OCXCON,0)),U,3)
...S OCXCONN=$P($G(^OCXS(860.6,OCXCON,0)),U,1) I '$L(OCXCONN) D WARN^OCXOCMPV("Data context IEN #"_(+OCXCON)_" not defined in Data Context file...",4,OCXDF,$P($T(+1)," ",1)) Q
...S OCXCONA=$P($G(^OCXS(860.6,OCXCON,0)),U,2) I '$L(OCXCONA) D WARN^OCXOCMPV("Data context abbreviation for '"_OCXCONN_"' not defined in Data Context file...",4,OCXDF,$P($T(+1)," ",1)) Q
...S OCXCONS=OCXCONA
...S OCXTOTL(OCXCONS)=0
...W:($X>60) ! W "."
...;
...N OCXATT,OCXDTYP,OCXDTYPN,OCXERR,OCXGETC,OCXLNK,OCXNAM,OCXPARM,OCXPATH
...S OCXTOTL(OCXCONS,OCXDF)=0
...S OCXNAM=$P($G(OCXREC(4,0)),U,1) Q:'$L(OCXNAM)
...S OCXPATH=$G(OCXREC(4,"LINK",OCXCON,"DATAPATH")) I '$L(OCXPATH) D WARN^OCXOCMPV("Data Link-Path not defined",4,OCXDF,$P($T(+1)," ",1)) Q
...S OCXLNK=$O(^OCXS(863.3,"B",OCXPATH,0)) I 'OCXLNK D WARN^OCXOCMPV("Data Link-Path '"_OCXPATH_"' not defined in Meta-Dictionary Link file...",4,OCXDF,$P($T(+1)," ",1)) Q
...S OCXATT=$P($G(^OCXS(863.3,OCXLNK,0)),U,5) I 'OCXATT D WARN^OCXOCMPV("Data Link-Attribute '"_OCXPATH_"' ("_OCXLNK_") not defined in Meta-Dictionary Attribute file...",4,OCXDF,$P($T(+1)," ",1)) Q
...;
...S $P(OCXREC(4,0),U,3)=""
...F OCXPARM="OCXO EXTERNAL FUNCTION CALL","OCXO VARIABLE NAME","OCXO VT-BAR PIECE NUMBER","OCXO UP-ARROW PIECE NUMBER","OCXO SEMI-COLON PIECE NUMBER","OCXO HL7 SEGMENT ID","OCXO FILE POINTER" D
....Q:'$O(^OCXS(863.8,"B",OCXPARM,0))
....S OCXPARM(OCXPARM)=$$GETPARM(33,OCXPATH,OCXPARM)
....I '$L(OCXPARM(OCXPARM)) K OCXPARM(OCXPARM)
...S OCXDTYP=$$GETPARM(34,OCXATT,"DATA TYPE")
...I '$L(OCXDTYP) D WARN^OCXOCMPV("Data Link-Attribute '"_OCXPATH_"' Data Type not defined in Meta-Dictionary Attribute file...",4,OCXDF,$P($T(+1)," ",1)) Q
...S:'OCXDTYP OCXDTYP=$O(^OCXS(864.1,"B",OCXDTYP,0)) S OCXDTYPN=$P($G(^OCXS(864.1,+OCXDTYP,0)),U,1)
...I '$L(OCXDTYPN) D WARN^OCXOCMPV("Data Link-Attribute '"_OCXPATH_"' Data Type '"_OCXDTYP_"' not defined in Meta-Dictionary Data Type file...",4,OCXDF,$P($T(+1)," ",1)) Q
...;
...Q:$G(OCXERR) Q:OCXWARN
...;
...I '$L($G(OCXPARM("OCXO VARIABLE NAME"))) D Q
....D WARN^OCXOCMPV("Not enough information in the MetaDictionary link file to generate navigation code.",4,OCXDF,$P($T(+1)," ",1)) S OCXERR=1 Q
...S OCXDFV=OCXPARM("OCXO VARIABLE NAME")
...S OCXTOTL(OCXCONS,OCXDF,"VAR")=OCXDFV
...S OCXGETC="$G("_OCXDFV_")"
...;
...Q:OCXWARN
...;
...S:$L($G(OCXPARM("OCXO VT-BAR PIECE NUMBER"))) OCXGETC="$P("_OCXGETC_",""|"","_(OCXPARM("OCXO VT-BAR PIECE NUMBER")+1)_")"
...S:$G(OCXPARM("OCXO UP-ARROW PIECE NUMBER")) OCXGETC="$P("_OCXGETC_",""^"","_OCXPARM("OCXO UP-ARROW PIECE NUMBER")_")"
...S:$G(OCXPARM("OCXO SEMI-COLON PIECE NUMBER")) OCXGETC="$P("_OCXGETC_","";"","_OCXPARM("OCXO SEMI-COLON PIECE NUMBER")_")"
...;
...Q:'$L(OCXGETC)
...S OCXPROG(OCXCONS,OCXDF)=OCXGETC
...;
;
W !!," Scanning Data Log..." D WAIT^DICD
;
;
S OCXD0=0 F S OCXD0=$O(^OCXD(861,OCXD0)) Q:'OCXD0 D
.I $D(^OCXD(861,OCXD0,0)) K OCXREC M OCXREC=^OCXD(861,OCXD0)
.E Q
.W:($X>60) !,"...",+OCXREC(0),"..." W:'(OCXD0#10) "."
.S OCXCONS=$G(OCXREC("SOURCE")) Q:'$L(OCXCONS)
.;
.Q:'(OCXCONS="OEPS")
.;
.D I (OCXCONS="HL7") S OCXD0=0 F S OCXD0=$O(^OCXD(861,OCXCONS,OCXD0)) Q:'OCXD0 D
..Q N OCXODATA
..S OCXTOT=$G(OCXTOT)+1
..S OCXTOTL(OCXCONS)=$G(OCXTOTL(OCXCONS))+1
..K OCXODATA M OCXODATA=^OCXD(861,OCXCONS,OCXD0) D CONV(.OCXODATA)
..S OCXDF=0 F S OCXDF=$O(OCXPROG(OCXCONS,OCXDF)) Q:'OCXDF D
...X "S OCXX="_OCXPROG(OCXCONS,OCXDF)
...I $L(OCXX) S OCXTOTL(OCXCONS,OCXDF)=$G(OCXTOTL(OCXCONS,OCXDF))+1
...;
.;
.I '(OCXCONS="HL7") S OCXD0=0 F S OCXD0=$O(OCXREC("DATA",OCXD0)) Q:'OCXD0 D
..N OCXVAR,OCXVAL
..S OCXTOT=$G(OCXTOT)+1
..S OCXTOTL(OCXCONS)=$G(OCXTOTL(OCXCONS))+1
..S OCXVAR=$P($G(OCXREC("DATA",OCXD0,0)),"=",1)
..S OCXVAL=$P($G(OCXREC("DATA",OCXD0,0)),"=",2,999)
..W !,?10,OCXVAR," = ",OCXVAL R XXX:60 Q
..S @OCXVAR=OCXVAL
..S OCXDF=0 F S OCXDF=$O(OCXPROG(OCXCONS,OCXDF)) Q:'OCXDF D
...X "S OCXX="_OCXPROG(OCXCONS,OCXDF)
...I $L(OCXX) S OCXTOTL(OCXCONS,OCXDF)=$G(OCXTOTL(OCXCONS,OCXDF))+1
..K @OCXVAR
;
K IOP D ^%ZIS
;
U IO D W *12 D ^%ZISC
.S OCXCONS="" F S OCXCONS=$O(OCXTOTL(OCXCONS)) Q:'$L(OCXCONS) D Q:$$PAUSE
..W !!,OCXCONS," Data Field Frequency in OCXLog (",OCXTOTL(OCXCONS)," entries)",!
..S OCXDFN="" F S OCXDFN=$O(^OCXS(860.4,"B",OCXDFN)) Q:'$L(OCXDFN) D
...S OCXDF=0 F S OCXDF=$O(^OCXS(860.4,"B",OCXDFN,OCXDF)) Q:'OCXDF I $D(OCXTOTL(OCXCONS,OCXDF)) D
....W !,$J(OCXTOTL(OCXCONS,OCXDF),5)," ",OCXDFN," [",OCXDF,"] ",$G(OCXPROG(OCXCONS,OCXDF))
.W !!,$J(OCXTOT,5)," Total arrays scanned"
.;
Q
;
ARCNT(SUB) ;
I '$G(^OCXD(861,SUB)) Q 0
Q (+$G(^OCXD(861,OCXCONS))-$O(^OCXD(861,OCXCONS,0)))+1
;
UDEFPARM(PARM) ;
Q:$D(OCXPARM(PARM)) 0
D WARN^OCXOCMPV(" '"_PARM_"' parameter missing, in MetaDictionary link file.",4,OCXDF,$P($T(+1)," ",1)) Q 1
;
GETPARM(FILE,INST,PARM) ;
Q:'$L(FILE) "" Q:'$L(INST) "" Q:'$L(PARM) ""
N OCXP,OCXP1,OCXI,OCXTEMP,OCXGL
S OCXGL="^OCXS" S:(FILE=1) OCXGL="^OCXD" S:(FILE=7) OCXGL="^OCXD" S:(FILE=10) OCXGL="^OCXD"
S FILE=FILE/10+860
Q:'$D(@OCXGL@(+FILE,0)) ""
I (PARM=+PARM),$D(^OCXS(863.8,PARM,0)) S OCXP=PARM
E S OCXP=$O(^OCXS(863.8,"B",PARM,0))
Q:'OCXP ""
I (INST=+INST),$D(@OXCGL@(FILE,INST,0)) S OCXI=INST
E S OCXI=$O(@OCXGL@(FILE,"B",INST,0))
Q:'OCXI ""
M OCXTEMP=@OCXGL@(FILE,OCXI)
S OCXP1=$O(OCXTEMP("PAR","B",OCXP,0)) Q:'OCXP1 ""
Q $G(OCXTEMP("PAR",OCXP1,"VAL"))
;
PAUSE() Q:'($E(IOST,1)="C") 0
N ANS
W !," Press <return> to continue... " R ANS:DTIME E Q 1
Q (ANS[U)
;
CONV(ARRAY) ;
;
N TEMP,INDEX
M TEMP=ARRAY K ARRAY
K TEMP("TIMELOG"),TEMP(0)
S INDEX=0 F S INDEX=$O(TEMP(INDEX)) Q:'INDEX D
.N PC,SEG
.S SEG=$P(TEMP(INDEX),"|",1)
.F PC=2:1:$L(TEMP(INDEX),"|") S ARRAY(SEG,PC-1)=$P(TEMP(INDEX),"|",PC)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXLOG1 6839 printed Nov 22, 2024@17:34:35 Page 2
OCXLOG1 ;SLC/RJS,CLA - Rule Display (Expert System - Data Field Frequency in OCXLog Report) ;8/04/98 16:01
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
S ;
+1 ;
+2 KILL OCXTOTL,OCXPROG,OCXGETC,OCXGETN,OCXCOD2,OCXERR,OCXDF,OXCDFN
+3 KILL OCXTOT,OCXNAM,OCXPARM,OCXPATH,OCXCON,OCXDPTR,OCXREC
+4 KILL ^TMP("OCXDF",$JOB)
SET OCXWARN=0
+5 SET ^TMP("OCXDF",$JOB)=($PIECE($HOROLOG,",",2)+($HOROLOG*86400)+(2*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
+6 ;
+7 WRITE !!," Generating Data Navigation code..."
DO WAIT^DICD
+8 ;
+9 Begin DoDot:1
+10 QUIT
SET OCXDF=0
FOR
SET OCXDF=$ORDER(^OCXS(860.4,"B",OCXDFN,OCXDF))
if 'OCXDF
QUIT
Begin DoDot:2
+11 IF $DATA(^OCXS(860.4,OCXDF,0))
KILL OCXREC(4)
MERGE OCXREC(4)=^OCXS(860.4,OCXDF)
+12 IF '$TEST
QUIT
+13 if ($X>60)
WRITE !
WRITE "."
+14 SET OCXCON=0
FOR
SET OCXCON=$ORDER(OCXREC(4,"LINK",OCXCON))
if 'OCXCON
QUIT
Begin DoDot:3
+15 SET OCXWARN=0
+16 if $PIECE($GET(^OCXS(860.6,OCXCON,0)),U,3)
QUIT
+17 SET OCXCONN=$PIECE($GET(^OCXS(860.6,OCXCON,0)),U,1)
IF '$LENGTH(OCXCONN)
DO WARN^OCXOCMPV("Data context IEN #"_(+OCXCON)_" not defined in Data Context file...",4,OCXDF,$PIECE($TEXT(+1)," ",1))
QUIT
+18 SET OCXCONA=$PIECE($GET(^OCXS(860.6,OCXCON,0)),U,2)
IF '$LENGTH(OCXCONA)
DO WARN^OCXOCMPV("Data context abbreviation for '"_OCXCONN_"' not defined in Data Context file...",4,OCXDF,$PIECE($TEXT(+1)," ",1))
QUIT
+19 SET OCXCONS=OCXCONA
+20 SET OCXTOTL(OCXCONS)=0
+21 if ($X>60)
WRITE !
WRITE "."
+22 ;
+23 NEW OCXATT,OCXDTYP,OCXDTYPN,OCXERR,OCXGETC,OCXLNK,OCXNAM,OCXPARM,OCXPATH
+24 SET OCXTOTL(OCXCONS,OCXDF)=0
+25 SET OCXNAM=$PIECE($GET(OCXREC(4,0)),U,1)
if '$LENGTH(OCXNAM)
QUIT
+26 SET OCXPATH=$GET(OCXREC(4,"LINK",OCXCON,"DATAPATH"))
IF '$LENGTH(OCXPATH)
DO WARN^OCXOCMPV("Data Link-Path not defined",4,OCXDF,$PIECE($TEXT(+1)," ",1))
QUIT
+27 SET OCXLNK=$ORDER(^OCXS(863.3,"B",OCXPATH,0))
IF 'OCXLNK
DO WARN^OCXOCMPV("Data Link-Path '"_OCXPATH_"' not defined in Meta-Dictionary Link file...",4,OCXDF,$PIECE($TEXT(+1)," ",1))
QUIT
+28 SET OCXATT=$PIECE($GET(^OCXS(863.3,OCXLNK,0)),U,5)
IF 'OCXATT
DO WARN^OCXOCMPV("Data Link-Attribute '"_OCXPATH_"' ("_OCXLNK_") not defined in Meta-Dictionary Attribute file...",4,OCXDF,$PIECE($TEXT(+1)," ",1))
QUIT
+29 ;
+30 SET $PIECE(OCXREC(4,0),U,3)=""
+31 FOR OCXPARM="OCXO EXTERNAL FUNCTION CALL","OCXO VARIABLE NAME","OCXO VT-BAR PIECE NUMBER","OCXO UP-ARROW PIECE NUMBER","OCXO SEMI-COLON PIECE NUMBER","OCXO HL7 SEGMENT ID","OCXO FILE POINTER"
Begin DoDot:4
+32 if '$ORDER(^OCXS(863.8,"B",OCXPARM,0))
QUIT
+33 SET OCXPARM(OCXPARM)=$$GETPARM(33,OCXPATH,OCXPARM)
+34 IF '$LENGTH(OCXPARM(OCXPARM))
KILL OCXPARM(OCXPARM)
End DoDot:4
+35 SET OCXDTYP=$$GETPARM(34,OCXATT,"DATA TYPE")
+36 IF '$LENGTH(OCXDTYP)
DO WARN^OCXOCMPV("Data Link-Attribute '"_OCXPATH_"' Data Type not defined in Meta-Dictionary Attribute file...",4,OCXDF,$PIECE($TEXT(+1)," ",1))
QUIT
+37 if 'OCXDTYP
SET OCXDTYP=$ORDER(^OCXS(864.1,"B",OCXDTYP,0))
SET OCXDTYPN=$PIECE($GET(^OCXS(864.1,+OCXDTYP,0)),U,1)
+38 IF '$LENGTH(OCXDTYPN)
DO WARN^OCXOCMPV("Data Link-Attribute '"_OCXPATH_"' Data Type '"_OCXDTYP_"' not defined in Meta-Dictionary Data Type file...",4,OCXDF,$PIECE($TEXT(+1)," ",1))
QUIT
+39 ;
+40 if $GET(OCXERR)
QUIT
if OCXWARN
QUIT
+41 ;
+42 IF '$LENGTH($GET(OCXPARM("OCXO VARIABLE NAME")))
Begin DoDot:4
+43 DO WARN^OCXOCMPV("Not enough information in the MetaDictionary link file to generate navigation code.",4,OCXDF,$PIECE($TEXT(+1)," ",1))
SET OCXERR=1
QUIT
End DoDot:4
QUIT
+44 SET OCXDFV=OCXPARM("OCXO VARIABLE NAME")
+45 SET OCXTOTL(OCXCONS,OCXDF,"VAR")=OCXDFV
+46 SET OCXGETC="$G("_OCXDFV_")"
+47 ;
+48 if OCXWARN
QUIT
+49 ;
+50 if $LENGTH($GET(OCXPARM("OCXO VT-BAR PIECE NUMBER")))
SET OCXGETC="$P("_OCXGETC_",""|"","_(OCXPARM("OCXO VT-BAR PIECE NUMBER")+1)_")"
+51 if $GET(OCXPARM("OCXO UP-ARROW PIECE NUMBER"))
SET OCXGETC="$P("_OCXGETC_",""^"","_OCXPARM("OCXO UP-ARROW PIECE NUMBER")_")"
+52 if $GET(OCXPARM("OCXO SEMI-COLON PIECE NUMBER"))
SET OCXGETC="$P("_OCXGETC_","";"","_OCXPARM("OCXO SEMI-COLON PIECE NUMBER")_")"
+53 ;
+54 if '$LENGTH(OCXGETC)
QUIT
+55 SET OCXPROG(OCXCONS,OCXDF)=OCXGETC
+56 ;
End DoDot:3
if OCXWARN
QUIT
End DoDot:2
if OCXWARN
QUIT
End DoDot:1
SET OCXDFN=""
FOR
SET OCXDFN=$ORDER(^OCXS(860.4,"B",OCXDFN))
if '$LENGTH(OCXDFN)
QUIT
Begin DoDot:1
End DoDot:1
if OCXWARN
QUIT
+57 ;
+58 WRITE !!," Scanning Data Log..."
DO WAIT^DICD
+59 ;
+60 ;
+61 SET OCXD0=0
FOR
SET OCXD0=$ORDER(^OCXD(861,OCXD0))
if 'OCXD0
QUIT
Begin DoDot:1
+62 IF $DATA(^OCXD(861,OCXD0,0))
KILL OCXREC
MERGE OCXREC=^OCXD(861,OCXD0)
+63 IF '$TEST
QUIT
+64 if ($X>60)
WRITE !,"...",+OCXREC(0),"..."
if '(OCXD0#10)
WRITE "."
+65 SET OCXCONS=$GET(OCXREC("SOURCE"))
if '$LENGTH(OCXCONS)
QUIT
+66 ;
+67 if '(OCXCONS="OEPS")
QUIT
+68 ;
+69 Begin DoDot:2
+70 QUIT
NEW OCXODATA
+71 SET OCXTOT=$GET(OCXTOT)+1
+72 SET OCXTOTL(OCXCONS)=$GET(OCXTOTL(OCXCONS))+1
+73 KILL OCXODATA
MERGE OCXODATA=^OCXD(861,OCXCONS,OCXD0)
DO CONV(.OCXODATA)
+74 SET OCXDF=0
FOR
SET OCXDF=$ORDER(OCXPROG(OCXCONS,OCXDF))
if 'OCXDF
QUIT
Begin DoDot:3
+75 XECUTE "S OCXX="_OCXPROG(OCXCONS,OCXDF)
+76 IF $LENGTH(OCXX)
SET OCXTOTL(OCXCONS,OCXDF)=$GET(OCXTOTL(OCXCONS,OCXDF))+1
+77 ;
End DoDot:3
End DoDot:2
IF (OCXCONS="HL7")
SET OCXD0=0
FOR
SET OCXD0=$ORDER(^OCXD(861,OCXCONS,OCXD0))
if 'OCXD0
QUIT
Begin DoDot:2
End DoDot:2
+78 ;
+79 IF '(OCXCONS="HL7")
SET OCXD0=0
FOR
SET OCXD0=$ORDER(OCXREC("DATA",OCXD0))
if 'OCXD0
QUIT
Begin DoDot:2
+80 NEW OCXVAR,OCXVAL
+81 SET OCXTOT=$GET(OCXTOT)+1
+82 SET OCXTOTL(OCXCONS)=$GET(OCXTOTL(OCXCONS))+1
+83 SET OCXVAR=$PIECE($GET(OCXREC("DATA",OCXD0,0)),"=",1)
+84 SET OCXVAL=$PIECE($GET(OCXREC("DATA",OCXD0,0)),"=",2,999)
+85 WRITE !,?10,OCXVAR," = ",OCXVAL
READ XXX:60
QUIT
+86 SET @OCXVAR=OCXVAL
+87 SET OCXDF=0
FOR
SET OCXDF=$ORDER(OCXPROG(OCXCONS,OCXDF))
if 'OCXDF
QUIT
Begin DoDot:3
+88 XECUTE "S OCXX="_OCXPROG(OCXCONS,OCXDF)
+89 IF $LENGTH(OCXX)
SET OCXTOTL(OCXCONS,OCXDF)=$GET(OCXTOTL(OCXCONS,OCXDF))+1
End DoDot:3
+90 KILL @OCXVAR
End DoDot:2
End DoDot:1
+91 ;
+92 KILL IOP
DO ^%ZIS
+93 ;
+94 USE IO
Begin DoDot:1
+95 SET OCXCONS=""
FOR
SET OCXCONS=$ORDER(OCXTOTL(OCXCONS))
if '$LENGTH(OCXCONS)
QUIT
Begin DoDot:2
+96 WRITE !!,OCXCONS," Data Field Frequency in OCXLog (",OCXTOTL(OCXCONS)," entries)",!
+97 SET OCXDFN=""
FOR
SET OCXDFN=$ORDER(^OCXS(860.4,"B",OCXDFN))
if '$LENGTH(OCXDFN)
QUIT
Begin DoDot:3
+98 SET OCXDF=0
FOR
SET OCXDF=$ORDER(^OCXS(860.4,"B",OCXDFN,OCXDF))
if 'OCXDF
QUIT
IF $DATA(OCXTOTL(OCXCONS,OCXDF))
Begin DoDot:4
+99 WRITE !,$JUSTIFY(OCXTOTL(OCXCONS,OCXDF),5)," ",OCXDFN," [",OCXDF,"] ",$GET(OCXPROG(OCXCONS,OCXDF))
End DoDot:4
End DoDot:3
End DoDot:2
if $$PAUSE
QUIT
+100 WRITE !!,$JUSTIFY(OCXTOT,5)," Total arrays scanned"
+101 ;
End DoDot:1
WRITE *12
DO ^%ZISC
+102 QUIT
+103 ;
ARCNT(SUB) ;
+1 IF '$GET(^OCXD(861,SUB))
QUIT 0
+2 QUIT (+$GET(^OCXD(861,OCXCONS))-$ORDER(^OCXD(861,OCXCONS,0)))+1
+3 ;
UDEFPARM(PARM) ;
+1 if $DATA(OCXPARM(PARM))
QUIT 0
+2 DO WARN^OCXOCMPV(" '"_PARM_"' parameter missing, in MetaDictionary link file.",4,OCXDF,$PIECE($TEXT(+1)," ",1))
QUIT 1
+3 ;
GETPARM(FILE,INST,PARM) ;
+1 if '$LENGTH(FILE)
QUIT ""
if '$LENGTH(INST)
QUIT ""
if '$LENGTH(PARM)
QUIT ""
+2 NEW OCXP,OCXP1,OCXI,OCXTEMP,OCXGL
+3 SET OCXGL="^OCXS"
if (FILE=1)
SET OCXGL="^OCXD"
if (FILE=7)
SET OCXGL="^OCXD"
if (FILE=10)
SET OCXGL="^OCXD"
+4 SET FILE=FILE/10+860
+5 if '$DATA(@OCXGL@(+FILE,0))
QUIT ""
+6 IF (PARM=+PARM)
IF $DATA(^OCXS(863.8,PARM,0))
SET OCXP=PARM
+7 IF '$TEST
SET OCXP=$ORDER(^OCXS(863.8,"B",PARM,0))
+8 if 'OCXP
QUIT ""
+9 IF (INST=+INST)
IF $DATA(@OXCGL@(FILE,INST,0))
SET OCXI=INST
+10 IF '$TEST
SET OCXI=$ORDER(@OCXGL@(FILE,"B",INST,0))
+11 if 'OCXI
QUIT ""
+12 MERGE OCXTEMP=@OCXGL@(FILE,OCXI)
+13 SET OCXP1=$ORDER(OCXTEMP("PAR","B",OCXP,0))
if 'OCXP1
QUIT ""
+14 QUIT $GET(OCXTEMP("PAR",OCXP1,"VAL"))
+15 ;
PAUSE() if '($EXTRACT(IOST,1)="C")
QUIT 0
+1 NEW ANS
+2 WRITE !," Press <return> to continue... "
READ ANS:DTIME
IF '$TEST
QUIT 1
+3 QUIT (ANS[U)
+4 ;
CONV(ARRAY) ;
+1 ;
+2 NEW TEMP,INDEX
+3 MERGE TEMP=ARRAY
KILL ARRAY
+4 KILL TEMP("TIMELOG"),TEMP(0)
+5 SET INDEX=0
FOR
SET INDEX=$ORDER(TEMP(INDEX))
if 'INDEX
QUIT
Begin DoDot:1
+6 NEW PC,SEG
+7 SET SEG=$PIECE(TEMP(INDEX),"|",1)
+8 FOR PC=2:1:$LENGTH(TEMP(INDEX),"|")
SET ARRAY(SEG,PC-1)=$PIECE(TEMP(INDEX),"|",PC)
End DoDot:1
+9 QUIT
+10 ;
