DGYMFIL2.m

DGYMFIL2 ;ALB/MLI - Set File Access Codes for MAS files ; October 20, 1994

 ;;5.3;Registration;**49**;Aug 13, 1993

 ;

 ; This routine will loop through the MAS files and show the site's

 ; existing file access and the recommended file access.

 ;

PRINT ; generate listing of existing vs recommended file access

 N BRKLINE,FLAG,I,LINE,PAGE,X

 S (FLAG,PAGE)=0,$P(LINE,"-",80)="",$P(BRKLINE,"- ",41)=""

 D HEADER I FLAG Q

 F I=1:1 S X=$P($T(FILES+I),";;",2) Q:X="QUIT"!FLAG  D

 . N CUR,REC ; cur=current, rec=recommended

 . S REC="@^d^"_$P(X,"^",2,5) ; recommended access (DD always @)

 . S CUR=$G(^DIC(+X,0,"DD"))_"^"_$G(^("RD"))_"^"_$G(^("WR"))_"^"_$G(^("DEL"))_"^"_$G(^("LAYGO"))

 . I $Y>(IOSL-4) D HEADER I FLAG Q

 . W !,$S(CUR=REC:" ",1:"*"),+X S X=$P($G(^DIC(+X,0)),"^",1) W ?8,$E(X,1,30) I $L(X)>30 W "..."

 . D WRITE(CUR) W ! ; write current access

 . I CUR=REC W ?43,"Currently meets recommended levels"

 . E  D WRITE(REC) ; write recommended access

 . W !,BRKLINE

 Q

 ;

 ;

WRITE(X) ; write out the access codes in columns

 ;

 ; input - X as string of dd^rd^wr^del^laygo access

 ;

 W ?43,$P(X,"^",1),?51,$P(X,"^",2),?57,$P(X,"^",3),?65,$P(X,"^",4),?75,$P(X,"^",5)

 Q

 ;

 ;

HEADER ; print header for comparison report

 N DIR,DIRUT,DTOUT,DUOUT,X,Y

 S PAGE=PAGE+1

 I $E(IOST,1,2)="C-",(PAGE>1) S DIR(0)="E" D ^DIR S FLAG='Y I FLAG Q

 W @IOF,!?29,"MAS File Access Report",?70,"PAGE:  ",$J(PAGE,2)

 W !!," File",?8,"File",?54,"File Access Type"

 W !," Number",?8,"Name",?43,"DD",?49,"Read",?55,"Write",?63,"Delete",?73,"Laygo"

 W !,LINE

 Q

 ;

 ;

LOAD ; load files into TMP global

 F I=1:1 S X=$P($T(FILES+I),";;",2) Q:X="QUIT"  S ^TMP($J,"DGYMFILE",+X)=X

 Q

 ;

FILES ; list of file numbers and names for MAS files w/recommended access

 ;;2^D^@^D

 ;;5^@^@^@

 ;;8^@^@^@

 ;;8.1^@^@^@

 ;;8.2^@^@^@

 ;;10^@^@^@

 ;;11^@^@^@

 ;;13^@^@^@

 ;;21^@^@^@

 ;;22^@^@^@

 ;;23^@^@^@

 ;;25^@^@^@

 ;;30^@^@^@

 ;;35^@^@^@

 ;;37^@^@^@

 ;;38.1^D^@^D

 ;;38.5^@^@^@

 ;;38.6^@^@^@

 ;;39.1^@^@^@

 ;;39.2^@^@^@

 ;;39.3^@^@^@

 ;;40.1^@^D^@

 ;;40.15^D^D^D

 ;;40.7^@^@^@

 ;;40.8^@^@^@

 ;;40.9^@^@^@

 ;;41.1^D^D^D

 ;;41.9^@^@^@

 ;;42^D^@^D

 ;;42.4^@^@^@

 ;;42.5^D^D^D

 ;;42.55^@^@^@

 ;;42.6^D^D^D

 ;;42.7^D^D^D

 ;;43^D^@^@

 ;;43.1^D^D^D

 ;;43.11^D^D^D

 ;;43.4^@^@^@

 ;;43.5^D^D^D

 ;;43.61^@^@^@

 ;;43.7^@^@^@

 ;;44^D^@^D

 ;;45^D^@^@

 ;;45.1^@^@^@

 ;;45.2^D^@^D

 ;;45.3^@^@^@

 ;;45.4^@^@^@

 ;;45.5^@^@^@

 ;;45.6^@^@^@

 ;;45.61^@^@^@

 ;;45.62^@^@^@

 ;;45.64^@^@^@

 ;;45.7^D^@^D

 ;;45.81^@^@^@

 ;;45.82^@^@^@

 ;;45.83^@^@^@

 ;;45.84^@^@^@

 ;;45.85^D^@^@

 ;;45.86^@^@^@

 ;;45.87^@^@^@

 ;;45.88^@^@^@

 ;;45.89^@^@^@

 ;;45.9^D^D^D

 ;;45.91^@^@^@

 ;;47^@^@^@

 ;;48^D^@^@

 ;;48.5^@^@^@

 ;;389.9^@^@^@

 ;;391^@^@^@

 ;;391.1^@^@^@

 ;;391.51^@^@^@

 ;;392^@^@^@

 ;;392.1^D^D^D

 ;;392.2^D^D^D

 ;;392.3^@^@^@

 ;;392.4^D^@^D

 ;;393^D^D^D

 ;;393.1^@^@^@

 ;;393.2^@^@^@

 ;;393.3^@^@^@

 ;;393.41^@^@^@

 ;;405^@^@^@

 ;;405.1^D^@^D

 ;;405.2^@^@^@

 ;;405.3^@^@^@

 ;;405.4^D^@^D

 ;;405.5^@^@^@

 ;;405.6^D^@^D

 ;;406.41^D^@^D

 ;;407.5^D^D^D

 ;;407.6^@^@^@

 ;;407.7^@^@^@

 ;;408^@^@^@

 ;;408.11^@^@^@

 ;;408.12^@^@^@

 ;;408.13^@^@^@

 ;;408.21^@^@^@

 ;;408.22^@^@^@

 ;;408.31^@^@^@

 ;;408.32^@^@^@

 ;;408.33^@^@^@

 ;;408.34^@^@^@

 ;;408.41^@^@^@

 ;;408.42^@^@^@

 ;;409.1^@^@^@

 ;;409.2^@^@^@

 ;;409.3^D^D^D

 ;;409.41^@^@^@

 ;;409.42^D^D^D

 ;;409.43^D^D^D

 ;;409.44^D^D^D

 ;;409.45^@^@^@

 ;;409.5^D^D^D

 ;;409.61^@^@^@

 ;;409.62^@^@^@

 ;;409.63^@^@^@

 ;;409.65^@^@^@

 ;;409.66^@^@^@

 ;;409.68^@^@^@

 ;;409.71^D^@^D

 ;;409.72^D^D^D

 ;;409.81^@^@^@

 ;;409.82^D^D^D

 ;;QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGYMFIL2   3685     printed  Apr 09, 2024@21:55:14                                                                                                                                                                                                    Page 2

DGYMFIL2  ;ALB/MLI - Set File Access Codes for MAS files ; October 20, 1994

 +1       ;;5.3;Registration;**49**;Aug 13, 1993

 +2       ;

 +3       ; This routine will loop through the MAS files and show the site's

 +4       ; existing file access and the recommended file access.

 +5       ;

PRINT     ; generate listing of existing vs recommended file access

 +1        NEW BRKLINE,FLAG,I,LINE,PAGE,X

 +2        SET (FLAG,PAGE)=0

           SET $PIECE(LINE,"-",80)=""

           SET $PIECE(BRKLINE,"- ",41)=""

 +3        DO HEADER

           IF FLAG

               QUIT 

 +4        FOR I=1:1

               SET X=$PIECE($TEXT(FILES+I),";;",2)

               if X="QUIT"!FLAG

                   QUIT 

               Begin DoDot:1

 +5       ; cur=current, rec=recommended

                   NEW CUR,REC

 +6       ; recommended access (DD always @)

                   SET REC="@^d^"_$PIECE(X,"^",2,5)

 +7                SET CUR=$GET(^DIC(+X,0,"DD"))_"^"_$GET(^("RD"))_"^"_$GET(^("WR"))_"^"_$GET(^("DEL"))_"^"_$GET(^("LAYGO"))

 +8                IF $Y>(IOSL-4)

                       DO HEADER

                       IF FLAG

                           QUIT 

 +9                WRITE !,$SELECT(CUR=REC:" ",1:"*"),+X

                   SET X=$PIECE($GET(^DIC(+X,0)),"^",1)

                   WRITE ?8,$EXTRACT(X,1,30)

                   IF $LENGTH(X)>30

                       WRITE "..."

 +10      ; write current access

                   DO WRITE(CUR)

                   WRITE !

 +11               IF CUR=REC

                       WRITE ?43,"Currently meets recommended levels"

 +12      ; write recommended access

                  IF '$TEST

                       DO WRITE(REC)

 +13               WRITE !,BRKLINE

               End DoDot:1

 +14       QUIT 

 +15      ;

 +16      ;

WRITE(X)  ; write out the access codes in columns

 +1       ;

 +2       ; input - X as string of dd^rd^wr^del^laygo access

 +3       ;

 +4        WRITE ?43,$PIECE(X,"^",1),?51,$PIECE(X,"^",2),?57,$PIECE(X,"^",3),?65,$PIECE(X,"^",4),?75,$PIECE(X,"^",5)

 +5        QUIT 

 +6       ;

 +7       ;

HEADER    ; print header for comparison report

 +1        NEW DIR,DIRUT,DTOUT,DUOUT,X,Y

 +2        SET PAGE=PAGE+1

 +3        IF $EXTRACT(IOST,1,2)="C-"

               IF (PAGE>1)

                   SET DIR(0)="E"

                   DO ^DIR

                   SET FLAG='Y

                   IF FLAG

                       QUIT 

 +4        WRITE @IOF,!?29,"MAS File Access Report",?70,"PAGE:  ",$JUSTIFY(PAGE,2)

 +5        WRITE !!," File",?8,"File",?54,"File Access Type"

 +6        WRITE !," Number",?8,"Name",?43,"DD",?49,"Read",?55,"Write",?63,"Delete",?73,"Laygo"

 +7        WRITE !,LINE

 +8        QUIT 

 +9       ;

 +10      ;

LOAD      ; load files into TMP global

 +1        FOR I=1:1

               SET X=$PIECE($TEXT(FILES+I),";;",2)

               if X="QUIT"

                   QUIT 

               SET ^TMP($JOB,"DGYMFILE",+X)=X

 +2        QUIT 

 +3       ;

FILES     ; list of file numbers and names for MAS files w/recommended access

 +1       ;;2^D^@^D

 +2       ;;5^@^@^@

 +3       ;;8^@^@^@

 +4       ;;8.1^@^@^@

 +5       ;;8.2^@^@^@

 +6       ;;10^@^@^@

 +7       ;;11^@^@^@

 +8       ;;13^@^@^@

 +9       ;;21^@^@^@

 +10      ;;22^@^@^@

 +11      ;;23^@^@^@

 +12      ;;25^@^@^@

 +13      ;;30^@^@^@

 +14      ;;35^@^@^@

 +15      ;;37^@^@^@

 +16      ;;38.1^D^@^D

 +17      ;;38.5^@^@^@

 +18      ;;38.6^@^@^@

 +19      ;;39.1^@^@^@

 +20      ;;39.2^@^@^@

 +21      ;;39.3^@^@^@

 +22      ;;40.1^@^D^@

 +23      ;;40.15^D^D^D

 +24      ;;40.7^@^@^@

 +25      ;;40.8^@^@^@

 +26      ;;40.9^@^@^@

 +27      ;;41.1^D^D^D

 +28      ;;41.9^@^@^@

 +29      ;;42^D^@^D

 +30      ;;42.4^@^@^@

 +31      ;;42.5^D^D^D

 +32      ;;42.55^@^@^@

 +33      ;;42.6^D^D^D

 +34      ;;42.7^D^D^D

 +35      ;;43^D^@^@

 +36      ;;43.1^D^D^D

 +37      ;;43.11^D^D^D

 +38      ;;43.4^@^@^@

 +39      ;;43.5^D^D^D

 +40      ;;43.61^@^@^@

 +41      ;;43.7^@^@^@

 +42      ;;44^D^@^D

 +43      ;;45^D^@^@

 +44      ;;45.1^@^@^@

 +45      ;;45.2^D^@^D

 +46      ;;45.3^@^@^@

 +47      ;;45.4^@^@^@

 +48      ;;45.5^@^@^@

 +49      ;;45.6^@^@^@

 +50      ;;45.61^@^@^@

 +51      ;;45.62^@^@^@

 +52      ;;45.64^@^@^@

 +53      ;;45.7^D^@^D

 +54      ;;45.81^@^@^@

 +55      ;;45.82^@^@^@

 +56      ;;45.83^@^@^@

 +57      ;;45.84^@^@^@

 +58      ;;45.85^D^@^@

 +59      ;;45.86^@^@^@

 +60      ;;45.87^@^@^@

 +61      ;;45.88^@^@^@

 +62      ;;45.89^@^@^@

 +63      ;;45.9^D^D^D

 +64      ;;45.91^@^@^@

 +65      ;;47^@^@^@

 +66      ;;48^D^@^@

 +67      ;;48.5^@^@^@

 +68      ;;389.9^@^@^@

 +69      ;;391^@^@^@

 +70      ;;391.1^@^@^@

 +71      ;;391.51^@^@^@

 +72      ;;392^@^@^@

 +73      ;;392.1^D^D^D

 +74      ;;392.2^D^D^D

 +75      ;;392.3^@^@^@

 +76      ;;392.4^D^@^D

 +77      ;;393^D^D^D

 +78      ;;393.1^@^@^@

 +79      ;;393.2^@^@^@

 +80      ;;393.3^@^@^@

 +81      ;;393.41^@^@^@

 +82      ;;405^@^@^@

 +83      ;;405.1^D^@^D

 +84      ;;405.2^@^@^@

 +85      ;;405.3^@^@^@

 +86      ;;405.4^D^@^D

 +87      ;;405.5^@^@^@

 +88      ;;405.6^D^@^D

 +89      ;;406.41^D^@^D

 +90      ;;407.5^D^D^D

 +91      ;;407.6^@^@^@

 +92      ;;407.7^@^@^@

 +93      ;;408^@^@^@

 +94      ;;408.11^@^@^@

 +95      ;;408.12^@^@^@

 +96      ;;408.13^@^@^@

 +97      ;;408.21^@^@^@

 +98      ;;408.22^@^@^@

 +99      ;;408.31^@^@^@

 +100     ;;408.32^@^@^@

 +101     ;;408.33^@^@^@

 +102     ;;408.34^@^@^@

 +103     ;;408.41^@^@^@

 +104     ;;408.42^@^@^@

 +105     ;;409.1^@^@^@

 +106     ;;409.2^@^@^@

 +107     ;;409.3^D^D^D

 +108     ;;409.41^@^@^@

 +109     ;;409.42^D^D^D

 +110     ;;409.43^D^D^D

 +111     ;;409.44^D^D^D

 +112     ;;409.45^@^@^@

 +113     ;;409.5^D^D^D

 +114     ;;409.61^@^@^@

 +115     ;;409.62^@^@^@

 +116     ;;409.63^@^@^@

 +117     ;;409.65^@^@^@

 +118     ;;409.66^@^@^@

 +119     ;;409.68^@^@^@

 +120     ;;409.71^D^@^D

 +121     ;;409.72^D^D^D

 +122     ;;409.81^@^@^@

 +123     ;;409.82^D^D^D

 +124     ;;QUIT