- 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
