OCXDI1 ;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 ;
;
Q
;
;
COMPARE(L,R) ;
;
Q:'$L($O(L(""))) $$ADDREC^OCXDI2("R")
;
N C,OCXDD M C=L,C=R S OCXDD=$O(C("")) Q $$MULT("C",OCXDD)
;
Q 0
;
MULT(CREF,OCXDD) ;
;
N OCXSUB,LREF,RREF,QUIT,OCXFLD
S LREF="L"_$E(CREF,2,$L(CREF)),RREF="R"_$E(CREF,2,$L(CREF))
S QUIT=0,OCXFLD="" F S OCXFLD=$O(@CREF@(OCXDD,OCXFLD)) Q:'$L(OCXFLD) D Q:QUIT
.I (OCXFLD[":") D Q:QUIT
..Q:$$EXFLD(+OCXFLD,0)
..I '$D(@LREF@(OCXDD,OCXFLD,.01,"E")) D M @LREF@(OCXDD,OCXFLD)=@RREF@(OCXDD,OCXFLD)
...D WARN("Missing multiple:",CREF,OCXDD,OCXFLD)
...S QUIT=$$ADDMULT^OCXDI3(CREF,OCXDD,OCXFLD)
..I '$D(@RREF@(OCXDD,OCXFLD,.01,"E")) D M @RREF@(OCXDD,OCXFLD)=@LREF@(OCXDD,OCXFLD)
...D WARN("Extra multiple:",CREF,OCXDD,OCXFLD)
...S QUIT=$$DELMULT^OCXDI3($$APPEND(CREF,OCXDD),OCXFLD)
.;
.I (OCXFLD=+OCXFLD),'$$EXFLD(+OCXDD,OCXFLD) D
..I ($O(@CREF@(OCXDD,OCXFLD,""))="E") D Q
...I $L($G(@RREF@(OCXDD,OCXFLD,"E"))),'$L($G(@LREF@(OCXDD,OCXFLD,"E"))) D Q
....D WARN("Data Value Missing in "_$$CUCI^OCXBDT,CREF,OCXDD,OCXFLD,"E")
....S QUIT=$$EDITFLD^OCXDI4(CREF,OCXDD,OCXFLD,"E")
...I $L($G(@LREF@(OCXDD,OCXFLD,"E"))),'$L($G(@RREF@(OCXDD,OCXFLD,"E"))) D Q
....D WARN("Extra Data Value in "_$$CUCI^OCXBDT,CREF,OCXDD,OCXFLD,"E")
....S QUIT=$$DELFLD^OCXDI4(CREF,OCXDD,OCXFLD,"E")
...I '(@LREF@(OCXDD,OCXFLD,"E")=@RREF@(OCXDD,OCXFLD,"E")) D
....D WARN("Inconsistent Data",CREF,OCXDD,OCXFLD,"E")
....S QUIT=$$EDITFLD^OCXDI4(CREF,OCXDD,OCXFLD,"E")
..S OCXSUB=0 F Q:QUIT S OCXSUB=$O(@CREF@(OCXDD,OCXFLD,OCXSUB)) Q:'OCXSUB I '($G(@RREF@(OCXDD,OCXFLD,OCXSUB))=$G(@LREF@(OCXDD,OCXFLD,OCXSUB))) D Q
...D WARN("Inconsistent word Data",CREF,OCXDD,OCXFLD,OCXSUB)
...S QUIT=$$LOADWORD^OCXDI2(RREF,OCXDD,OCXFLD,OCXSUB)
.;
.I 'QUIT,(OCXFLD[":") S QUIT=$$MULT($$APPEND(CREF,OCXDD),OCXFLD)
Q QUIT
;
APPEND(ARRAY,OCXSUB) ;
S:'(OCXSUB=+OCXSUB) OCXSUB=""""_OCXSUB_""""
Q:'(ARRAY["(") ARRAY_"("_OCXSUB_")"
Q $E(ARRAY,1,$L(ARRAY)-1)_","_OCXSUB_")"
;
EXFLD(FILE,OCXFLD) ;
N OCXFNAM
S OCXFNAM=$$FIELD^OCXBDTD(FILE,OCXFLD,"LABEL")
I (OCXFNAM["UNIQUE OBJECT IDENTIFIER") Q 1
I (FILE=860.2),(OCXFLD=.02) Q 1
I (FILE=860.22),(OCXFLD=4) Q 1
I (FILE=860.3),(OCXFLD=3) Q 1
I (FILE=860.9),(OCXFLD=1) Q 1
I (FILE=860.91) Q 1
I (FILE=19),(OCXFLD=.15) Q 1
I (FILE=19),(OCXFLD=.16) Q 1
I (FILE=19),(OCXFLD=.26) Q 1
I (FILE=19),(OCXFLD=1.1) Q 1
I (FILE=19),(OCXFLD=3.6) Q 1
I (FILE=19),(OCXFLD=14) Q 1
I (FILE=19),(OCXFLD=99) Q 1
I (FILE=19),(OCXFLD=99.1) Q 1
I (FILE=19),(OCXFLD=200) Q 1
I (FILE=19),(OCXFLD=201) Q 1
I (FILE=19),(OCXFLD=203) Q 1
I ($E(OCXFNAM,1)="*") Q 1
Q 0
;
WARN(MSG,CREF,OCXDD,OCXFLD,OCXSUB) ;
;
Q:$G(OCXAUTO)
;
N D0,DASH,OCXDDPTH,OCXDPTR,FILE,FILEID,LREF,OCXPTR,RREF
;
Q:'OCXFLGR
;
S DASH="",$P(DASH,"-",(55-$L(MSG)))="-"
W !!,"----WARNING-",MSG,DASH
D DSPHDR(CREF,OCXDD,OCXFLD)
I $D(OCXSUB) D DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB)
I '$D(OCXSUB) D DSPREC(CREF,OCXDD,OCXFLD)
;
W ! Q
;
DSPREC(CREF,OCXDD,OCXFLD) ;
;
N OCXDPTR,OCXDDPTH,LEVL,OCXCREF,OCXSUB
S OCXCREF=$$APPEND($$APPEND(CREF,OCXDD),OCXFLD)
S OCXDDPTH=$P($P(OCXCREF,"(",2),")",1),LEVL=$L(OCXDDPTH,",")
S OCXSUB="" F S OCXSUB=$O(@OCXCREF@(OCXSUB)) Q:'$L(OCXSUB) D
.;
.I '(OCXSUB[":"),'((OCXSUB=.01)&$O(@OCXCREF@(OCXSUB))) D
..N LINE
..Q:$$EXFLD(+OCXFLD,OCXSUB)
..I OCXFLD W !,?(5+((LEVL)*4)),$$FIELD^OCXBDTD(+OCXFLD,OCXSUB,"LABEL"),": ",$G(@OCXCREF@(OCXSUB,"E"))
..S LINE=0 F S LINE=$O(@OCXCREF@(OCXSUB,LINE)) Q:'LINE D
...W !,?(5+(LEVL*4)),$J(LINE,3),">",@OCXCREF@(OCXSUB,LINE)
.;
.I (OCXSUB[":") D
..N D0,OCXDD,FILENAME
..S D0=+$P(OCXSUB,":",2),OCXDD=+OCXSUB
..S FILENAME=$$FILENAME^OCXBDTD(OCXDD)
..I $L(FILENAME) W !,?(5+($L(LEVL)*4)),FILENAME
..E W !!,?(5+(LEVL*4)),FILENAME
..W " ",D0,": ",$G(@OCXCREF@(OCXSUB,.01,"E"))
..D DSPREC($$APPEND(CREF,OCXDD),OCXFLD,OCXSUB)
;
Q
;
DSPHDR(CREF,OCXDD,OCXFLD) ;
;
N D0,FILE,FILEID,OCXPTR,OCXDDPTH
S OCXDDPTH=$P($P($$APPEND($$APPEND(CREF,OCXDD),OCXFLD),"(",2),")",1)
S FILE="" F OCXPTR=1:1:$L(OCXDDPTH,",") D
.N OCXDD,D0,FILEID
.S FILEID=$P(OCXDDPTH,",",OCXPTR)
.I (FILEID[":") D
..S D0=+$P(FILEID,":",2),OCXDD=+$E(FILEID,2,$L(FILEID))
..W !,?(5+(OCXPTR*4)),$$FILENAME^OCXBDTD(OCXDD)
..S:$L(FILE) FILE=FILE_"," S FILE=FILE_FILEID
..I $D(@("L("_FILE_",.01,""E"")")) W ": ",@("L("_FILE_",.01,""E"")") W:D0 " [",D0,"]"
..E I $D(@("R("_FILE_",.01,""E"")")) W ": ",@("R("_FILE_",.01,""E"")") W:D0 " [",D0,"]"
;
Q
;
DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB) ;
;
N OCXDPTR,LREF,RREF,OCXDDPTH
;
S OCXDDPTH=$P($P($$APPEND(CREF,OCXDD),"(",2),")",1)
S LREF="L("_OCXDDPTH_")",RREF="R("_OCXDDPTH_")"
W !,?(5+(($L(OCXDDPTH,",")+1)*4)),$$FIELD^OCXBDTD(OCXDD,OCXFLD,"LABEL")," field [",OCXFLD,"]"
I OCXSUB W " Line #",OCXSUB
;
W:($D(@RREF@(OCXFLD,OCXSUB))) !,?(5+(($L(OCXDDPTH,",")+2)*4)),"(R) OEX,OER: ",@RREF@(OCXFLD,OCXSUB)
W:($D(@LREF@(OCXFLD,OCXSUB))) !,?(5+(($L(OCXDDPTH,",")+2)*4)),"(L) ",$$CUCI^OCXBDT,": ",@LREF@(OCXFLD,OCXSUB)
;
Q
;
W !,?10 Q 0 Q $$PAUSE
;
PAUSE() Q:'OCXFLGC 0 W " Press Enter " R X:DTIME W ! Q (X[U)
;
NOW() N X,Y,%DT S X="N",%DT="T" D ^%DT S Y=$$DATE^OCXBDTD(Y) S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2) Q Y
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXDI1 5461 printed Nov 22, 2024@17:34:24 Page 2
OCXDI1 ;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 QUIT
+3 ;
+4 ;
COMPARE(L,R) ;
+1 ;
+2 if '$LENGTH($ORDER(L("")))
QUIT $$ADDREC^OCXDI2("R")
+3 ;
+4 NEW C,OCXDD
MERGE C=L,C=R
SET OCXDD=$ORDER(C(""))
QUIT $$MULT("C",OCXDD)
+5 ;
+6 QUIT 0
+7 ;
MULT(CREF,OCXDD) ;
+1 ;
+2 NEW OCXSUB,LREF,RREF,QUIT,OCXFLD
+3 SET LREF="L"_$EXTRACT(CREF,2,$LENGTH(CREF))
SET RREF="R"_$EXTRACT(CREF,2,$LENGTH(CREF))
+4 SET QUIT=0
SET OCXFLD=""
FOR
SET OCXFLD=$ORDER(@CREF@(OCXDD,OCXFLD))
if '$LENGTH(OCXFLD)
QUIT
Begin DoDot:1
+5 IF (OCXFLD[":")
Begin DoDot:2
+6 if $$EXFLD(+OCXFLD,0)
QUIT
+7 IF '$DATA(@LREF@(OCXDD,OCXFLD,.01,"E"))
Begin DoDot:3
+8 DO WARN("Missing multiple:",CREF,OCXDD,OCXFLD)
+9 SET QUIT=$$ADDMULT^OCXDI3(CREF,OCXDD,OCXFLD)
End DoDot:3
MERGE @LREF@(OCXDD,OCXFLD)=@RREF@(OCXDD,OCXFLD)
+10 IF '$DATA(@RREF@(OCXDD,OCXFLD,.01,"E"))
Begin DoDot:3
+11 DO WARN("Extra multiple:",CREF,OCXDD,OCXFLD)
+12 SET QUIT=$$DELMULT^OCXDI3($$APPEND(CREF,OCXDD),OCXFLD)
End DoDot:3
MERGE @RREF@(OCXDD,OCXFLD)=@LREF@(OCXDD,OCXFLD)
End DoDot:2
if QUIT
QUIT
+13 ;
+14 IF (OCXFLD=+OCXFLD)
IF '$$EXFLD(+OCXDD,OCXFLD)
Begin DoDot:2
+15 IF ($ORDER(@CREF@(OCXDD,OCXFLD,""))="E")
Begin DoDot:3
+16 IF $LENGTH($GET(@RREF@(OCXDD,OCXFLD,"E")))
IF '$LENGTH($GET(@LREF@(OCXDD,OCXFLD,"E")))
Begin DoDot:4
+17 DO WARN("Data Value Missing in "_$$CUCI^OCXBDT,CREF,OCXDD,OCXFLD,"E")
+18 SET QUIT=$$EDITFLD^OCXDI4(CREF,OCXDD,OCXFLD,"E")
End DoDot:4
QUIT
+19 IF $LENGTH($GET(@LREF@(OCXDD,OCXFLD,"E")))
IF '$LENGTH($GET(@RREF@(OCXDD,OCXFLD,"E")))
Begin DoDot:4
+20 DO WARN("Extra Data Value in "_$$CUCI^OCXBDT,CREF,OCXDD,OCXFLD,"E")
+21 SET QUIT=$$DELFLD^OCXDI4(CREF,OCXDD,OCXFLD,"E")
End DoDot:4
QUIT
+22 IF '(@LREF@(OCXDD,OCXFLD,"E")=@RREF@(OCXDD,OCXFLD,"E"))
Begin DoDot:4
+23 DO WARN("Inconsistent Data",CREF,OCXDD,OCXFLD,"E")
+24 SET QUIT=$$EDITFLD^OCXDI4(CREF,OCXDD,OCXFLD,"E")
End DoDot:4
End DoDot:3
QUIT
+25 SET OCXSUB=0
FOR
if QUIT
QUIT
SET OCXSUB=$ORDER(@CREF@(OCXDD,OCXFLD,OCXSUB))
if 'OCXSUB
QUIT
IF '($GET(@RREF@(OCXDD,OCXFLD,OCXSUB))=$GET(@LREF@(OCXDD,OCXFLD,OCXSUB)))
Begin DoDot:3
+26 DO WARN("Inconsistent word Data",CREF,OCXDD,OCXFLD,OCXSUB)
+27 SET QUIT=$$LOADWORD^OCXDI2(RREF,OCXDD,OCXFLD,OCXSUB)
End DoDot:3
QUIT
End DoDot:2
+28 ;
+29 IF 'QUIT
IF (OCXFLD[":")
SET QUIT=$$MULT($$APPEND(CREF,OCXDD),OCXFLD)
End DoDot:1
if QUIT
QUIT
+30 QUIT QUIT
+31 ;
APPEND(ARRAY,OCXSUB) ;
+1 if '(OCXSUB=+OCXSUB)
SET OCXSUB=""""_OCXSUB_""""
+2 if '(ARRAY["(")
QUIT ARRAY_"("_OCXSUB_")"
+3 QUIT $EXTRACT(ARRAY,1,$LENGTH(ARRAY)-1)_","_OCXSUB_")"
+4 ;
EXFLD(FILE,OCXFLD) ;
+1 NEW OCXFNAM
+2 SET OCXFNAM=$$FIELD^OCXBDTD(FILE,OCXFLD,"LABEL")
+3 IF (OCXFNAM["UNIQUE OBJECT IDENTIFIER")
QUIT 1
+4 IF (FILE=860.2)
IF (OCXFLD=.02)
QUIT 1
+5 IF (FILE=860.22)
IF (OCXFLD=4)
QUIT 1
+6 IF (FILE=860.3)
IF (OCXFLD=3)
QUIT 1
+7 IF (FILE=860.9)
IF (OCXFLD=1)
QUIT 1
+8 IF (FILE=860.91)
QUIT 1
+9 IF (FILE=19)
IF (OCXFLD=.15)
QUIT 1
+10 IF (FILE=19)
IF (OCXFLD=.16)
QUIT 1
+11 IF (FILE=19)
IF (OCXFLD=.26)
QUIT 1
+12 IF (FILE=19)
IF (OCXFLD=1.1)
QUIT 1
+13 IF (FILE=19)
IF (OCXFLD=3.6)
QUIT 1
+14 IF (FILE=19)
IF (OCXFLD=14)
QUIT 1
+15 IF (FILE=19)
IF (OCXFLD=99)
QUIT 1
+16 IF (FILE=19)
IF (OCXFLD=99.1)
QUIT 1
+17 IF (FILE=19)
IF (OCXFLD=200)
QUIT 1
+18 IF (FILE=19)
IF (OCXFLD=201)
QUIT 1
+19 IF (FILE=19)
IF (OCXFLD=203)
QUIT 1
+20 IF ($EXTRACT(OCXFNAM,1)="*")
QUIT 1
+21 QUIT 0
+22 ;
WARN(MSG,CREF,OCXDD,OCXFLD,OCXSUB) ;
+1 ;
+2 if $GET(OCXAUTO)
QUIT
+3 ;
+4 NEW D0,DASH,OCXDDPTH,OCXDPTR,FILE,FILEID,LREF,OCXPTR,RREF
+5 ;
+6 if 'OCXFLGR
QUIT
+7 ;
+8 SET DASH=""
SET $PIECE(DASH,"-",(55-$LENGTH(MSG)))="-"
+9 WRITE !!,"----WARNING-",MSG,DASH
+10 DO DSPHDR(CREF,OCXDD,OCXFLD)
+11 IF $DATA(OCXSUB)
DO DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB)
+12 IF '$DATA(OCXSUB)
DO DSPREC(CREF,OCXDD,OCXFLD)
+13 ;
+14 WRITE !
QUIT
+15 ;
DSPREC(CREF,OCXDD,OCXFLD) ;
+1 ;
+2 NEW OCXDPTR,OCXDDPTH,LEVL,OCXCREF,OCXSUB
+3 SET OCXCREF=$$APPEND($$APPEND(CREF,OCXDD),OCXFLD)
+4 SET OCXDDPTH=$PIECE($PIECE(OCXCREF,"(",2),")",1)
SET LEVL=$LENGTH(OCXDDPTH,",")
+5 SET OCXSUB=""
FOR
SET OCXSUB=$ORDER(@OCXCREF@(OCXSUB))
if '$LENGTH(OCXSUB)
QUIT
Begin DoDot:1
+6 ;
+7 IF '(OCXSUB[":")
IF '((OCXSUB=.01)&$ORDER(@OCXCREF@(OCXSUB)))
Begin DoDot:2
+8 NEW LINE
+9 if $$EXFLD(+OCXFLD,OCXSUB)
QUIT
+10 IF OCXFLD
WRITE !,?(5+((LEVL)*4)),$$FIELD^OCXBDTD(+OCXFLD,OCXSUB,"LABEL"),": ",$GET(@OCXCREF@(OCXSUB,"E"))
+11 SET LINE=0
FOR
SET LINE=$ORDER(@OCXCREF@(OCXSUB,LINE))
if 'LINE
QUIT
Begin DoDot:3
+12 WRITE !,?(5+(LEVL*4)),$JUSTIFY(LINE,3),">",@OCXCREF@(OCXSUB,LINE)
End DoDot:3
End DoDot:2
+13 ;
+14 IF (OCXSUB[":")
Begin DoDot:2
+15 NEW D0,OCXDD,FILENAME
+16 SET D0=+$PIECE(OCXSUB,":",2)
SET OCXDD=+OCXSUB
+17 SET FILENAME=$$FILENAME^OCXBDTD(OCXDD)
+18 IF $LENGTH(FILENAME)
WRITE !,?(5+($LENGTH(LEVL)*4)),FILENAME
+19 IF '$TEST
WRITE !!,?(5+(LEVL*4)),FILENAME
+20 WRITE " ",D0,": ",$GET(@OCXCREF@(OCXSUB,.01,"E"))
+21 DO DSPREC($$APPEND(CREF,OCXDD),OCXFLD,OCXSUB)
End DoDot:2
End DoDot:1
+22 ;
+23 QUIT
+24 ;
DSPHDR(CREF,OCXDD,OCXFLD) ;
+1 ;
+2 NEW D0,FILE,FILEID,OCXPTR,OCXDDPTH
+3 SET OCXDDPTH=$PIECE($PIECE($$APPEND($$APPEND(CREF,OCXDD),OCXFLD),"(",2),")",1)
+4 SET FILE=""
FOR OCXPTR=1:1:$LENGTH(OCXDDPTH,",")
Begin DoDot:1
+5 NEW OCXDD,D0,FILEID
+6 SET FILEID=$PIECE(OCXDDPTH,",",OCXPTR)
+7 IF (FILEID[":")
Begin DoDot:2
+8 SET D0=+$PIECE(FILEID,":",2)
SET OCXDD=+$EXTRACT(FILEID,2,$LENGTH(FILEID))
+9 WRITE !,?(5+(OCXPTR*4)),$$FILENAME^OCXBDTD(OCXDD)
+10 if $LENGTH(FILE)
SET FILE=FILE_","
SET FILE=FILE_FILEID
+11 IF $DATA(@("L("_FILE_",.01,""E"")"))
WRITE ": ",@("L("_FILE_",.01,""E"")")
if D0
WRITE " [",D0,"]"
+12 IF '$TEST
IF $DATA(@("R("_FILE_",.01,""E"")"))
WRITE ": ",@("R("_FILE_",.01,""E"")")
if D0
WRITE " [",D0,"]"
End DoDot:2
End DoDot:1
+13 ;
+14 QUIT
+15 ;
DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB) ;
+1 ;
+2 NEW OCXDPTR,LREF,RREF,OCXDDPTH
+3 ;
+4 SET OCXDDPTH=$PIECE($PIECE($$APPEND(CREF,OCXDD),"(",2),")",1)
+5 SET LREF="L("_OCXDDPTH_")"
SET RREF="R("_OCXDDPTH_")"
+6 WRITE !,?(5+(($LENGTH(OCXDDPTH,",")+1)*4)),$$FIELD^OCXBDTD(OCXDD,OCXFLD,"LABEL")," field [",OCXFLD,"]"
+7 IF OCXSUB
WRITE " Line #",OCXSUB
+8 ;
+9 if ($DATA(@RREF@(OCXFLD,OCXSUB)))
WRITE !,?(5+(($LENGTH(OCXDDPTH,",")+2)*4)),"(R) OEX,OER: ",@RREF@(OCXFLD,OCXSUB)
+10 if ($DATA(@LREF@(OCXFLD,OCXSUB)))
WRITE !,?(5+(($LENGTH(OCXDDPTH,",")+2)*4)),"(L) ",$$CUCI^OCXBDT,": ",@LREF@(OCXFLD,OCXSUB)
+11 ;
+12 QUIT
+13 ;
+14 WRITE !,?10
QUIT 0
QUIT $$PAUSE
+15 ;
PAUSE() if 'OCXFLGC
QUIT 0
WRITE " Press Enter "
READ X:DTIME
WRITE !
QUIT (X[U)
+1 ;
NOW() NEW X,Y,%DT
SET X="N"
SET %DT="T"
DO ^%DT
SET Y=$$DATE^OCXBDTD(Y)
if (Y["@")
SET Y=$PIECE(Y,"@",1)_" at "_$PIECE(Y,"@",2)
QUIT Y
+1 ;
