source: WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLBLD1.m@ 711

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

initial load of WorldVistAEHR
File size: 5.1 KB
RevLine 
[613]1GMPLBLD1 ; SLC/MKB -- Bld PL Selection Lists cont ;;3/12/03 13:48
2 ;;2.0;Problem List;**3,28**;Aug 25, 1994
3 ;
4 ; This routine invokes IA #3991,#10082
5 ;
6SEL() ; Select item(s) from list
7 N DIR,X,Y,MAX,GRP S GRP=$D(GMPLGRP) ; =1 if editing groups, 0 if lists
8 S MAX=$P($G(^TMP("GMPLST",$J,0)),U,1) I MAX'>0 Q "^"
9 S DIR(0)="LAO^1:"_MAX,DIR("A")="Select "_$S('GRP:"Category",1:"Problem")_"(s)"
10 S:MAX>1 DIR("A")=DIR("A")_" (1-"_MAX_"): "
11 S:MAX'>1 DIR("A")=DIR("A")_": ",DIR("B")=1
12 S DIR("?")="Enter the "_$S('GRP:"categories",1:"problems")_" you wish to select, as a range or list of numbers"
13 D ^DIR S:$D(DTOUT)!(X="") Y="^"
14 Q Y
15 ;
16SEL1() ; Select item from list
17 N DIR,X,Y,MAX,GRP S GRP=$D(GMPLGRP) ; =1 if editing groups, 0 if lists
18 S MAX=$P($G(^TMP("GMPLST",$J,0)),U,1) I MAX'>0 Q "^"
19 S DIR(0)="NAO^1:"_MAX_":0",DIR("A")="Select "_$S('GRP:"Category",1:"Problem")
20 S:MAX>1 DIR("A")=DIR("A")_" (1-"_MAX_"): "
21 S:MAX'>1 DIR("A")=DIR("A")_": ",DIR("B")=1
22 S DIR("?")="Enter the "_$S('GRP:"category",1:"problem")_" you wish to select, by number"
23 D ^DIR I $D(DTOUT)!(X="") S Y="^"
24 Q Y
25 ;
26SEQ(NUM) ; Enter/edit seq #, returns new #
27 N DIR,X,Y,GRP S GRP=$D(GMPLGRP) ; =1 if editing groups, 0 if lists
28 S DIR(0)="NA^.01:999.99:2",DIR("A")="SEQUENCE: " S:NUM DIR("B")=NUM
29 S DIR("?",1)="Enter a number indicating the sequence of this item in the "_$S('GRP:"list;",1:"category;")
30 S DIR("?")="up to 2 decimal places may be used, to order these items."
31SQ D ^DIR I $D(DTOUT)!(X="^") Q "^"
32 I X?1"^".E W $C(7),$$NOJUMP G SQ
33 I Y=NUM Q NUM
34 I $D(^TMP("GMPLIST",$J,"SEQ",Y)) D G SQ
35 . W $C(7),!!,"Sequence number already in use! Please enter another number."
36 . W !,"Use the 'Change View' option to display the current sequence numbers.",!
37 Q Y
38 ;
39HDR(TEXT) ; Enter/edit group subheader text in list
40 N DIR,X,Y S:$L(TEXT) DIR("B")=TEXT
41 S DIR(0)="FAO^2:30",DIR("A")="HEADER: "
42 S DIR("?")="Enter the text you wish displayed as a header for this category of problems"
43 S:$D(DIR("B")) DIR("?",1)=DIR("?")_";",DIR("?")="enter '@' if no header text is desired."
44H1 D ^DIR I $D(DTOUT)!(X="^") Q "^"
45 I X?1"^".E W $C(7),$$NOJUMP G H1
46 I X="@" Q:$$SURE^GMPLX "" G H1
47 Q Y
48 ;
49TEXT(TEXT) ; Edit problem text
50 N DIR,X,Y S:$L(TEXT) DIR("B")=TEXT
51 S DIR(0)="FAO^2:80",DIR("A")="DISPLAY TEXT: "
52 S DIR("?")="Enter the text you wish presented here for this problem."
53T1 D ^DIR I $D(DTOUT)!("^"[X) S Y="^" G TQ
54 I X?1"^".E W $C(7),$$NOJUMP G T1
55 I X="@" G:'$$SURE^GMPLX T1 S Y="@" G TQ
56TQ Q Y
57 ;
58CODE(CODE) ; Enter/edit problem code
59 N DIR,X,Y
60 S DIR(0)="PAO^ICD9(:QEMZ",DIR("A")="ICD CODE: " S:$L(CODE) DIR("B")=CODE
61 S DIR("?")="Enter the code you wish to be displayed with this problem."
62 S DIR("S")="I $$STATCHK^ICDAPIU($P(^(0),U),DT)"
63C1 D ^DIR I $D(DTOUT)!(X="^") S Y="^" G CQ
64 I X?1"^".E W $C(7),$$NOJUMP G C1
65 I X="@" G:'$$SURE^GMPLX C1 S Y=""
66 S:+Y'>0 Y="" S:+Y>0 Y=Y(0,0)
67CQ Q Y
68 ;
69FLAG(DFLT) ; Edit category flag
70 N DIR,X,Y S DIR(0)="YAO",DIR("B")=$S(+DFLT:"YES",1:"NO")
71 S DIR("A")="SHOW PROBLEMS AUTOMATICALLY? "
72 S DIR("?",1)="Enter YES if you wish the problems contained in this category to be",DIR("?",2)="automatically displayed upon entry to this list; NO will display only the",DIR("?")="category header until the user selects it to view."
73F1 D ^DIR I $D(DTOUT)!(X="^") Q "^"
74 I X?1"^".E W $C(7),$$NOJUMP G F1
75 Q Y
76 ;
77NOJUMP() ; Message
78 Q " ^-jumping not allowed!"
79 ;
80RETURN() ; End of page prompt
81 N DIR,X,Y
82 S DIR(0)="E" D ^DIR
83 Q +Y
84 ;
85TMPIFN() ; Get temporary IFN ("#N") for ^TMP("GMPLIST",$J,)
86 N I,LAST S (I,LAST)=0
87 F S I=$O(^TMP("GMPLIST",$J,I)) Q:+I'>0 S:I?1.N1"N" LAST=+I
88 S I=LAST+1,I=$E("0000",1,4-$L(I))_I
89TMPQ Q I_"N"
90 ;
91DELETE(IFN) ; Kill entry in ^TMP("GMPLIST",$J,)
92 N SEQ,ITEM S ^TMP("GMPLIST",$J,0)=^TMP("GMPLIST",$J,0)-1
93 S SEQ=+^TMP("GMPLIST",$J,IFN),ITEM=$P(^TMP("GMPLIST",$J,IFN),U,2),^TMP("GMPLIST",$J,IFN)="@"
94 K ^TMP("GMPLIST",$J,"SEQ",SEQ),^TMP("GMPLIST",$J,"PROB",ITEM),^TMP("GMPLIST",$J,"GRP",ITEM)
95 K:IFN?1.N1"N" ^TMP("GMPLIST",$J,IFN)
96 Q
97 ;
98RESEQ ; Resequence items
99 N SEL,NUM,SEQ,NSEQ,PIECE,IFN,GMPQUIT S VALMBCK=""
100 S SEL=$$SEL G:SEL="^" RSQ
101 F PIECE=1:1:$L(SEL,",") D Q:$D(GMPQUIT) W !
102 . S NUM=$P(SEL,",",PIECE) Q:NUM'>0
103 . S IFN=$P($G(^TMP("GMPLST",$J,"B",NUM)),U,1) Q:+IFN'>0 S SEQ=$P(^TMP("GMPLIST",$J,IFN),U,1)
104 . W !!,$P(^TMP("GMPLIST",$J,IFN),U,3)
105 . S NSEQ=$$SEQ(SEQ) I NSEQ="^" S GMPQUIT=1 Q
106 .I SEQ'=NSEQ S ^TMP("GMPLIST",$J,IFN)=NSEQ_U_$P(^TMP("GMPLIST",$J,IFN),U,2,$L(^TMP("GMPLIST",$J,IFN),U)),^TMP("GMPLIST",$J,"SEQ",NSEQ)=IFN,GMPREBLD=1 K ^TMP("GMPLIST",$J,"SEQ",SEQ)
107 I $D(GMPREBLD) S VALMBCK="R",GMPLSAVE=1 ; D BUILD in exit action
108RSQ S:'VALMCC VALMBCK="R" S VALMSG=$$MSG^GMPLX
109 Q
110 ;
111EDIT ; Edit category display
112 N GRPS,NUM,IFN,HDR,FLG,PIECE,GMPQUIT,GMPREBLD S VALMBCK=""
113 S GRPS=$$SEL G:GRPS="^" EDQ
114 F PIECE=1:1:$L(GRPS,",") D Q:$D(GMPQUIT) W !
115 . S NUM=$P(GRPS,",",PIECE) Q:NUM'>0
116 .S IFN=$P($G(^TMP("GMPLST",$J,"B",NUM)),U,1) Q:+IFN'>0
117 . S HDR=$P(^TMP("GMPLIST",$J,IFN),U,3),FLG=$P(^TMP("GMPLIST",$J,IFN),U,4)
118 . S HDR=$$HDR(HDR) I HDR="^" S GMPQUIT=1 Q
119 . S FLG=$$FLAG(FLG) I FLG="^" S GMPQUIT=1 Q
120 . S $P(^TMP("GMPLIST",$J,IFN),U,3,4)=HDR_U_FLG,GMPREBLD=1
121 I $D(GMPREBLD) S VALMBCK="R",GMPLSAVE=1 D BUILD^GMPLBLD("^TMP(""GMPLIST"",$J)",GMPLMODE)
122EDQ S:'VALMCC VALMBCK="R" S VALMSG=$$MSG^GMPLX
123 Q
Note: See TracBrowser for help on using the repository browser.