source: FOIAVistA/trunk/r/MEDICINE-MC/MCARDHLP.m@ 1754

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

initial load of FOIAVistA 6/30/08 version

File size: 5.5 KB
Line 
1MCARDHLP ;WISC/DCB-HELP FOR SCREEN INPUT ;8/27/96 10:06
2 ;;2.3;Medicine;;09/13/1996
3 Q
4START ;
5 N SPACE,X,Y S MCARGDA=DJDN
6 N VAL,MCERR,FLAG,TMP,XHOLD
7 N SPACE S SPACE="" S $P(SPACE," ",80)=""
8 I $D(MCDID) S DX=1,DY=1 X XY W SPACE
9 Q:'$D(DJJ(+V))
10 S @$P(DJJ(V),U,2) X XY
11 I $D(MCHELPSW),('$D(MCHELPS2)) D FUNC^MCARDNQ2 K MCMASS D SKIP Q
12 I $D(MCDID),$D(MCHELPSW),'$D(MCHELPS2) Q
13 I (DJ4["200")!(DJ4["690") D FUNC Q
14 S VAL=$P(DJ0,U,2)
15 I VAL["F" G FUNC
16 I VAL["S" D SETH(DJDD,DJAT,DJ0) D SKIP Q
17 I DJ4["M" D MULT(DJDD,DJAT,DJDN,.FLAG)
18 I VAL["P" D POINTER(DJDD,DJAT) D FUNC:$D(MCERR),SKIP Q
19 I DJ4["M",VAL["D" D Q ; New line & dot block DAD 7-23-96
20 . N %DT,DJAT,DJDD,DJX,MCMASS,X
21 . S DJDD=+$P(DJ0,U,2),DJAT=.01
22 . S X=$P($P(DJ0,U,5)," D ^%DT") S:X="" X="S %DT=""E""" X X
23 . I $D(DJCP) X DJCP X XY W DJLIN
24 . D HELP^MCARDNQ,FUNC
25 . Q
26 I DJ4["M",$TR(VAL,"aeAIM")=+VAL D Q ; New line & dot block DAD 8-14-96
27 . N DJAT,DJDD
28 . S DJDD=+$P(DJ0,U,2),DJAT=.01
29 . I $D(DJCP) X DJCP X XY W DJLIN
30 . D FUNC
31 . Q
32FUNC ;
33 D NUMBER(DJDD,DJAT)
34 I $G(MCERR) D FUNC^MCARDNQ2
35SKIP ;
36 S MCDID=1
37 S @$P(DJJ(V),U,2) X XY Q
38POINTER(XFILE,FLD) ;
39 N LINE,PTER,SUB,GL,XFLD,HOLD S HOLD=XFILE
40 S LINE=$G(^DD(XFILE,FLD,0)) I LINE="" S MCERR=0 Q
41 S GL=$P(LINE,U,3),LINE=$P(LINE,U,2)
42 I GL'="" S PTER=+$P(LINE,"P",2)
43 E S XFILE=+LINE,XFLD=.01,PTER=+$P($P($G(^DD(XFILE,XFLD,0)),U,2),"P",2)
44 I +PTER=0 S MCERR=0 Q
45 I PTER=200 S MCERR=0 Q
46 D POINTERH(XFILE,PTER,FLD,HOLD)
47 Q
48POINTERH(XFILE,MFILE,FLD,HOLD) ;
49 N DIC,TMP,REC,LOOP,TOTAL,LEN,GLOBAL,Y,SETLOC
50 N FIELDS,TYPE,EXC,TEMP,ERROR,X,XREF,SWITCH
51 D RTNELM^MCDBELM(MFILE,1,".01","","","E","",.TEMP,.ERROR)
52 S GLOBAL=TEMP("DIC"),XREF=GLOBAL_"""B"")"
53 S GLOBAL=TEMP("GLO")
54 S REC=+$P($G(@GLOBAL@(0)),U,4) I REC>200!(REC<1) S MCERR=1 Q
55 S SETLOC=$$SCRN(HOLD,FLD),LOOP=0,D0=DJDN,HOLD=""
56 W !
57 F S HOLD=$O(@XREF@(HOLD)) Q:HOLD="" D
58 .S Y=$O(@XREF@(HOLD,0))
59 .S TEP=$G(@GLOBAL@(Y,0)),REC=Y X SETLOC
60 .I $T D
61 ..S $P(TEMP(1),U,2)=Y D GETDATA^MCDBSAVE(.TEMP,.ERROR)
62 ..S XHOLD=$D(XHOLD(REC)),LOOP=LOOP+1
63 ..S TMP(TEMP("FLD",.01))=XHOLD S SWITCH=XHOLD
64 I (LOOP<1) S MCERR=1 Q
65 I (LOOP>70) D:SWITCH'=0 ADJUST
66 D HEADER("{Current choices}")
67 D POINTER2(LOOP)
68 Q
69ADJUST ;
70 N %X,%Y,HOLD,TOTAL,XTEMP S XTEMP(1)="CURENTLY IN LIST",TOTAL=1
71 F HOLD=1:1:LOOP D
72 .I $D(TMP(HOLD,0)) S TOTAL=TOTAL+1,XTEMP(TOTAL)=TMP(HOLD,0)
73 S LOOP=TOTAL K TMP
74 S %X="XTEMP(",%Y="TMP(" D %XY^%RCR
75 Q
76POINTER2(TOTAL) ;Help display for pointers
77 N MAX,COL,SP,VAL,TYPE S VAL=""
78 I TOTAL=0 S MCERR=1 Q
79 S SP=" ",$P(SP," ",80)="",CT=0,COL=(TOTAL\7)
80 S:(TOTAL/7)'=(TOTAL\7) COL=COL+1
81 S MAX=80\COL,MLEN=MAX-2,COL=COL-1
82 I $D(DJCP) X DJCP X XY W DJLIN
83 F LOOP=1:1:TOTAL S VAL=$O(TMP(VAL)) Q:VAL="" D
84 .S TYPE=TMP(VAL)
85 .I CT>COL S CT=0 W !
86 .I $G(VAL)'="" D
87 ..S CT=CT+1
88 ..W $S(TYPE:$G(DJHIN),1:"")_$E($E(VAL,1,MLEN)_SP,1,MAX)_$S(TYPE:$G(DJLIN),1:"")
89 Q
90SETH(FILE,FIELD,TEMP) ;
91 N DIC,LOOP,ITEMS,TMP,LOP,MAX,MLEN1,MLEN2,TOTAL
92 I +$P(TEMP,U,2)'=0 S FILE=+$P(TEMP,U,2),FIELD=.01,TEMP=""
93 S:$P($G(TEMP),U,3)="" TEMP=$G(^DD(FILE,FIELD,0))
94 S TMP=$P(TEMP,U,3),MLEN1=0,MLEN2=0
95 S DIC("S")=$$SCRN(FILE,FIELD),LOOP(0)=0,ITEMS=""
96 Q:TMP=""
97 F LOOP=1:1:$L(TMP,";") S MAX=$P(TMP,";",LOOP) Q:MAX="" D
98 .I $G(DIC("S"))]"" S Y=$P(MAX,":") I Y]"" X DIC("S") Q:'$T
99 .S LOOP(0)=LOOP(0)+1,ITEMS=ITEMS_MAX_";"
100 .S LEN1=$L($P(MAX,":",1)) S:LEN1>MLEN1 MLEN1=LEN1
101 .S LEN2=$L($P(MAX,":",2)) S:LEN2>MLEN2 MLEN2=LEN2
102 S TOTAL=LOOP(0) D SET2(ITEMS,TOTAL,MLEN1,MLEN2)
103 Q
104SET2(TMP,TOTAL,MLEN1,MLEN2) ;
105 N MAX,COL,CT,LOOP,F1,F2,SP,Y
106 S SP="",$P(SP," ",80)="",MLEN=MLEN1+3+MLEN2+2,CT=0
107 S COL=(TOTAL\7) S:(TOTAL/7)'=(TOTAL\7) COL=COL+1
108 S MAX=80\COL,MAX=MAX-2 S:MAX<MLEN MLEN=MAX
109 S COL=COL-1
110 S:COL=3&(TOTAL<8) COL=1 I $D(DJCP) X DJCP X XY W DJLIN
111 F LOOP=1:1:TOTAL D
112 .S TEMP=$P(TMP,";",LOOP),F1=$P(TEMP,":",1),F2=$P(TEMP,":",2)
113 .S F1=$E(F1_SP,1,MLEN1),F2=$E(F2_SP,1,MLEN2)
114 .I CT>COL S CT=0 W !
115 .W $G(DJHIN),F1,$G(DJLIN)," - ",F2," "
116 .S CT=CT+1
117 D HEADER("{Help prompt for Set of Codes}")
118 Q
119NUMBER(FILE,FIELD) ;
120 N VAL
121 S VAL=$G(^DD(FILE,FIELD,3)) I VAL="" S MCERR=1 Q
122 D HEADER("{Help prompt}")
123 I $D(DJCP) X DJCP X XY W DJLIN
124 W !!,VAL
125 Q
126MULT(FILE,FIELD,XREC,FLAG) ;
127 N FIELDS,REC,EXC,DATA,TYPE,USER,TEMP,ERROR,LOOP,TOTAL,GLO,LEVEL
128 S LEVEL=1,FIELDS=FIELD,REC=""
129 D MAIN(FILE,.FIELDS,.LEVEL)
130 I LEVEL>1 F LOOP=1:1:LEVEL S REC=REC_^TMP($J,"DJST",LOOP,"DA")_U
131 E S REC=XREC_U,FIELDS=FIELD_U
132 S REC=REC_1,FIELDS=FIELDS_".01"
133 ;; ***ORIGINAL*** ;; S:$D(^DD(FILE,0,"UP")) FILE=^DD(FILE,0,"UP")
134 F S FILE(0)=$G(^DD(FILE,0,"UP")) Q:FILE(0)'>0 S FILE=FILE(0) ;DAD81496
135 D RTNELM^MCDBELM(FILE,REC,FIELDS,"","","E","",.TEMP,.ERROR)
136 S GLO=TEMP("GLO")
137 F LOOP=0:0 S LOOP=+$O(@GLO@(LOOP)) Q:LOOP=0 D
138 .S REC=+$P($G(@GLO@(LOOP,0)),U,1),XHOLD(REC)=""
139 Q
140MAIN(FILE,FIELDS,LEVEL) ;
141 N HOLD,NAME
142 S HOLD=$G(^DD(FILE,0,"UP"))
143 I HOLD="" S FIELDS=$$REORDER(FIELDS,LEVEL) Q
144 S NAME=$O(^DD(FILE,0,"NM","")),LEVEL=LEVEL+1
145 S FIELDS=$G(FIELDS)_U_+$O(^DD(HOLD,"B",NAME,0))
146 D MAIN(HOLD,.FIELDS,LEVEL)
147 Q
148REORDER(FIELDS,LEVEL) ;
149 N LOOP,HOLD S HOLD="" I LEVEL<2 Q ""
150 F LOOP=LEVEL:-1:1 D
151 .S HOLD=HOLD_$P(FIELDS,U,LOOP)_U
152 Q HOLD
153HEADER(MCHELP) ;
154 N SPACE,TEMP,TMP S SPACE="",$P(SPACE," ",80)=" "
155 S DX=1,DY=1 X XY
156 S TMP=40-$L(MCHELP)
157 S TEMP=$E(SPACE,1,TMP)_MCHELP
158 W DJHIN,"*** Commands: ^C ",$S($D(DJTOGGLE):"or KP1 ",1:""),"***",?40,TEMP,DJLIN
159 Q
160SCRN(SFILE,SFLD) ;
161 N SCREEN
162 I $G(^DD(SFILE,SFLD,12.1))'="" D SCSET
163 I '$D(SCREEN) D
164 .S SFILE=+$P(^DD(SFILE,SFLD,0),U,2),SFLD=.01
165 .I 'SFILE?1N.N1".".N S SFILE=+$P(SFILE,"P",2)
166 .I $G(^DD(SFILE,SFLD,12.1))'="" D SCSET
167 Q $S($D(SCREEN):SCREEN,1:"I 1")
168SCSET ;
169 I ^DD(SFILE,SFLD,12.1)["S DIC(""S"")" X ^(12.1) S SCREEN=DIC("S") K DIC("S") Q
170 S SCREEN=^DD(SFILE,SFLD,12.1) Q
Note: See TracBrowser for help on using the repository browser.