OCXOCONV ;SLC/RJS,CLA - EXPERT SYSTEM CONVERSION (PRE 1T13 -> 1T14) ;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 OCXOETIM,OCXTOT,OCXCUR,OCXX,OCXY,OCXZ
S OCXOETIM=$H
;
I '$D(^OCX) D BMES^XPDUTL(" The ^OCX global is missing, Conversion Aborted...") H 3 Q
;
F OCXZ="^OCXS","^OCXD" I $D(@OCXZ) D
.D BMES^XPDUTL(" Purging files in the "_OCXZ_" global...")
.S OCXX=0 F S OCXX=$O(@OCXZ@(OCXX)) Q:'OCXX D
..I $D(@OCXZ@(OCXX)) S OCXY=$P(@OCXZ@(OCXX,0),U,1,2) K @OCXZ@(OCXX) S @OCXZ@(OCXX,0)=OCXY
;
I $D(^OCX(10)) S OCXZ=$P(^OCX(10,0),U,1,2) D BMES^XPDUTL(" Purging the "_$P(OCXZ,U,1)_" file...") K ^OCX(10) S ^OCX(10,0)=OCXZ
;
D BMES^XPDUTL(" Initializing scan, One moment please...")
S OCXQUIT=0,GLREF="^OCX" F OCXTOT=0:1 S GLREF=$Q(@GLREF) Q:'$L(GLREF)
D BMES^XPDUTL(" Scanning ^OCX global for ^OCX( references...")
S OCXQUIT=0,GLREF="^OCX" F OCXCUR=0:1 S GLREF=$Q(@GLREF) Q:'$L(GLREF) D Q:OCXQUIT
.D:'(OCXCUR#10) STATUS(OCXCUR,OCXTOT)
.N GLVAL,DELIM
.S GLVAL=@GLREF
.Q:'(GLVAL["^OCX(")
.S GLVAL=$$CONV(GLVAL)
.S @GLREF=GLVAL
;
D STATUS(10,10)
H 1
D STATUS(0,10)
;
D BMES^XPDUTL(" Seperating ^OCX into ^OCXD and ^OCXS...")
D BMES^XPDUTL(" ^OCXD contains the 'Dynamic' files likely to shrink and grow...")
D BMES^XPDUTL(" ^OCXS contains the 'Static' files likely to remain the same size...")
D BMES^XPDUTL(" Initializing, One moment please...")
S OCXZ=0 F OCXTOT=0:1 S OCXZ=$O(^OCX(OCXZ)) Q:'OCXZ
D BMES^XPDUTL(" Scanning ^OCX global moving files")
S OCXZ=0 F OCXCUR=0:1 S OCXZ=$O(^OCX(OCXZ)) Q:'OCXZ D
.N NEWREF,OLDREF
.S OLDREF="^OCX("_OCXZ_")"
.S NEWREF=$$CONV("^OCX("_OCXZ)_")"
.M @NEWREF=@OLDREF
.D STATUS(OCXCUR,OCXTOT)
;
D STATUS(10,10)
H 1
D STATUS(0,10)
;
Q
CONV(V) ;
F Q:'(V["^OCX(") D
.N FILE,GL,NFILE
.S FILE=+$P($P(V,"^OCX(",2),",",1)
.;W !,"FILE: ",FILE
.S GL="^OCXS("
.S:(FILE=1) GL="^OCXD("
.S:(FILE=7) GL="^OCXD("
.S:(FILE=10) GL="^OCXD("
.S:(FILE="""LOG""") GL="^OCXD("
.S NFILE=0
.S:FILE NFILE=FILE/10+860 S:(FILE="""LOG""") NFILE=861
.I 'NFILE Q
.S V=$P(V,"^OCX("_FILE,1)_GL_NFILE_$P(V,"^OCX("_FILE,2,999)
;
Q V
;
DATE() N X,Y,%DT S X="N",%DT="T" D ^%DT X ^DD("DD") Q Y
;
DTCONV(Y) Q:'(Y["@") Y Q $P(Y,"@",1)_" at "_$P(Y,"@",2,99)
;
STATUS(CURRENT,XPDIDTOT) ;
;
I '$D(XPDIDVT) N XPDIDVT
S XPDIDVT=$G(XPDIDVT)
D UPDATE^XPDID(CURRENT)
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOCONV 2533 printed Apr 09, 2024@21:30:43 Page 2
OCXOCONV ;SLC/RJS,CLA - EXPERT SYSTEM CONVERSION (PRE 1T13 -> 1T14) ;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 OCXOETIM,OCXTOT,OCXCUR,OCXX,OCXY,OCXZ
+3 SET OCXOETIM=$HOROLOG
+4 ;
+5 IF '$DATA(^OCX)
DO BMES^XPDUTL(" The ^OCX global is missing, Conversion Aborted...")
HANG 3
QUIT
+6 ;
+7 FOR OCXZ="^OCXS","^OCXD"
IF $DATA(@OCXZ)
Begin DoDot:1
+8 DO BMES^XPDUTL(" Purging files in the "_OCXZ_" global...")
+9 SET OCXX=0
FOR
SET OCXX=$ORDER(@OCXZ@(OCXX))
if 'OCXX
QUIT
Begin DoDot:2
+10 IF $DATA(@OCXZ@(OCXX))
SET OCXY=$PIECE(@OCXZ@(OCXX,0),U,1,2)
KILL @OCXZ@(OCXX)
SET @OCXZ@(OCXX,0)=OCXY
End DoDot:2
End DoDot:1
+11 ;
+12 IF $DATA(^OCX(10))
SET OCXZ=$PIECE(^OCX(10,0),U,1,2)
DO BMES^XPDUTL(" Purging the "_$PIECE(OCXZ,U,1)_" file...")
KILL ^OCX(10)
SET ^OCX(10,0)=OCXZ
+13 ;
+14 DO BMES^XPDUTL(" Initializing scan, One moment please...")
+15 SET OCXQUIT=0
SET GLREF="^OCX"
FOR OCXTOT=0:1
SET GLREF=$QUERY(@GLREF)
if '$LENGTH(GLREF)
QUIT
+16 DO BMES^XPDUTL(" Scanning ^OCX global for ^OCX( references...")
+17 SET OCXQUIT=0
SET GLREF="^OCX"
FOR OCXCUR=0:1
SET GLREF=$QUERY(@GLREF)
if '$LENGTH(GLREF)
QUIT
Begin DoDot:1
+18 if '(OCXCUR#10)
DO STATUS(OCXCUR,OCXTOT)
+19 NEW GLVAL,DELIM
+20 SET GLVAL=@GLREF
+21 if '(GLVAL["^OCX(")
QUIT
+22 SET GLVAL=$$CONV(GLVAL)
+23 SET @GLREF=GLVAL
End DoDot:1
if OCXQUIT
QUIT
+24 ;
+25 DO STATUS(10,10)
+26 HANG 1
+27 DO STATUS(0,10)
+28 ;
+29 DO BMES^XPDUTL(" Seperating ^OCX into ^OCXD and ^OCXS...")
+30 DO BMES^XPDUTL(" ^OCXD contains the 'Dynamic' files likely to shrink and grow...")
+31 DO BMES^XPDUTL(" ^OCXS contains the 'Static' files likely to remain the same size...")
+32 DO BMES^XPDUTL(" Initializing, One moment please...")
+33 SET OCXZ=0
FOR OCXTOT=0:1
SET OCXZ=$ORDER(^OCX(OCXZ))
if 'OCXZ
QUIT
+34 DO BMES^XPDUTL(" Scanning ^OCX global moving files")
+35 SET OCXZ=0
FOR OCXCUR=0:1
SET OCXZ=$ORDER(^OCX(OCXZ))
if 'OCXZ
QUIT
Begin DoDot:1
+36 NEW NEWREF,OLDREF
+37 SET OLDREF="^OCX("_OCXZ_")"
+38 SET NEWREF=$$CONV("^OCX("_OCXZ)_")"
+39 MERGE @NEWREF=@OLDREF
+40 DO STATUS(OCXCUR,OCXTOT)
End DoDot:1
+41 ;
+42 DO STATUS(10,10)
+43 HANG 1
+44 DO STATUS(0,10)
+45 ;
+46 QUIT
CONV(V) ;
+1 FOR
if '(V["^OCX(")
QUIT
Begin DoDot:1
+2 NEW FILE,GL,NFILE
+3 SET FILE=+$PIECE($PIECE(V,"^OCX(",2),",",1)
+4 ;W !,"FILE: ",FILE
+5 SET GL="^OCXS("
+6 if (FILE=1)
SET GL="^OCXD("
+7 if (FILE=7)
SET GL="^OCXD("
+8 if (FILE=10)
SET GL="^OCXD("
+9 if (FILE="""LOG""")
SET GL="^OCXD("
+10 SET NFILE=0
+11 if FILE
SET NFILE=FILE/10+860
if (FILE="""LOG""")
SET NFILE=861
+12 IF 'NFILE
QUIT
+13 SET V=$PIECE(V,"^OCX("_FILE,1)_GL_NFILE_$PIECE(V,"^OCX("_FILE,2,999)
End DoDot:1
+14 ;
+15 QUIT V
+16 ;
DATE() NEW X,Y,%DT
SET X="N"
SET %DT="T"
DO ^%DT
XECUTE ^DD("DD")
QUIT Y
+1 ;
DTCONV(Y) if '(Y["@")
QUIT Y
QUIT $PIECE(Y,"@",1)_" at "_$PIECE(Y,"@",2,99)
+1 ;
STATUS(CURRENT,XPDIDTOT) ;
+1 ;
+2 IF '$DATA(XPDIDVT)
NEW XPDIDVT
+3 SET XPDIDVT=$GET(XPDIDVT)
+4 DO UPDATE^XPDID(CURRENT)
+5 ;
+6 QUIT
+7 ;
