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  Sep 23, 2025@20:20:51                                                                                                                                                                                                      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