AZGSAV1M.m

AZGSAV1M ;RPMS/TJF/MLQ MOVE GLOBAL ENTERIES TO UNIX FILE  

 ;;1.4;AUGS;*0*;OCT 16, 1991

 U %DEV W AUDT,!,AUTLE,! S GO=AUGL

Z S:'$D(AUF) AUF="" S A=AUF,(B,C,D,E,F,G,H)=""

1 S A=$O(@(GO_"A)")) G END:A="" I $D(AUE) G END:A>AUE

 I $D(^(A))#2 S S=A D SB1

2 S B=$O(@(GO_"A,B)")) G 1:B="" I $D(^(B))#2 S S=B D SB1

3 S C=$O(@(GO_"A,B,C)")) G 2:C="" I $D(^(C))#2 S S=C D SB1

4 S D=$O(@(GO_"A,B,C,D)")) G 3:D="" I $D(^(D))#2 S S=D D SB1

5 S E=$O(@(GO_"A,B,C,D,E)")) G 4:E="" I $D(^(E))#2 S S=E D SB1

6 S F=$O(@(GO_"A,B,C,D,E,F)")) G 5:F="" I $D(^(F))#2 S S=F D SB1

7 S G=$O(@(GO_"A,B,C,D,E,F,G)")) G 6:G="" I $D(^(G))#2 S S=G D SB1

8 S H=$O(@(GO_"A,B,C,D,E,F,G,H)")) G 7:H="" I $D(^(H))#2 S S=H D SB1

 G 8

END W "**",!,"**",!!

 K A,B,C,D,E,F,G,H,S,X,GO,EDE,I,SS,AUF,AUE,DATA

 Q

SB1 S EDE=GO F I=65:1:72 S X=$C(I),SS=0 Q:'$D(@X)  Q:@X=""  S @("SS="_X_"'=+"_X) S:I>65 EDE=EDE_"," S:SS EDE=EDE_"""" S EDE=EDE_@X S:SS EDE=EDE_""""

 S DATA=^(S)

 W EDE_")",!,DATA,!

 Q

AZGSAV1M  ;RPMS/TJF/MLQ MOVE GLOBAL ENTERIES TO UNIX FILE  

 +1       ;;1.4;AUGS;*0*;OCT 16, 1991

 +2        USE %DEV

           WRITE AUDT,!,AUTLE,!

           SET GO=AUGL

Z          IF '$DATA(AUF)

               SET AUF=""

           SET A=AUF

           SET (B,C,D,E,F,G,H)=""

1          SET A=$ORDER(@(GO_"A)"))

           IF A=""

               GOTO END

           IF $DATA(AUE)

               IF A>AUE

                   GOTO END

 +1        IF $DATA(^(A))#2

               SET S=A

               DO SB1

2          SET B=$ORDER(@(GO_"A,B)"))

           IF B=""

               GOTO 1

           IF $DATA(^(B))#2

               SET S=B

               DO SB1

3          SET C=$ORDER(@(GO_"A,B,C)"))

           IF C=""

               GOTO 2

           IF $DATA(^(C))#2

               SET S=C

               DO SB1

4          SET D=$ORDER(@(GO_"A,B,C,D)"))

           IF D=""

               GOTO 3

           IF $DATA(^(D))#2

               SET S=D

               DO SB1

5          SET E=$ORDER(@(GO_"A,B,C,D,E)"))

           IF E=""

               GOTO 4

           IF $DATA(^(E))#2

               SET S=E

               DO SB1

6          SET F=$ORDER(@(GO_"A,B,C,D,E,F)"))

           IF F=""

               GOTO 5

           IF $DATA(^(F))#2

               SET S=F

               DO SB1

7          SET G=$ORDER(@(GO_"A,B,C,D,E,F,G)"))

           IF G=""

               GOTO 6

           IF $DATA(^(G))#2

               SET S=G

               DO SB1

8          SET H=$ORDER(@(GO_"A,B,C,D,E,F,G,H)"))

           IF H=""

               GOTO 7

           IF $DATA(^(H))#2

               SET S=H

               DO SB1

 +1        GOTO 8

END        WRITE "**",!,"**",!!

 +1        KILL A,B,C,D,E,F,G,H,S,X,GO,EDE,I,SS,AUF,AUE,DATA

 +2        QUIT 

SB1        SET EDE=GO

           FOR I=65:1:72

               SET X=$CHAR(I)

               SET SS=0

               IF '$DATA(@X)

                   QUIT 

               IF @X=""

                   QUIT 

               SET @("SS="_X_"'=+"_X)

               IF I>65

                   SET EDE=EDE_","

               IF SS

                   SET EDE=EDE_""""

               SET EDE=EDE_@X

               IF SS

                   SET EDE=EDE_""""

 +1        SET DATA=^(S)

 +2        WRITE EDE_")",!,DATA,!

 +3        QUIT