NURSDD.m

NURSDD ;HIRMFO/RM-THIS ROUTINE PRINTS OUT DD'S FOR NURSING FILES ;12/30/87

 ;;4.0;NURSING SERVICE;;Apr 25, 1997

 ;LAST MODIFIED BY RM;12/30/87

 Q:'$D(^DIC(213.9,1,"OFF"))  Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1

 S X="DID" X ^%ZOSF("TEST") Q:'$T

 D DT^DICRW S NURQUEUE=0

DEV S %ZIS="Q" D ^%ZIS K %ZIS K:POP IO("Q") G:POP QUIT I '($E(IOST)="P"),'$D(IO("Q")) S XQH="NURS-PRINTER QUEUE" W $C(7) D EN^XQH D ^%ZISC G DEV

 S NURQUEUE=0 I $D(IO("Q")) K IO("Q"),IO("C") S NURQUEUE=1,ZTDESC="Nursing DD Listing",ZTRTN="LATER^NURSDD",ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL D ^%ZTLOAD S NURQUEUE=0

 Q

LATER S NURSION=ION

 F NURSFILE=209.99999:0 S NURSFILE=$O(^DIC(NURSFILE)) Q:NURSFILE'<220!(NURSFILE="")  D SETVAR,EN^DID

QUIT ; KILL LOCAL VARIABLES

 S:$G(POP) NUROUT=1 D CLOSE^NURSUT1,^NURSKILL

 Q

SETVAR ; SETS VARIABLES TO PRINT DD

 S DIC=NURSFILE,DIFORMAT=1,IOP=ION

 Q

NURSDD    ;HIRMFO/RM-THIS ROUTINE PRINTS OUT DD'S FOR NURSING FILES ;12/30/87

 +1       ;;4.0;NURSING SERVICE;;Apr 25, 1997

 +2       ;LAST MODIFIED BY RM;12/30/87

 +3        IF '$DATA(^DIC(213.9,1,"OFF"))

               QUIT 

           IF $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1

               QUIT 

 +4        SET X="DID"

           XECUTE ^%ZOSF("TEST")

           IF '$TEST

               QUIT 

 +5        DO DT^DICRW

           SET NURQUEUE=0

DEV        SET %ZIS="Q"

           DO ^%ZIS

           KILL %ZIS

           IF POP

               KILL IO("Q")

           IF POP

               GOTO QUIT

           IF '($EXTRACT(IOST)="P")

               IF '$DATA(IO("Q"))

                   SET XQH="NURS-PRINTER QUEUE"

                   WRITE $CHAR(7)

                   DO EN^XQH

                   DO ^%ZISC

                   GOTO DEV

 +1        SET NURQUEUE=0

           IF $DATA(IO("Q"))

               KILL IO("Q"),IO("C")

               SET NURQUEUE=1

               SET ZTDESC="Nursing DD Listing"

               SET ZTRTN="LATER^NURSDD"

               SET ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL

               DO ^%ZTLOAD

               SET NURQUEUE=0

 +2        QUIT 

LATER      SET NURSION=ION

 +1        FOR NURSFILE=209.99999:0

               SET NURSFILE=$ORDER(^DIC(NURSFILE))

               IF NURSFILE'<220!(NURSFILE="")

                   QUIT 

               DO SETVAR

               DO EN^DID

QUIT      ; KILL LOCAL VARIABLES

 +1        IF $GET(POP)

               SET NUROUT=1

           DO CLOSE^NURSUT1

           DO ^NURSKILL

 +2        QUIT 

SETVAR    ; SETS VARIABLES TO PRINT DD

 +1        SET DIC=NURSFILE

           SET DIFORMAT=1

           SET IOP=ION

 +2        QUIT