source: IHS-VA_UTILITIES-XB/trunk/XBDHDSV.m@ 1745

Last change on this file since 1745 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 3.0 KB
Line 
1XBDHDSV ; IHS/ADC/GTH - COMPILES HEADER INFO FOR AUTO ENTRY INTO DIP ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 I '$D(^TMP("XBDH",$J,"HEADER")) Q
5NEW ;
6 NEW XBDHC,XBDHHDX,DIRPIPE,XBDHI,XBDHLJ,XBDHLPTH,XBDHMORE,XBDHN,XBDHNN,XBDHL,XBDHPDFN,XBDHRJ,XBDHSTG,XBDHTPTH,XBDHWW,XBDHX,XBDHY,I,J,L,P,X,Y,BY,DALL,DIC,DIJ,DP,DPP,FR,IOP,IOX,IOY,TO,XBDHCHLW,XBDHPDNA,%
7INIT ;
8 S ^TMP("XBDH",$J,"HELPR",0)="]",^(99)="",X=^TMP("XBDH",$J,"HEADER"),XBDHCHLW=1,XBDHPDFN=$P(X,U),XBDHPDNA=$P(X,U,2),XBDHTHLW=$P(X,U,3),V="|"
9 KILL X
10 S XBDHLPTH="",(XBDHN,XBDHI)=0
11INCN ;
12 S XBDHN=XBDHN+1
13 G:'$D(^TMP("XBDH",$J,"HEADER",XBDHN)) CLOSE S XBDHX=^(XBDHN)
14 D MUMPS,PRELIM
15 S XBDHLPTH=XBDHTPTH
16 D NORMAL
17 G INCN
18 ;
19CLOSE ;
20 I XBDHTPTH]"" S X=$L(XBDHTPTH,";")-1,Y="" F X=1:1:X D SET
21 D STD
22 S DIR(0)="YO",DIR("A")="Want to make any more changes",DIR("B")="NO"
23 D ^DIR
24 KILL DIR
25 I Y=1 G EXIT
26 I Y=U S XBDHQUIT="" Q
27 KILL ^TMP("XBDH",$J,"SAVE")
28EXIT ;
29 Q
30 ;
31SET ;
32 S XBDHI=XBDHI+1,^TMP("XBDH",$J,"HELPR",XBDHI)=Y
33 Q
34 ;
35MUMPS ;
36 S XBDHJ=""
37 F L=0:0 S XBDHJ=$O(^TMP("XBDH",$J,"HEADER",XBDHN,XBDHJ)) Q:XBDHJ="" S XBDHI=XBDHI+1,^TMP("XBDH",$J,"HELPR",XBDHI)=^TMP("XBDH",$J,"HEADER",XBDHN,XBDHJ)
38 KILL XBDHJ
39 Q
40 ;
41PRELIM ;
42 S X=$P(^TMP("XBDH",$J,"HEADER",XBDHN),V),XBDHTPTH=$P(X,"~",4)
43 I XBDHLPTH=XBDHTPTH Q
44 I $E(XBDHTPTH,1,$L(XBDHLPTH))=XBDHLPTH D DOWN Q
45 I $E(XBDHLPTH,1,$L(XBDHTPTH))=XBDHTPTH D UP Q
46 D PATH
47 Q
48 ;
49DOWN ;
50 S X=$L(XBDHLPTH,";")
51 F I=X:1 S Y=$P(XBDHTPTH,";",I) Q:Y="" D SET
52 Q
53 ;
54UP ;
55 S X=$L(XBDHTPTH,";"),Y=$L(XBDHLPTH,";"),X=Y-X,Y=""
56 F I=1:1:X D SET
57 Q
58 ;
59PATH ;
60 F I=1:1 I $P(XBDHLPTH,";",I)="" S A=I-1 Q
61 F I=1:1 I $P(XBDHTPTH,";",I)="" S B=I-1 Q
62 F I=1:1:A Q:$P(XBDHLPTH,";",1,I)'=$P(XBDHTPTH,";",1,I)
63 S C=I-1,N=A-C,Y=""
64 F I=1:1:N D SET
65 S C=C+1
66 F I=C:1:B S Y=$P(XBDHTPTH,";",I) D SET
67 KILL A,B,C,I,N
68 Q
69 ;
70NORMAL ;
71 S XBDHC=XBDHCHLW,XBDHNN=$J("",$P(XBDHX,V,5))_$P(XBDHX,V,3),XBDHLJ=$P(XBDHX,V,4),XBDHRJ=$P(XBDHX,V,6),XBDHWW=$P(XBDHX,V,7),XBDHCHLW=XBDHCHLW+$P(XBDHX,V,4)+$P(XBDHX,V,8)
72 S XBDHSTG=$P($P(XBDHX,V),"~",2)
73 I XBDHNN'=$P(XBDHX,V,2) S XBDHSTG=XBDHSTG_";"""_XBDHNN_""""
74 S XBDHSTG=XBDHSTG_";C"_XBDHC
75 I XBDHLJ S XBDHSTG=XBDHSTG_$S(XBDHWW="+":";W",1:";L")_XBDHLJ
76 I XBDHRJ="+" S XBDHSTG=XBDHSTG_";R"_$P(XBDHX,V,4)
77 S XBDHI=XBDHI+1,^TMP("XBDH",$J,"HELPR",XBDHI)=XBDHSTG
78 Q
79 ;
80STD ;
81 W !!,"I AM ABOUT TO PRINT A SAMPLE REPORT.",!
82 S DIR(0)="YO",DIR("A")="For this demo, do you want the 'standard' print options",DIR("B")="YES",DIR("?")="Standard options: SORT BY '@NUMBER', DEVICE = 'HOME'"
83 D ^DIR
84 KILL DIR
85 I Y=U S XBDHQUIT="" Q
86 W !!,"HMMM, LET ME THINK ABOUT THIS...",!!
87 I Y=1 S BY="NUMBER;@",FR="",TO="",IOP=$I,DUZ(0)="@"
88DIP ;
89 S DIC=^DIC(XBDHPDFN,0,"GL")
90 S DIRPIPE="D ^XBDHDIP",L="]"
91 KILL XBDHHDX
92 D EN1^DIP
93 Q
94 ;
95NOTES ;
96 ; CONVERTS THE INFO FROM THE "HEADER" GLOBAL INTO FM SYNATX FOR THE "HELPR" GLOBAL
97 ; INPUT = ^TMP("XBDH",$J,"HEADER",XBDHCHN)
98 ; OUTPUT = ^TMP("XBDH",$J,"HELPR",N)
99 ; ";L" IS SUPERCEEDED BY ";W" IF WORDWRAP IS IN EFFECT
100 ; EN1^DIP LEAVES SOME LOCALS HANGING AROUND WHICH ARE KILLED IN DIP+2
101 ;
Note: See TracBrowser for help on using the repository browser.