OCXDIAG ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC UTILITY ROUTINE ;SEP 7,1999 at 10:30
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
S ;
;
N QUIT,LINE,TEXT,REMOTE,LOCAL,D0,OPCODE,REF,OCXFLGA,OCXFLGC,OCXFLGR,OCXFLGD S QUIT=0
;
D DOT
I $L($T(VERSION^OCXOCMP)),($$VERSION^OCXOCMP="ORDER CHECK EXPERT version 1.01 released OCT 29,1998"),1
E D Q
.W !
.W !,"Diagnostic aborted, version mismatch."
.W !,"Current Local version: ",$$VERSION^OCXOCMP
.W !," Diagnostic Version: ORDER CHECK EXPERT version 1.01 released OCT 29,1998"
I '$D(DTIME) W !!,"DTIME not defined !!",!! Q
W !!,"Order Check Expert System Diagnostic Tool"
W !," Created: SEP 7,1999 at 10:30 in UCI: OEX,OER"
W !," Current Date: ",$$NOW^OCXDI0," Current UCI: ",$$CUCI^OCXBDT,!!
S LASTFILE=0 K ^TMP("OCXDIAG",$J)
S ^TMP("OCXDIAG",$J)=($P($H,",",2)+($H*86400)+(4*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
S (OCXFLGR,OCXFLGC,OCXFLGA)=1
S OCXFLGC=$$READ^OCXDI2("Y"," Do you want ^OCXDIAG to fix differences ?","YES") Q:(OCXFLGC[U)
I OCXFLGC S OCXFLGA=$$READ^OCXDI2("Y"," Do you want to stop and ask before each change ?","YES") Q:(OCXFLGA[U)
S OCXFLGD=$$READ^OCXDI2("Y"," Do you want ^OCXDIAG to check for extra local records ?","NO") Q:(OCXFLGD[U)
;
RUN ;
;
; OCXFLGR = 0-> NO REPORT 1-> REPORT
; OCXFLGA = 0-> NO ASK 1-> ASK
; OCXFLGC = 0-> NO CHANGE 1-> CHANGE
; OCXFLGD = 0-> NO CHECK FOR EXTRAS 1-> CHECK
;
D MESG("Loading Data ") D ^OCXDI001
;
S LINE=0 F S LINE=$O(^TMP("OCXDIAG",$J,LINE)) Q:'LINE D Q:QUIT
.D:'(LINE#50) STATUS^OCXOPOST(LINE,$O(^TMP("OCXDIAG",$J," "),-1))
.S TEXT=$G(^TMP("OCXDIAG",$J,LINE)) I $L(TEXT) D Q:QUIT
..S TEXT=$P(TEXT,";",2,999),OPCODE=$P(TEXT,U,1),TEXT=$P(TEXT,U,2,999)
..;
..I OPCODE="RTN" K RSUM S RSUM(0)=TEXT Q
..I OPCODE="RSUM" S RSUM($O(RSUM(""),-1)+1)=TEXT Q
..I OPCODE="RND" S QUIT=$$RTN^OCXDI0(.RSUM) Q
..I OPCODE="REND" K RSUM D MESG("Scanning Data Files ") Q
..I OPCODE="RSTRT" D MESG("Scanning Routines ") Q
..I OPCODE="KEY" D DOT S LOCAL="",D0=$$GETFILE^OCXDI0(+$P(TEXT,U,1),$P(TEXT,U,2),.LOCAL) S QUIT=(D0=(-10)) Q
..I OPCODE="R" S REF="REMOTE("_$P($P(TEXT,U,1),":",1)_":"_D0_$P($P(TEXT,U,1),":",2,99)_")" Q
..I OPCODE="D",$D(REF) S @REF=$P(TEXT,U,1,999) K REF Q
..;
..I OPCODE="EOR" S QUIT=$$COMPARE^OCXDI1(.LOCAL,.REMOTE) K LOCAL,REMOTE Q
..I OPCODE="EOF" S QUIT=$$LISTFILE^OCXDI0(U_$P(TEXT,U,1),(+$P(TEXT,U,2)&OCXFLGD)) K LOCAL,REMOTE Q
..I OPCODE="SOF" D MESG(" Scanning '"_(TEXT)_"' file ") S:(('OCXFLGA)&(+TEXT=101.41)) OCXFLGC=0 Q
..I OPCODE="ROOT" D Q
...N FILE,DATA
...S FILE=U_$P(TEXT,U,1),DATA=$P(TEXT,U,2,3)
...Q:$D(@FILE)
...S @FILE=DATA
...D MESG(" Restoring file #"_(+$P(DATA,U,2))_" zero node")
..;
..W !,"Unknown OpCode: ",OPCODE," in: ",TEXT S QUIT=$$PAUSE^OCXDI0 W !
;
D MESG("Checking protocols ") Q:$$EN^OCXDI5
;
K ^TMP("OCXDIAG",$J)
;
D MESG("Diagnostic Finished...")
;
Q
;
AUTO ;
;
N QUIT,LINE,TEXT,REMOTE,LOCAL,D0,OPCODE,REF,OCXFLGA,OCXFLGC,OCXFLGR,OCXFLGD S QUIT=0
;
S LASTFILE=0 K ^TMP("OCXDIAG",$J)
S ^TMP("OCXDIAG",$J)=($P($H,",",2)+($H*86400)+(4*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
S (OCXFLGD,OCXFLGA,OCXFLGR)=0,(OCXAUTO,OCXFLGC)=1
;
D MESG(" ")
D MESG("Order Check Expert System Diagnostic Tool")
D MESG(" Created: SEP 7,1999 at 10:30 in UCI: OEX,OER")
D MESG(" Current Date: "_($$NOW^OCXDI0)_" Current UCI: "_($$CUCI^OCXBDT))
D MESG(" ")
D MESG(" ")
;
D RUN
;
Q
;
MESG(X) ;
;
I '$G(OCXAUTO) W !,X
E D BMES^XPDUTL(.X)
Q
;
;
DOT Q:$G(OCXAUTO) W:($X>70) ! W " ." Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXDIAG 3709 printed Apr 09, 2024@21:43:15 Page 2
OCXDIAG ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC UTILITY ROUTINE ;SEP 7,1999 at 10:30
+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 NEW QUIT,LINE,TEXT,REMOTE,LOCAL,D0,OPCODE,REF,OCXFLGA,OCXFLGC,OCXFLGR,OCXFLGD
SET QUIT=0
+3 ;
+4 DO DOT
+5 IF $LENGTH($TEXT(VERSION^OCXOCMP))
IF ($$VERSION^OCXOCMP="ORDER CHECK EXPERT version 1.01 released OCT 29,1998")
IF 1
+6 IF '$TEST
Begin DoDot:1
+7 WRITE !
+8 WRITE !,"Diagnostic aborted, version mismatch."
+9 WRITE !,"Current Local version: ",$$VERSION^OCXOCMP
+10 WRITE !," Diagnostic Version: ORDER CHECK EXPERT version 1.01 released OCT 29,1998"
End DoDot:1
QUIT
+11 IF '$DATA(DTIME)
WRITE !!,"DTIME not defined !!",!!
QUIT
+12 WRITE !!,"Order Check Expert System Diagnostic Tool"
+13 WRITE !," Created: SEP 7,1999 at 10:30 in UCI: OEX,OER"
+14 WRITE !," Current Date: ",$$NOW^OCXDI0," Current UCI: ",$$CUCI^OCXBDT,!!
+15 SET LASTFILE=0
KILL ^TMP("OCXDIAG",$JOB)
+16 SET ^TMP("OCXDIAG",$JOB)=($PIECE($HOROLOG,",",2)+($HOROLOG*86400)+(4*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
+17 SET (OCXFLGR,OCXFLGC,OCXFLGA)=1
+18 SET OCXFLGC=$$READ^OCXDI2("Y"," Do you want ^OCXDIAG to fix differences ?","YES")
if (OCXFLGC[U)
QUIT
+19 IF OCXFLGC
SET OCXFLGA=$$READ^OCXDI2("Y"," Do you want to stop and ask before each change ?","YES")
if (OCXFLGA[U)
QUIT
+20 SET OCXFLGD=$$READ^OCXDI2("Y"," Do you want ^OCXDIAG to check for extra local records ?","NO")
if (OCXFLGD[U)
QUIT
+21 ;
RUN ;
+1 ;
+2 ; OCXFLGR = 0-> NO REPORT 1-> REPORT
+3 ; OCXFLGA = 0-> NO ASK 1-> ASK
+4 ; OCXFLGC = 0-> NO CHANGE 1-> CHANGE
+5 ; OCXFLGD = 0-> NO CHECK FOR EXTRAS 1-> CHECK
+6 ;
+7 DO MESG("Loading Data ")
DO ^OCXDI001
+8 ;
+9 SET LINE=0
FOR
SET LINE=$ORDER(^TMP("OCXDIAG",$JOB,LINE))
if 'LINE
QUIT
Begin DoDot:1
+10 if '(LINE#50)
DO STATUS^OCXOPOST(LINE,$ORDER(^TMP("OCXDIAG",$JOB," "),-1))
+11 SET TEXT=$GET(^TMP("OCXDIAG",$JOB,LINE))
IF $LENGTH(TEXT)
Begin DoDot:2
+12 SET TEXT=$PIECE(TEXT,";",2,999)
SET OPCODE=$PIECE(TEXT,U,1)
SET TEXT=$PIECE(TEXT,U,2,999)
+13 ;
+14 IF OPCODE="RTN"
KILL RSUM
SET RSUM(0)=TEXT
QUIT
+15 IF OPCODE="RSUM"
SET RSUM($ORDER(RSUM(""),-1)+1)=TEXT
QUIT
+16 IF OPCODE="RND"
SET QUIT=$$RTN^OCXDI0(.RSUM)
QUIT
+17 IF OPCODE="REND"
KILL RSUM
DO MESG("Scanning Data Files ")
QUIT
+18 IF OPCODE="RSTRT"
DO MESG("Scanning Routines ")
QUIT
+19 IF OPCODE="KEY"
DO DOT
SET LOCAL=""
SET D0=$$GETFILE^OCXDI0(+$PIECE(TEXT,U,1),$PIECE(TEXT,U,2),.LOCAL)
SET QUIT=(D0=(-10))
QUIT
+20 IF OPCODE="R"
SET REF="REMOTE("_$PIECE($PIECE(TEXT,U,1),":",1)_":"_D0_$PIECE($PIECE(TEXT,U,1),":",2,99)_")"
QUIT
+21 IF OPCODE="D"
IF $DATA(REF)
SET @REF=$PIECE(TEXT,U,1,999)
KILL REF
QUIT
+22 ;
+23 IF OPCODE="EOR"
SET QUIT=$$COMPARE^OCXDI1(.LOCAL,.REMOTE)
KILL LOCAL,REMOTE
QUIT
+24 IF OPCODE="EOF"
SET QUIT=$$LISTFILE^OCXDI0(U_$PIECE(TEXT,U,1),(+$PIECE(TEXT,U,2)&OCXFLGD))
KILL LOCAL,REMOTE
QUIT
+25 IF OPCODE="SOF"
DO MESG(" Scanning '"_(TEXT)_"' file ")
if (('OCXFLGA)&(+TEXT=101.41))
SET OCXFLGC=0
QUIT
+26 IF OPCODE="ROOT"
Begin DoDot:3
+27 NEW FILE,DATA
+28 SET FILE=U_$PIECE(TEXT,U,1)
SET DATA=$PIECE(TEXT,U,2,3)
+29 if $DATA(@FILE)
QUIT
+30 SET @FILE=DATA
+31 DO MESG(" Restoring file #"_(+$PIECE(DATA,U,2))_" zero node")
End DoDot:3
QUIT
+32 ;
+33 WRITE !,"Unknown OpCode: ",OPCODE," in: ",TEXT
SET QUIT=$$PAUSE^OCXDI0
WRITE !
End DoDot:2
if QUIT
QUIT
End DoDot:1
if QUIT
QUIT
+34 ;
+35 DO MESG("Checking protocols ")
if $$EN^OCXDI5
QUIT
+36 ;
+37 KILL ^TMP("OCXDIAG",$JOB)
+38 ;
+39 DO MESG("Diagnostic Finished...")
+40 ;
+41 QUIT
+42 ;
AUTO ;
+1 ;
+2 NEW QUIT,LINE,TEXT,REMOTE,LOCAL,D0,OPCODE,REF,OCXFLGA,OCXFLGC,OCXFLGR,OCXFLGD
SET QUIT=0
+3 ;
+4 SET LASTFILE=0
KILL ^TMP("OCXDIAG",$JOB)
+5 SET ^TMP("OCXDIAG",$JOB)=($PIECE($HOROLOG,",",2)+($HOROLOG*86400)+(4*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
+6 SET (OCXFLGD,OCXFLGA,OCXFLGR)=0
SET (OCXAUTO,OCXFLGC)=1
+7 ;
+8 DO MESG(" ")
+9 DO MESG("Order Check Expert System Diagnostic Tool")
+10 DO MESG(" Created: SEP 7,1999 at 10:30 in UCI: OEX,OER")
+11 DO MESG(" Current Date: "_($$NOW^OCXDI0)_" Current UCI: "_($$CUCI^OCXBDT))
+12 DO MESG(" ")
+13 DO MESG(" ")
+14 ;
+15 DO RUN
+16 ;
+17 QUIT
+18 ;
MESG(X) ;
+1 ;
+2 IF '$GET(OCXAUTO)
WRITE !,X
+3 IF '$TEST
DO BMES^XPDUTL(.X)
+4 QUIT
+5 ;
+6 ;
DOT if $GET(OCXAUTO)
QUIT
if ($X>70)
WRITE !
WRITE " ."
QUIT
+1 ;
