1 | NURSDFFS ;HIRMFO/RM-FILE FIELD STRUCTURES FOR NURSING FILES ;AUGUST 1986
|
---|
2 | ;;4.0;NURSING SERVICE;;Apr 25, 1997
|
---|
3 | Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
|
---|
4 | D DT^DICRW S NURQUEUE=0
|
---|
5 | W ! S ZTRTN="EN1^NURSDFFS" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
|
---|
6 | EN1 ; ENTRY TO BEGIN PRINTING
|
---|
7 | S IOP=ION D ^%ZIS K IOP U IO
|
---|
8 | F NURSFILE=209.99999:0 S NURSFILE=$O(^DIC(NURSFILE)) Q:NURSFILE'<220!(NURSFILE="") S STACK=1,NURSPACE="",NURSPAGE=1,NURSLINE=0 D PRNTFLDS
|
---|
9 | QUIT D CLOSE^NURSUT1,^NURSKILL
|
---|
10 | Q
|
---|
11 | PRNTFLDS ; PRINTS LINES FOR FIELDS
|
---|
12 | D:(STACK=1)!(NURSLINE>55) HEADER
|
---|
13 | F NURSFLD=0:0 S NURSFLD=$O(^DD(NURSFILE,NURSFLD)) Q:NURSFLD'>0 D PRINTLN,POPSTACK,CKSUB
|
---|
14 | Q
|
---|
15 | CKSUB ; CHECKS FOR THE EXISTENCE OF SUB-FIELDS AND PRINTS THEM OUT (RECURSIVE)
|
---|
16 | S STACK=STACK+1,NURSPACE=" "_NURSPACE
|
---|
17 | 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
|
---|
18 | S STACK=STACK-1,NURSFLD=NURSFLD(STACK),NURSFILE=NURSFILE(STACK),NURSPACE=$E(NURSPACE,8,$L(NURSPACE))
|
---|
19 | K NURSFLD(STACK),NURSFILE(STACK)
|
---|
20 | Q
|
---|
21 | PRINTLN ; PRINT A LINE
|
---|
22 | D FIELD^DID(NURSFILE,NURSFLD,"","LABEL","NURSFLNM","") S NURSLINE=NURSLINE+1
|
---|
23 | W !,NURSPACE_NURSFLD_$E(" ",1,7-$L(NURSFLD))_NURSFLNM("LABEL")
|
---|
24 | Q
|
---|
25 | POPSTACK ; ADD ONE MORE ITEM TO STACK
|
---|
26 | S NURSFLD(STACK)=NURSFLD,NURSFILE(STACK)=NURSFILE
|
---|
27 | Q
|
---|
28 | HEADER ; PRINT HEADING FOR EACH FILE
|
---|
29 | I '$D(NURSFILE(1)) S NURSFIL1=NURSFILE
|
---|
30 | E S NURSFIL1=NURSFILE(1)
|
---|
31 | W @IOF
|
---|
32 | 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),!
|
---|
33 | S NURSLINE=0,NURSPAGE=NURSPAGE+1
|
---|
34 | Q
|
---|