source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXLOG1.m@ 1697

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
 ;