- %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