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