NURSDFFS ;HIRMFO/RM-FILE FIELD STRUCTURES FOR NURSING FILES ;AUGUST 1986
;;4.0;NURSING SERVICE;;Apr 25, 1997
Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
D DT^DICRW S NURQUEUE=0
W ! S ZTRTN="EN1^NURSDFFS" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
EN1 ; ENTRY TO BEGIN PRINTING
S IOP=ION D ^%ZIS K IOP U IO
F NURSFILE=209.99999:0 S NURSFILE=$O(^DIC(NURSFILE)) Q:NURSFILE'<220!(NURSFILE="") S STACK=1,NURSPACE="",NURSPAGE=1,NURSLINE=0 D PRNTFLDS
QUIT D CLOSE^NURSUT1,^NURSKILL
Q
PRNTFLDS ; PRINTS LINES FOR FIELDS
D:(STACK=1)!(NURSLINE>55) HEADER
F NURSFLD=0:0 S NURSFLD=$O(^DD(NURSFILE,NURSFLD)) Q:NURSFLD'>0 D PRINTLN,POPSTACK,CKSUB
Q
CKSUB ; CHECKS FOR THE EXISTENCE OF SUB-FIELDS AND PRINTS THEM OUT (RECURSIVE)
S STACK=STACK+1,NURSPACE=" "_NURSPACE
F NURSFILE=NURSFILE:0 S NURSFILE=$O(^DD(NURSFILE(STACK-1),"SB",NURSFILE)) Q:NURSFILE'>0 S NURSFLD=$O(^DD(NURSFILE(STACK-1),"SB",NURSFILE,"")) I NURSFLD=NURSFLD(STACK-1) D PRNTFLDS
S STACK=STACK-1,NURSFLD=NURSFLD(STACK),NURSFILE=NURSFILE(STACK),NURSPACE=$E(NURSPACE,8,$L(NURSPACE))
K NURSFLD(STACK),NURSFILE(STACK)
Q
PRINTLN ; PRINT A LINE
D FIELD^DID(NURSFILE,NURSFLD,"","LABEL","NURSFLNM","") S NURSLINE=NURSLINE+1
W !,NURSPACE_NURSFLD_$E(" ",1,7-$L(NURSFLD))_NURSFLNM("LABEL")
Q
POPSTACK ; ADD ONE MORE ITEM TO STACK
S NURSFLD(STACK)=NURSFLD,NURSFILE(STACK)=NURSFILE
Q
I '$D(NURSFILE(1)) S NURSFIL1=NURSFILE
E S NURSFIL1=NURSFILE(1)
W @IOF
W !!,$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),?22,"FILE FIELD STRUCTURE FOR FILE #"_NURSFIL1,?70,"PAGE: ",NURSPAGE,!,$$REPEAT^XLFSTR("-",80),!
S NURSLINE=0,NURSPAGE=NURSPAGE+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSDFFS 1696 printed Nov 22, 2024@17:32 Page 2
NURSDFFS ;HIRMFO/RM-FILE FIELD STRUCTURES FOR NURSING FILES ;AUGUST 1986
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
+2 if '$DATA(^DIC(213.9,1,"OFF"))
QUIT
if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
QUIT
+3 DO DT^DICRW
SET NURQUEUE=0
+4 WRITE !
SET ZTRTN="EN1^NURSDFFS"
DO EN7^NURSUT0
if POP!($DATA(ZTSK))
GOTO QUIT
EN1 ; ENTRY TO BEGIN PRINTING
+1 SET IOP=ION
DO ^%ZIS
KILL IOP
USE IO
+2 FOR NURSFILE=209.99999:0
SET NURSFILE=$ORDER(^DIC(NURSFILE))
if NURSFILE'<220!(NURSFILE="")
QUIT
SET STACK=1
SET NURSPACE=""
SET NURSPAGE=1
SET NURSLINE=0
DO PRNTFLDS
QUIT DO CLOSE^NURSUT1
DO ^NURSKILL
+1 QUIT
PRNTFLDS ; PRINTS LINES FOR FIELDS
+1 if (STACK=1)!(NURSLINE>55)
DO HEADER
+2 FOR NURSFLD=0:0
SET NURSFLD=$ORDER(^DD(NURSFILE,NURSFLD))
if NURSFLD'>0
QUIT
DO PRINTLN
DO POPSTACK
DO CKSUB
+3 QUIT
CKSUB ; CHECKS FOR THE EXISTENCE OF SUB-FIELDS AND PRINTS THEM OUT (RECURSIVE)
+1 SET STACK=STACK+1
SET NURSPACE=" "_NURSPACE
+2 FOR NURSFILE=NURSFILE:0
SET NURSFILE=$ORDER(^DD(NURSFILE(STACK-1),"SB",NURSFILE))
if NURSFILE'>0
QUIT
SET NURSFLD=$ORDER(^DD(NURSFILE(STACK-1),"SB",NURSFILE,""))
IF NURSFLD=NURSFLD(STACK-1)
DO PRNTFLDS
+3 SET STACK=STACK-1
SET NURSFLD=NURSFLD(STACK)
SET NURSFILE=NURSFILE(STACK)
SET NURSPACE=$EXTRACT(NURSPACE,8,$LENGTH(NURSPACE))
+4 KILL NURSFLD(STACK),NURSFILE(STACK)
+5 QUIT
PRINTLN ; PRINT A LINE
+1 DO FIELD^DID(NURSFILE,NURSFLD,"","LABEL","NURSFLNM","")
SET NURSLINE=NURSLINE+1
+2 WRITE !,NURSPACE_NURSFLD_$EXTRACT(" ",1,7-$LENGTH(NURSFLD))_NURSFLNM("LABEL")
+3 QUIT
POPSTACK ; ADD ONE MORE ITEM TO STACK
+1 SET NURSFLD(STACK)=NURSFLD
SET NURSFILE(STACK)=NURSFILE
+2 QUIT
+1 IF '$DATA(NURSFILE(1))
SET NURSFIL1=NURSFILE
+2 IF '$TEST
SET NURSFIL1=NURSFILE(1)
+3 WRITE @IOF
+4 WRITE !!,$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3),?22,"FILE FIELD STRUCTURE FOR FILE #"_NURSFIL1,?70,"PAGE: ",NURSPAGE,!,$$REPEAT^XLFSTR("-",80),!
+5 SET NURSLINE=0
SET NURSPAGE=NURSPAGE+1
+6 QUIT
