source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXDI0.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1OCXDI0 ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC UTILITY ROUTINE ;SEP 7,1999 at 10:30
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5S ;
6 ;
7 Q
8 ;
9RTN(RSUM) ;
10 ;
11 D DOT^OCXDIAG
12 ;
13 N CHAR,CSUM,DASH,LINE,MSG,RNDX,RPC,RTN,TEXT,X,RCSM,RDIFF
14 ;
15 S RCSM(3)="",RTN=$P(RSUM(0),U,1)
16 F RNDX=1:1 Q:'$D(RSUM(RNDX)) F RPC=1:1:$L(RSUM(RNDX),U) S RCSM($O(RCSM(""),-1)+1)=$P(RSUM(RNDX),U,RPC)
17 K RCSM(3)
18 ;
19 S X=RTN X ^%ZOSF("TEST") E D WARN(RTN,"Routine not in local system") Q 0
20 ;
21 F LINE=4:1 S TEXT=$$TEXT(RTN,LINE) Q:'$L(TEXT) I '$D(RCSM(LINE)) S RDIFF(LINE)=""
22 S LINE=0 F S LINE=$O(RCSM(LINE)) Q:'LINE S TEXT=$$TEXT(RTN,LINE) D
23 .S CSUM=0 F CHAR=1:1:$L(TEXT) S CSUM=CSUM+($A(TEXT,CHAR)*CHAR)
24 .I '(RCSM(LINE)=(+(CSUM_"."_$L(TEXT)_"1"))) S RDIFF(LINE)=""
25 ;
26 Q:'$O(RDIFF(0)) 0
27 ;
28 D WARN(RTN,"Checksums do not match",.RDIFF)
29 ;
30 Q 0
31 ;
32WARN(RTN,MSG,LINES) ;
33 ;
34 Q:$G(OCXAUTO)
35 ;
36 N DASH,LINE,NLINE,PLINE
37 ;
38 S DASH="",$P(DASH,"-",(55-$L(MSG)-2))="-"
39 W !!,"----WARNING-","--",MSG,DASH
40 ;
41 W !,RTN,?10,"[OEX,OER] -> [",$$CUCI^OCXBDT,"] Line"
42 ;
43 I $O(LINES($O(LINES(0)))) W "s: "
44 E W ": "
45 ;
46 S LINE=0 F S LINE=$O(LINES(LINE)) Q:'LINE D
47 .W:($X>60) !,?40
48 .S NLINE=LINE F S PLINE=NLINE,NLINE=$O(LINES(NLINE)) Q:(NLINE-PLINE-1)
49 .I (PLINE=LINE) W " ",LINE
50 .E W " ",LINE,"-",PLINE S LINE=PLINE
51 ;
52 W ! Q
53 ;
54TEXT(RTN,LINE) ;
55 ;
56 N TEXT X "S TEXT=$T(+"_(+LINE)_"^"_RTN_")" Q TEXT
57 ;
58HEADER ;
59 ;
60 W !," Created: SEP 7,1999 at 10:30 in UCI: OEX,OER"
61 W !," Current Date: ",$$NOW," Current UCI: ",$$CUCI^OCXBDT,!!
62 S LASTFILE=0
63 K ^TMP("OCXDIAG",$J)
64 S ^TMP("OCXDIAG",$J)=($P($H,",",2)+($H*86400)+(1*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
65 Q
66 ;
67LISTFILE(GLREF,SCANDUP) ;
68 ;
69 Q:($L(GLREF)<2) 0
70 N D0,NAME,FILE,QUIT,CNT,FILENUM
71 S QUIT=0,FILE=$P($G(@GLREF@(0)),U,1),FILENUM=+$P($G(@GLREF@(0)),U,2)
72 I '$L(FILE) W !!,"Cannot find File: ",GLREF Q $$PAUSE
73 I SCANDUP S (QUIT,D0)=0 F CNT=0:1 S D0=$O(@GLREF@(D0)) Q:'D0 S NAME=$P($G(@GLREF@(D0,0)),U,1) D Q:QUIT
74 .D DOT^OCXDIAG
75 .I '$L(NAME) W !,GLREF," ",FILE," -> Record #",D0," does not have a name." S QUIT=$$PAUSE Q
76 .I OCXFLGR,'$D(^TMP("OCXDIAG",$J,"A",FILENUM,NAME)) D
77 ..W !!," Extra Record in (L) ",$$CUCI^OCXBDT," - ",FILE,": ",NAME,"."
78 ..S QUIT=$$DELREC^OCXDI2(FILENUM,D0)
79 Q QUIT
80 ;
81GETFILE(FILE,RECNAME,ARRAY) ;
82 ;
83 N CHECK,GLNEXT,GLREF,LINES,REC,DD,FLD
84 S REC=$$LOOKUP(FILE,RECNAME)
85 I 'REC W:OCXFLGR !!,$$FILENAME^OCXBDTD(FILE),": ",RECNAME," not found." Q 0
86 I (REC=-1) W:OCXFLGR !!,$$FILENAME^OCXBDTD(FILE),": ",RECNAME," duplicate local entries.",! S REC=$$DELDUP^OCXDI2(FILE,RECNAME)
87 I (REC=-2) W:OCXFLGR !!,$$FILENAME^OCXBDTD(FILE)," (",FILE,") local file not found." W ! Q:$$PAUSE -10 Q REC
88 I (REC<0) W:OCXFLGR !!,$$FILENAME^OCXBDTD(FILE),": ",RECNAME," unknown error." W ! Q:$$PAUSE -10 Q REC
89 I (REC>0) D
90 .S CHECK=0,LINES=0
91 .D GETREC($$FILE^OCXBDTD(FILE,"GLOBAL NAME"),"ARRAY(",REC,.ARRAY)
92 .S GLREF="ARRAY" F S GLREF=$Q(@GLREF) Q:'$L(GLREF) Q:'($E(GLREF,1,6)="ARRAY(") K:'$L(@GLREF) @GLREF
93 ;
94 Q REC
95 ;
96LKUPARRY(DD,KEY,ARRAY) ;
97 ;
98 N D0 S D0=0 F S D0=$O(ARRAY(DD,D0)) Q:'D0 Q:($G(ARRAY(DD,D0,.01,"E"))=KEY)
99 Q D0
100 ;
101LOOKUP(FILE,KEY) ;
102 I $O(^TMP("OCXDIAG",$J,"B",FILE,KEY,0)) Q 0
103 N RECNAM,REC,D0,CNT,SHORT S (REC,CNT)=0
104 S GL=$$FILE^OCXBDTD(FILE,"GLOBAL NAME") Q:'$L(GL) -2 S GL=$E(GL,1,$L(GL)-1)_")"
105 S SHORT=$E(KEY,1,30),RECNAM=SHORT D F S RECNAM=$O(@GL@("B",RECNAM)) Q:'$L(RECNAM) Q:'($E(RECNAM,1,$L(SHORT))=SHORT) D
106 .S D0=0 F S D0=$O(@GL@("B",RECNAM,D0)) Q:'D0 I ($P($G(@GL@(D0,0)),U,1)=KEY) S CNT=CNT+1,REC=D0_U_RECNAME
107 Q:(CNT>1) -1
108 S:$L($P(REC,U,2)) ^TMP("OCXDIAG",$J,"A",FILE,$P(REC,U,2))=""
109 Q +REC
110 ;
111GETREC(GL,PATH,D0,REM) ;
112 ;
113 Q:'($P($G(@(GL_"0)")),U,2))
114 N S1,DATA,DD
115 S DATA="" D DIQ(GL,D0,.DATA)
116 S DD=$O(DATA(0)) Q:'DD
117 ;
118 I $L($$FILE^OCXBDTD(DD,"NAME")) S PATH=PATH_""""_DD_":"_D0_""""
119 I '$L($$FILE^OCXBDTD(DD,"NAME")) S PATH=PATH_","""_DD_":"_D0_""""
120 M @(PATH_")")=DATA(DD,D0)
121 ;
122 S S1="" F S S1=$O(@(GL_D0_","_$$SUB(S1)_")")) Q:'$L(S1) I ($D(@(GL_D0_","_$$SUB(S1)_")"))>3) D
123 .N D1,GLREF S GLREF=GL_D0_","_$$SUB(S1)_","
124 .S D1=0 F S D1=$O(@(GLREF_D1_")")) Q:'D1 D GETREC(GLREF,PATH,D1,.REM)
125 ;
126 Q
127 ;
128SUB(X) Q:'(X=+X) """"_X_"""" Q X
129 ;
130DIQ(DIC,DA,OCXARY) ;
131 N DR,DIQ S DR=".01:99999",DIQ="OCXARY(",DIQ(0)="EN" D EN^DIQ1
132 Q
133 ;
134PAUSE() Q:'OCXFLGC 0 W " Press Enter " R X:DTIME W ! Q (X[U)
135 ;
136NOW() 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
137 ;
Note: See TracBrowser for help on using the repository browser.