FHZDOC1.m

FHZDOC1 ; HISC/REL - First Line Listing ;8/2/90  15:19 

 ;;5.5;DIETETICS;;Jan 28, 2005

 S X="N",%DT="XT" D ^%DT S DTP=Y D DTP^FH

 W !,"Routine First-line List",!!

GET W ! D ^%ZIS Q:POP  K %UTILITY D ^%RSEL

 S NAM="" G:$O(%UTILITY(NAM))="" DONE

 U IO W @IOF,!?22,"First line list of DIETETIC Programs",!?31,DTP,!!

GO S NAM=$O(%UTILITY(NAM)) G:NAM="" DONE

 X "ZL @NAM S X=$T(+1)" S N=$P(X,"-",2,99),N=$P(N,";",1) W $P(X," ",1),?10,N,! W:$Y>60 @IOF G GO

DONE U IO(0) S IOP="" D ^%ZIS Q

FHZDOC1   ; HISC/REL - First Line Listing ;8/2/90  15:19 

 +1       ;;5.5;DIETETICS;;Jan 28, 2005

 +2        SET X="N"

           SET %DT="XT"

           DO ^%DT

           SET DTP=Y

           DO DTP^FH

 +3        WRITE !,"Routine First-line List",!!

GET        WRITE !

           DO ^%ZIS

           IF POP

               QUIT 

           KILL %UTILITY

           DO ^%RSEL

 +1        SET NAM=""

           IF $ORDER(%UTILITY(NAM))=""

               GOTO DONE

 +2        USE IO

           WRITE @IOF,!?22,"First line list of DIETETIC Programs",!?31,DTP,!!

GO         SET NAM=$ORDER(%UTILITY(NAM))

           IF NAM=""

               GOTO DONE

 +1        XECUTE "ZL @NAM S X=$T(+1)"

           SET N=$PIECE(X,"-",2,99)

           SET N=$PIECE(N,";",1)

           WRITE $PIECE(X," ",1),?10,N,!

           IF $Y>60

               WRITE @IOF

           GOTO GO

DONE       USE IO(0)

           SET IOP=""

           DO ^%ZIS

           QUIT