110 lines
4.0 KiB
Mathematica
110 lines
4.0 KiB
Mathematica
OCXBDT2 ;SLC/RJS,CLA - BUILD OCX PACKAGE DIAGNOSTIC ROUTINES (File Data) ;8/04/98 13:21
|
|
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
|
|
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
|
|
;
|
|
S ;
|
|
;
|
|
;
|
|
N FILE,REC,DD,RECNAME
|
|
;
|
|
S FILE=0 F S FILE=$O(^OCXS(FILE)) Q:'FILE D
|
|
.S ^TMP("OCXBDT",$J,$$NEXT)="ROOT^OCXS("_(+FILE)_",0)^"_$P(^OCXS(FILE,0),U,1,2)
|
|
S FILE=0 F S FILE=$O(^OCXD(FILE)) Q:'FILE D
|
|
.S ^TMP("OCXBDT",$J,$$NEXT)="ROOT^OCXD("_(+FILE)_",0)^"_$P(^OCXD(FILE,0),U,1,2)
|
|
;
|
|
F FILE=38,41,40,37,39,36,35,34,32,31,33,30,9,8,6,5,4,3,2 D
|
|
.S FILE=FILE/10+860
|
|
.Q:'($O(^OCXS(FILE,0))) Q:'$L($P(^OCXS(FILE,0),U,1))
|
|
.S ^TMP("OCXBDT",$J,$$NEXT)="SOF^"_(+$P(^OCXS(FILE,0),U,2))_" "_$P(^OCXS(FILE,0),U,1)
|
|
.W !!,"File: ",+FILE," ",$P(^OCXS(FILE,0),U,1)
|
|
.S REC=0 F S REC=$O(^OCXS(FILE,REC)) Q:'REC D
|
|
..N REM,ARRAY,DD
|
|
..W !,FILE," ",$P(^OCXS(FILE,0),U,1),": ",$J(REC,6)," ",$P(^OCXS(FILE,REC,0),U,1)," "
|
|
..I (FILE=2),$G(^OCXS(860.2,REC,"INACT")) W !,?10,"*** Inactive rule skipped. ***" Q
|
|
..D GETREC("^OCXS("_FILE_",","REM(",REC,.REM)
|
|
..S DD=$O(REM(0))
|
|
..S ^TMP("OCXBDT",$J,$$NEXT)="KEY"_U_DD_U_REM(DD,.01,"E")
|
|
..S ARRAY="REM(0)" F S ARRAY=$Q(@ARRAY) Q:'$L(ARRAY) Q:'($E(ARRAY,1,4)="REM(") I $L(@ARRAY) D
|
|
...S ^TMP("OCXBDT",$J,$$NEXT)="R"_U_$P($P(ARRAY,"(",2),")",1)
|
|
...S ^TMP("OCXBDT",$J,$$NEXT)="D"_U_(@ARRAY)
|
|
..S ^TMP("OCXBDT",$J,$$NEXT)="EOR^"
|
|
.S ^TMP("OCXBDT",$J,$$NEXT)="EOF^OCXS("_FILE_")^1"
|
|
;
|
|
Q
|
|
;
|
|
NEXT() Q $O(^TMP("OCXBDT",$J,""),-1)+1
|
|
;
|
|
GETREC(GL,PATH,D0,REM) ;
|
|
;
|
|
Q:'($P($G(@(GL_"0)")),U,2))
|
|
N S1,DATA,DD
|
|
S DATA="" D DIQ(GL,D0,.DATA)
|
|
S DD=$O(DATA(0)) Q:'DD
|
|
;
|
|
I $L($$FILE^OCXBDTD(DD,"NAME")) S PATH=PATH_""""_DD_":"""
|
|
I '$L($$FILE^OCXBDTD(DD,"NAME")) S PATH=PATH_","""_DD_":"_D0_""""
|
|
M @(PATH_")")=DATA(DD,D0)
|
|
;
|
|
S S1="" F S S1=$O(@(GL_D0_","_$$SUB(S1)_")")) Q:'$L(S1) I ($D(@(GL_D0_","_$$SUB(S1)_")"))>3) D
|
|
.N D1,GLREF S GLREF=GL_D0_","_$$SUB(S1)_","
|
|
.S D1=0 F S D1=$O(@(GLREF_D1_")")) Q:'D1 D GETREC(GLREF,PATH,D1,.REM)
|
|
;
|
|
Q
|
|
;
|
|
SUB(X) Q:'(X=+X) """"_X_"""" Q X
|
|
;
|
|
DIQ(DIC,DA,OCXARY) ;
|
|
N DR,DIQ,DD,D0,FLD
|
|
S DR=".01:99999",DIQ="OCXARY(",DIQ(0)="IEN" D EN^DIQ1
|
|
;
|
|
S DD=0 F S DD=$O(OCXARY(DD)) Q:'DD D
|
|
.S D0=0 F S D0=$O(OCXARY(DD,D0)) Q:'D0 D
|
|
..S FLD=0 F S FLD=$O(OCXARY(DD,D0,FLD)) Q:'FLD D
|
|
...I $L($$FIELD^OCXBDTD(DD,FLD,"POINTER")),$L($G(OCXARY(DD,D0,FLD,"E"))),$L($G(OCXARY(DD,D0,FLD,"I"))),(OCXARY(DD,D0,FLD,"E")=OCXARY(DD,D0,FLD,"I")) D Q
|
|
....N OCXPNTR
|
|
....S OCXPNTR=$$FIELD^OCXBDTD(DD,FLD,"POINTER")
|
|
....I $L(OCXPNTR) S OCXPNTR="^"_OCXPNTR_"0)"
|
|
....I $D(@OCXPNTR) S OCXPNTR=$P(@OCXPNTR,"^",1)
|
|
....W !!,"Broken pointer '",OCXARY(DD,D0,FLD,"E"),"'"
|
|
....W " (",$$FIELD^OCXBDTD(DD,FLD,"LABEL"),") to"
|
|
....W " '",OCXPNTR,"' file (",DD,",",D0,",",FLD,")"
|
|
....W !," Not included."
|
|
....I (FLD=.01) K OCXARY(DD,D0)
|
|
....E K OCXARY(DD,D0,FLD)
|
|
...K OCXARY(DD,D0,FLD,"I")
|
|
...K:'$L($G(OCXARY(DD,D0,FLD,"E"))) OCXARY(DD,D0,FLD,"E")
|
|
...K:$$EXFLD(DD,FLD) OCXARY(DD,D0,FLD)
|
|
..;
|
|
..I ($$FIELD^OCXBDTD(DD,.01,"LABEL")["PARAMETER"),($G(OCXARY(DD,D0,.01,"E"))="DATA TYPE"),$G(OCXARY(DD,D0,1,"E")) D
|
|
...I $D(^OCXS(864.1,+OCXARY(DD,D0,1,"E"),0)) S OCXARY(DD,D0,1,"E")=$P(^OCXS(864.1,+OCXARY(DD,D0,1,"E"),0),U,1)
|
|
..;
|
|
..I ($$FIELD^OCXBDTD(DD,.01,"LABEL")["PARAMETER"),($G(OCXARY(DD,D0,.01,"E"))="OCXO GENERATE CODE FUNCTION"),$G(OCXARY(DD,D0,1,"E")) D
|
|
...I $D(^OCXS(863.7,+OCXARY(DD,D0,1,"E"),0)) S OCXARY(DD,D0,1,"E")=$P(^OCXS(863.7,+OCXARY(DD,D0,1,"E"),0),U,1)
|
|
..;
|
|
;
|
|
Q
|
|
EXFLD(FILE,OCXFLD) ;
|
|
;
|
|
N OCXFNAM
|
|
S OCXFNAM=$$FIELD^OCXBDTD(FILE,OCXFLD,"LABEL")
|
|
I (OCXFNAM["UNIQUE OBJECT IDENTIFIER") Q 1
|
|
I ($E(OCXFNAM,1)="*") 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
|
|
Q 0
|
|
;
|