AXVRTN ;10N20/MAH ; Routine checker ; 11/12/2004
;;1.0;AXVRTN - VISN20 APPLICATION;**1**;11/16/2004
;Cache Objects and Classes
;class for apps
;##class(visn.vApps)
;properties - AppsName
;hold the national application names
;class for routine
;##class(visn.vRoutine)
;properties - RtnApps
;properties - RtnName
;properties - RtnPatch
;Properties - RtnVersion
;Properties - RntCksum
;Properties - RntSize
;hold the national/local routines within vista
CLN N X
;S X=0 F S X=$O(^visn.vRoutineD(X)) Q:X'>0 D ##CLASS(visn.vRoutine).%DeleteId(X)
K X
;S ##CLASS(visn.vRoutine).%New(1)=""
STR ;Clean up globel than run the build
S SL=0
N APP,RN,PAT,VERION,X,SIZE,CLSUM,APPID
S RNT="B"
F S RNT=$O(^ROUTINE(""_RNT_"")) Q:RNT="" D
.Q:'($E(RNT)?1U)
.I $D(^ROUTINE(RNT,0,2)) S SL=$P($G(^ROUTINE(RNT,0,2)),"^",1) I SL'[";;" Q
.I $D(^ROUTINE(RNT,0,"SIZE")) S SIZE=$P($G(^ROUTINE(RNT,0,"SIZE")),"^",1)
.S RSUM="ZL @X S Y=0 F %=1,3:1 S %1=$T(+%),%3=$F(%1,"" "") Q:'%3 S %3=$S($E(%1,%3)'="";"":$L(%1),$E(%1,%3+1)="";"":$L(%1),1:%3-2) F %2=1:1:%3 S Y=$A(%1,%2)*(%2+%)+Y"
.S X=RNT X RSUM S CLSUM=Y K X
.S VERSION=$P(SL,";",3)
.S PACKAGE=$P(SL,";",4) I PACKAGE="" S PACKAGE="UNKNOWN"
.S PACKAGE=($TR(PACKAGE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
.S PAT=$P(SL,";",5)
.S PAT=$TR(PAT,"**","")
.S SL=0
.;S RNTID=$O(^visn.vRoutineI("RtnNameIndex",RNT,0))
.;I RNTID'>0 S RN=##CLASS(visn.vRoutine).%New() ; add new record because it isn't there
.;E S RN=##CLASS(visn.vRoutine).%OpenId(RNTID) ;it here so your bring into memory
.;S RN.RtnName=RNT
.;S RN.RtnVersion=VERSION
.;S RN.RtnPatch=PAT
.;S RN.RtnCksum=CLSUM
.;S RN.RtnSize=SIZE
.;S RN.RtnApplication=PACKAGE
.;Do RN.%Save()
.;Do RN.%Close()
.W !,RNT_"^"_VERSION_"^"_PAT_"^"_CLSUM_"^"_PACKAGE
.K RN
.Q
EXIT K SIZE,SL,RNT,VERSION,PACKAGE,PAT,RN,APP,CLSUM,RSUM,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HAXVRTN 1921 printed Nov 22, 2024@17:54:35 Page 2
AXVRTN ;10N20/MAH ; Routine checker ; 11/12/2004
+1 ;;1.0;AXVRTN - VISN20 APPLICATION;**1**;11/16/2004
+2 ;Cache Objects and Classes
+3 ;class for apps
+4 ;##class(visn.vApps)
+5 ;properties - AppsName
+6 ;hold the national application names
+7 ;class for routine
+8 ;##class(visn.vRoutine)
+9 ;properties - RtnApps
+10 ;properties - RtnName
+11 ;properties - RtnPatch
+12 ;Properties - RtnVersion
+13 ;Properties - RntCksum
+14 ;Properties - RntSize
+15 ;hold the national/local routines within vista
CLN NEW X
+1 ;S X=0 F S X=$O(^visn.vRoutineD(X)) Q:X'>0 D ##CLASS(visn.vRoutine).%DeleteId(X)
+2 KILL X
+3 ;S ##CLASS(visn.vRoutine).%New(1)=""
STR ;Clean up globel than run the build
+1 SET SL=0
+2 NEW APP,RN,PAT,VERION,X,SIZE,CLSUM,APPID
+3 SET RNT="B"
+4 FOR
SET RNT=$ORDER(^ROUTINE(""_RNT_""))
if RNT=""
QUIT
Begin DoDot:1
+5 if '($EXTRACT(RNT)?1U)
QUIT
+6 IF $DATA(^ROUTINE(RNT,0,2))
SET SL=$PIECE($GET(^ROUTINE(RNT,0,2)),"^",1)
IF SL'[";;"
QUIT
+7 IF $DATA(^ROUTINE(RNT,0,"SIZE"))
SET SIZE=$PIECE($GET(^ROUTINE(RNT,0,"SIZE")),"^",1)
+8 SET RSUM="ZL @X S Y=0 F %=1,3:1 S %1=$T(+%),%3=$F(%1,"" "") Q:'%3 S %3=$S($E(%1,%3)'="";"":$L(%1),$E(%1,%3+1)="";"":$L(%1),1:%3-2) F %2=1:1:%3 S Y=$A(%1,%2)*(%2+%)+Y"
+9 SET X=RNT
XECUTE RSUM
SET CLSUM=Y
KILL X
+10 SET VERSION=$PIECE(SL,";",3)
+11 SET PACKAGE=$PIECE(SL,";",4)
IF PACKAGE=""
SET PACKAGE="UNKNOWN"
+12 SET PACKAGE=($TRANSLATE(PACKAGE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
+13 SET PAT=$PIECE(SL,";",5)
+14 SET PAT=$TRANSLATE(PAT,"**","")
+15 SET SL=0
+16 ;S RNTID=$O(^visn.vRoutineI("RtnNameIndex",RNT,0))
+17 ;I RNTID'>0 S RN=##CLASS(visn.vRoutine).%New() ; add new record because it isn't there
+18 ;E S RN=##CLASS(visn.vRoutine).%OpenId(RNTID) ;it here so your bring into memory
+19 ;S RN.RtnName=RNT
+20 ;S RN.RtnVersion=VERSION
+21 ;S RN.RtnPatch=PAT
+22 ;S RN.RtnCksum=CLSUM
+23 ;S RN.RtnSize=SIZE
+24 ;S RN.RtnApplication=PACKAGE
+25 ;Do RN.%Save()
+26 ;Do RN.%Close()
+27 WRITE !,RNT_"^"_VERSION_"^"_PAT_"^"_CLSUM_"^"_PACKAGE
+28 KILL RN
+29 QUIT
End DoDot:1
EXIT KILL SIZE,SL,RNT,VERSION,PACKAGE,PAT,RN,APP,CLSUM,RSUM,Y
+1 QUIT
