source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURSDFFS.m@ 901

Last change on this file since 901 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1NURSDFFS ;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
6EN1 ; 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
9QUIT D CLOSE^NURSUT1,^NURSKILL
10 Q
11PRNTFLDS ; 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
15CKSUB ; 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
21PRINTLN ; 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
25POPSTACK ; ADD ONE MORE ITEM TO STACK
26 S NURSFLD(STACK)=NURSFLD,NURSFILE(STACK)=NURSFILE
27 Q
28HEADER ; 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
Note: See TracBrowser for help on using the repository browser.