source: IHS-VA_UTILITIES-XB/trunk/XBSUMBLD.m@ 1039

Last change on this file since 1039 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 3.2 KB
Line 
1XBSUMBLD ; IHS/ADC/GTH - ROUTINE INTEGRITY CHECK GENERATOR ; [ 10/29/2002 7:42 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
4 ;
5 ; This routine requests the user to select a set of routines and
6 ; generates an integrity checking routine for the selected routines.
7 ; The user is asked to enter the name of the generated routine.
8 ;
9 ; The VA's equivalent routine is XTSUMBLD, which will also create
10 ; integrity checking routine(s).
11 ;
12START ;
13 W !,"NOTE: The VA's equivalent routine is XTSUMBLD, which"
14 W !," will also create integrity checking routine(s).",!!
15 Q:'$$DIR^XBDIR("E")
16 NEW BYTE,COUNT,QUIT,RTDATE,RTN,RTNAME,VERSION
17 KILL ^UTILITY($J),^TMP("XBSUMBLD",$J)
18 D ^XBKVAR
19 X ^%ZOSF("RSEL")
20 I $O(^UTILITY($J,""))="" D EOJ Q
21 S RTNAME=$$DIR^XBDIR("F^5:8^K:X'?1U.U X","Enter name of routine to be generated: ","","","Example: APCDINTG")
22 I $D(DIRUT) D EOJ Q
23 D CHECKRTN
24 I 'Y D EOJ Q
25 S VERSION=" ;;"_$$DIR^XBDIR("F^1:5^K:'(X?1.2N!(X?1.2N1"".""1.2N)) X","Enter version number","","","Must be n or n.n where the length of n is 1-2")
26 I $D(DIRUT) D EOJ Q
27 S VERSION=VERSION_";"_$$DIR^XBDIR("FO^2:30","Enter package name")
28 I $D(DTOUT)!($D(DUOUT)) D EOJ Q
29 ; begin Y2K fix block
30 ;S Y=$$DIR^XBDIR("D","Enter date","TODAY")
31 S Y=$$DIR^XBDIR("D^::E","Enter date","TODAY") ;Y2000
32 ; end Y2K fix block
33 I $D(DIRUT) D EOJ Q
34 D DD^%DT
35 S RTDATE=Y,VERSION=VERSION_";;"_Y
36 F %=1:1:11 S X=$P($T(@("LINE"_%)),";;",2,99),@("XBSUMBLD("_%_")=X")
37 F %=1:1:3 S X=$P($T(@("CODE"_%)),";;",2,99),@("XBSUMBLD(""CODE"_%_""")=X")
38 KILL %,X,Y
39 X XBSUMBLD(1)
40 Q
41 ;
42CHECKRTN ;
43 S Y=1,X=RTNAME
44 X ^%ZOSF("TEST")
45 E Q
46 S Y=$$DIR^XBDIR("YO","Routine already exists. Want to recreate it","NO")
47 I $D(DIRUT) S Y=0
48 Q
49 ;
50EOJ ;
51 KILL %,DTOUT,DUOUT,DIRUT,DIROUT,X,XBSUMBLD,Y,^UTILITY($J)
52 Q
53 ;IHS/SET/GTH XB*3*9 10/29/2002 LINE2 mod'd seed of RTN from "" to 0.
54 ; The only good thing I can say about the following is that it works.
55LINE1 ;;X XBSUMBLD(2),XBSUMBLD(6),XBSUMBLD(11)
56LINE2 ;;S RTN=0 F S RTN=$O(^UTILITY($J,RTN)) Q:RTN="" W !,RTN ZL @RTN S (BYTE,COUNT)=0 S X=$T(+1),X=$P(X," [ ",1) X XBSUMBLD(4),XBSUMBLD(3),XBSUMBLD(5)
57LINE3 ;;F I=2:1 S X=$T(+I) Q:X="" X XBSUMBLD(4)
58LINE4 ;;F J=1:1 S Y=$E(X,J) Q:Y="" S BYTE=BYTE+1,COUNT=COUNT+$A(Y)
59LINE5 ;;S ^TMP("XBSUMBLD",$J,RTN)=BYTE_"^"_COUNT
60LINE6 ;;ZR S X=RTNAME_" ;INTEGRITY CHECKER;"_RTDATE ZI X ZI VERSION ZI " ;" ZI "START ;" ZI " NEW BYTE,COUNT,RTN" ZI " K ^UTILITY($J)" X XBSUMBLD(7),XBSUMBLD(8),XBSUMBLD(9),XBSUMBLD(10) ZS @RTNAME
61LINE7 ;;F I=1:1:3 S V="CODE"_I S Z=XBSUMBLD(V) Q:Z="" ZI Z
62LINE8 ;;ZI " Q" ZI " ;" ZI "LINE1 ;;X XBSUMBLD(2),XBSUMBLD(6)" F I=2:1:4 S Z="LINE"_I_" ;;"_XBSUMBLD(I) ZI Z
63LINE9 ;;ZI "LINE5 ;;S B=$P(^UTILITY($J,RTN),""^"",1),C=$P(^(RTN),""^"",2) I B'=BYTE!(C'=COUNT) W "" has been modified""" ZI "LINE6 ;;K XBSUMBLD,B,C,I,J,R,X,Y" ZI " ;" ZI "LIST ;"
64LINE10 ;;S RTN="" F S RTN=$O(^TMP("XBSUMBLD",$J,RTN)) Q:RTN="" S Z=^(RTN),Z=" ;;"_RTN_"^"_Z ZI Z
65LINE11 ;;K %,XBSUMBLD,DTOUT,DUOUT,DIRUT,DIROUT,I,J,V,X,Y,Z,^UTILITY($J),^TMP("XBSUMBLD",$J)
66CODE1 ;; F I=1:1 S X=$T(LIST+I) Q:X="" S X=$P(X,";;",2),R=$P(X,"^",1),B=$P(X,"^",2),C=$P(X,"^",3),^UTILITY($J,R)=B_"^"_C
67CODE2 ;; F I=1:1:6 S X=$P($T(@("LINE"_I)),";;",2,99),@("XBSUMBLD("_I_")=X")
68CODE3 ;; X XBSUMBLD(1)
Note: See TracBrowser for help on using the repository browser.