AUDIC.m

%AUDIC ;PRINT IHS DICTIONARY LIST [ 02/18/88  9:33 AM ]

 ;IHS-OKLA CITY AREA OFFICE-LMD

L1 G QUE

L2 K MGIO S PG=0 S:$D(AU("PRINT")) MGIO=+$I S IOP=IO D ^%ZIS U IO D HEADING

L4 W !! S D=0

L5 S D=$O(^DIC(D)) G L6:D]"@" W ?10,D,?25,$P(^DIC(D,0),"^",1),?60,^DIC(D,0,"GL"),! D HEADING:$Y>50 H .5 G L5

L6 I $D(MGIO),(MGIO=IO) K MG,MGIO Q

END W # X ^%ZIS("C") K MG,MGIO Q

HEADING S PG=PG+1,TITLE="I.H.S.  DICTIONARY LIST",TM=$P($H,",",2),HR=TM\3600,MIN=TM#3600\60 S:MIN<10 MIN="0"_MIN S TME=HR_":"_MIN,USER=""

 W #,!!,TME,?80-$L(TITLE)\2,TITLE,?72,"page ",PG,!,?80-$L(^DD("SITE"))\2,^DD("SITE"),!

 I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y

UCI X ^%ZOSF("UCI") S MG("UCI")="UCI: "_$P(Y,",",1) W ?80-$L(MG("UCI"))\2,MG("UCI")

 S Y=DT X ^DD("DD") W !!,?80-$L("as of "_Y)\2,"as of ",Y,!!

H3 W ?10,"FILE #",?25,"FILE NAME",?60,"GLOBAL NAME",! F I=1:1:78 W "="

 W ! Q

PRQ ;

PRQ1 S:$D(^%ZTSK(ZTSK,"SITE")) DUZ(2)=^%ZTSK(ZTSK,"SITE") S U="^" K ^%ZTSK(ZTSK) G L2

QUE S:'$D(DUZ) DUZ=0 D ^%AUQUE G L2:$D(AU("PRINT")) Q:'$D(AU("QUE"))

QUE1 S ^%ZTSK(ZTSK,0)="PRQ^%AUDIC"_^%ZTSK(ZTSK,0)

QUEEND K ZTSK Q

%AUDIC    ;PRINT IHS DICTIONARY LIST [ 02/18/88  9:33 AM ]

 +1       ;IHS-OKLA CITY AREA OFFICE-LMD

L1         GOTO QUE

L2         KILL MGIO

           SET PG=0

           IF $DATA(AU("PRINT"))

               SET MGIO=+$IO

           SET IOP=IO

           DO ^%ZIS

           USE IO

           DO HEADING

L4         WRITE !!

           SET D=0

L5         SET D=$ORDER(^DIC(D))

           IF D]"@"

               GOTO L6

           WRITE ?10,D,?25,$PIECE(^DIC(D,0),"^",1),?60,^DIC(D,0,"GL"),!

           IF $Y>50

               DO HEADING

           HANG .5

           GOTO L5

L6         IF $DATA(MGIO)

               IF (MGIO=IO)

                   KILL MG,MGIO

                   QUIT 

END        WRITE #

           XECUTE ^%ZIS("C")

           KILL MG,MGIO

           QUIT 

HEADING    SET PG=PG+1

           SET TITLE="I.H.S.  DICTIONARY LIST"

           SET TM=$PIECE($HOROLOG,",",2)

           SET HR=TM\3600

           SET MIN=TM#3600\60

           IF MIN<10

               SET MIN="0"_MIN

           SET TME=HR_":"_MIN

           SET USER=""

 +1        WRITE #,!!,TME,?80-$LENGTH(TITLE)\2,TITLE,?72,"page ",PG,!,?80-$LENGTH(^DD("SITE"))\2,^DD("SITE"),!

 +2        IF '$DATA(DT)

               SET %DT=""

               SET X="T"

               DO ^%DT

               SET DT=Y

UCI        XECUTE ^%ZOSF("UCI")

           SET MG("UCI")="UCI: "_$PIECE(Y,",",1)

           WRITE ?80-$LENGTH(MG("UCI"))\2,MG("UCI")

 +1        SET Y=DT

           XECUTE ^DD("DD")

           WRITE !!,?80-$LENGTH("as of "_Y)\2,"as of ",Y,!!

H3         WRITE ?10,"FILE #",?25,"FILE NAME",?60,"GLOBAL NAME",!

           FOR I=1:1:78

               WRITE "="

 +1        WRITE !

           QUIT 

PRQ       ;

PRQ1       IF $DATA(^%ZTSK(ZTSK,"SITE"))

               SET DUZ(2)=^%ZTSK(ZTSK,"SITE")

           SET U="^"

           KILL ^%ZTSK(ZTSK)

           GOTO L2

QUE        IF '$DATA(DUZ)

               SET DUZ=0

           DO ^%AUQUE

           IF $DATA(AU("PRINT"))

               GOTO L2

           IF '$DATA(AU("QUE"))

               QUIT 

QUE1       SET ^%ZTSK(ZTSK,0)="PRQ^%AUDIC"_^%ZTSK(ZTSK,0)

QUEEND     KILL ZTSK

           QUIT