- 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 Jan 18, 2025@03:25:41 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 ;