source: FOIAVistA/tag/r/PROBLEM_LIST-GMPL/GMPLBLDC.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA
File size: 5.4 KB
Line 
1GMPLBLDC ; SLC/MKB -- Build Problem Selection Categories ;3/12/03 9:22
2 ;;2.0;Problem List;**3,7,28**;Aug 25, 1994;Build 1
3 ;
4 ; This routine invokes IA #3991
5 ;
6EN ; -- main entry point for GMPL SELECTION GROUP BUILD
7 D EN^VALM("GMPL SELECTION GROUP BUILD")
8 Q
9 ;
10HDR ; -- header code
11 N NAME,NUM,DATE S NUM=+^TMP("GMPLST",$J,0)_" problem"_$S(+^TMP("GMPLST",$J,0)'=1:"s",1:"")
12 S DATE="Last Modified: "_$S(+$P(GMPLGRP,U,3):$$FMTE^XLFDT($P(GMPLGRP,U,3)),1:"<new category>")
13 S VALMHDR(1)=DATE_$J(NUM,79-$L(DATE))
14 S NAME=$P(GMPLGRP,U,2),VALMHDR(2)=$J(NAME,$L(NAME)\2+41)
15 Q
16 ;
17INIT ; -- init variables and list array
18 S GMPLGRP=$$GROUP^GMPLBLD2("L") I GMPLGRP="^" S VALMQUIT=1 Q
19 L +^GMPL(125.11,+GMPLGRP,0):1 I '$T D G INIT
20 . W $C(7),!!,"This category is currently being edited by another user!",!
21 S GMPLMODE="E",VALMSG=$$MSG^GMPLX
22 D GETLIST,BUILD("^TMP(""GMPLIST"",$J)",GMPLMODE)
23 Q
24 ;
25GETLIST ; Build ^TMP("GMPLIST",$J,#) of problems
26 N SEQ,IFN,ITEM,PROB,CNT K ^TMP("GMPLIST",$J) S CNT=0
27 W !,"Searching for the problems ..."
28 F IFN=0:0 S IFN=$O(^GMPL(125.12,"B",+GMPLGRP,IFN)) Q:IFN'>0 D
29 . S ITEM=$G(^GMPL(125.12,IFN,0)),SEQ=$P(ITEM,U,2),PROB=$P(ITEM,U,3)
30 . S ^TMP("GMPLIST",$J,IFN)=$P(ITEM,U,2,5),CNT=CNT+1 ; seq ^ prob ^ text ^ code
31 . S (^TMP("GMPLIST",$J,"PROB",PROB),^TMP("GMPLIST",$J,"SEQ",SEQ))=IFN ; Xrefs
32 S ^TMP("GMPLIST",$J,0)=CNT
33 Q
34 ;
35BUILD(LIST,MODE) ; Build ^TMP("GMPLST",$J,) of current items in LIST for display
36 N SEQ,LCNT,NUM,PROB,TEXT,IFN,ITEM,CODE D CLEAN^VALM10
37 I $P($G(^TMP("GMPLIST",$J,0)),U,1)'>0 S ^TMP("GMPLST",$J,1,0)=" ",^TMP("GMPLST",$J,2,0)="No items available.",^TMP("GMPLST",$J,0)="0^2",VALMCNT=2 Q
38 S (LCNT,NUM,SEQ)=0
39 F S SEQ=$O(^TMP("GMPLIST",$J,"SEQ",SEQ)) Q:SEQ'>0 D
40 . S IFN=^TMP("GMPLIST",$J,"SEQ",SEQ),LCNT=LCNT+1,NUM=NUM+1
41 . S PROB=$P(^TMP("GMPLIST",$J,IFN),U,2),TEXT=$P(^TMP("GMPLIST",$J,IFN),U,3),CODE=$P(^TMP("GMPLIST",$J,IFN),U,4)
42 . S ^TMP("GMPLST",$J,LCNT,0)=$S(MODE="I":$J("<"_SEQ_">",8),1:" ")_$J(NUM,4)_" "_TEXT
43 . I $L(CODE) D
44 .. S ^TMP("GMPLST",$J,LCNT,0)=^TMP("GMPLST",$J,LCNT,0)_" ("_CODE_")"
45 .. I $$STATCHK^ICDAPIU(CODE,DT) Q ; OK - code is active
46 .. S ^TMP("GMPLST",$J,LCNT,0)=^TMP("GMPLST",$J,LCNT,0)_" <INACTIVE CODE>"
47 . D CNTRL^VALM10(LCNT,9,5,IOINHI,IOINORM)
48 . S ^TMP("GMPLST",$J,"B",NUM)=IFN
49 S ^TMP("GMPLST",$J,0)=NUM_U_LCNT,VALMCNT=LCNT
50 Q
51 ;
52HELP ; -- help code
53 N X
54 W !!?4,"You may take a variety of actions from this prompt. To update"
55 W !?4,"this category you may add new problems or remove an existing"
56 W !?4,"one; you may also change the text or code displayed, or the order"
57 W !?4,"in which each problem is displayed. Select View w/wo Seq Numbers"
58 W !?4,"to toggle seeing the sequence number in addition to the display"
59 W !?4,"number per problem. If necessary, the current category may be"
60 W !?4,"deleted; you may change to a different category to continue editing."
61 W !!,"Press <return> to continue ..." R X:DTIME
62 S VALMSG=$$MSG^GMPLX,VALMBCK=$S(VALMCC:"",1:"R")
63 Q
64 ;
65EXIT ; -- exit code
66 I $D(GMPLSAVE),$$CKSAVE^GMPLBLD2 D
67 . D SAVE^GMPLBLD2
68 . S ^GMPL(125.11,+GMPLGRP,0)=$P(GMPLGRP,U,2)_U_DT
69 L -^GMPL(125.11,+GMPLGRP,0)
70 K GMPLIST,GMPLST,GMPLMODE,GMPLGRP,GMPLSAVE,GMPREBLD,GMPQUIT,RT1,TMPITEM
71 K VALMBCK,VALMCNT,VALMSG,VALMHDR
72 K ^TMP("GMPLIST",$J),^TMP("GMPLST",$J)
73 Q
74 ;
75ADD ; Add new problem(s)
76 N X,Y,SEQ,CODE,IFN,GMPVOCAB,GMPQUIT,GMPREBLD S VALMBCK=""
77 S GMPVOCAB=$$VOCAB^GMPLX1 Q:GMPVOCAB="^"
78 F D Q:$D(GMPQUIT) W !!
79 . S (X,Y)="" D SEARCH^GMPLX(.X,.Y,"PROBLEM: ","1",GMPVOCAB)
80 . I +Y'>0 S GMPQUIT=1 Q
81 . S X=$$TEXT^GMPLBLD1(X) I X="^" S GMPQUIT=1 Q
82 . S CODE=$$CODE^GMPLBLD1($G(Y(1))) I CODE="^" S GMPQUIT=1 Q
83 . S RT1="^TMP(""GMPLIST"",$J,""SEQ"",",SEQ=+$$LAST^GMPLBLD2(RT1)+1 ; dflt = next #
84 . S SEQ=$$SEQ^GMPLBLD1(SEQ) I SEQ="^" S GMPQUIT=1 Q
85 . S IFN=$$TMPIFN^GMPLBLD1,^TMP("GMPLIST",$J,0)=^TMP("GMPLIST",$J,0)+1
86 . S ^TMP("GMPLIST",$J,IFN)=SEQ_U_+Y_U_X_U_CODE ; seq ^ # ^ text ^ code
87 . S (^TMP("GMPLIST",$J,"PROB",+Y),^TMP("GMPLIST",$J,"SEQ",SEQ))=IFN,GMPREBLD=1
88 I $D(GMPREBLD) S VALMBCK="R",GMPLSAVE=1 D BUILD("^TMP(""GMPLIST"",$J)",GMPLMODE),HDR
89 S:'VALMCC VALMBCK="R" S VALMSG=$$MSG^GMPLX
90 Q
91 ;
92REMOVE ; Remove problem from group
93 N NUM,IFN S VALMBCK=""
94 S NUM=$$SEL1^GMPLBLD1 G:NUM="^" RMQ
95 S IFN=$P($G(^TMP("GMPLST",$J,"B",NUM)),U,1) G:+IFN'>0 RMQ
96 I "@"[$G(^TMP("GMPLIST",$J,IFN)) W $C(7),!!,"Problem does not exist in this category!" H 2 G RMQ
97 I '$$SURE^GMPLX W !?5,"< Nothing removed! >" H 1 G RMQ
98 D DELETE^GMPLBLD1(IFN) S VALMBCK="R",GMPLSAVE=1
99 D BUILD("^TMP(""GMPLIST"",$J)",GMPLMODE),HDR
100RMQ S:'VALMCC VALMBCK="R" S VALMSG=$$MSG^GMPLX
101 Q
102 ;
103EDIT ; Edit problem text and code
104 N NUM,SEL,IFN,PIECE,CODE,PROB,PROBLEM,GMPQUIT,GMPREBLD S VALMBCK=""
105 S SEL=$$SEL^GMPLBLD1 G:SEL="^" EDQ
106 F PIECE=1:1:$L(SEL,",") D Q:$D(GMPQUIT) W !
107 . S NUM=$P(SEL,",",PIECE) Q:NUM'>0
108 . S IFN=$P($G(^TMP("GMPLST",$J,"B",NUM)),U,1) Q:IFN'>0
109 . I "@"[$G(^TMP("GMPLIST",$J,IFN)) W $C(7),!!,"Problem #"_NUM_" does not exist in this category!" H 2 Q
110 . W !!,">>> Problem #"_NUM S PROBLEM=^TMP("GMPLIST",$J,IFN)
111 . W:$P(PROBLEM,U,2)>1 " = "_$G(^LEX(757.01,+$P(PROBLEM,U,2),0)) W ! ; KER
112 . S PROB=$$TEXT^GMPLBLD1($P(PROBLEM,U,3)) I PROB="^" S GMPQUIT=1 Q
113 . I PROB="@" D DELETE^GMPLBLD1(IFN) S GMPREBLD=1 Q
114 . S CODE=$$CODE^GMPLBLD1($P(PROBLEM,U,4)) I CODE="^" S GMPQUIT=1 Q
115 . S ^TMP("GMPLIST",$J,IFN)=$P(PROBLEM,U,1,2)_U_PROB_U_CODE,GMPREBLD=1
116 I $D(GMPREBLD) S VALMBCK="R",GMPLSAVE=1 D BUILD("^TMP(""GMPLIST"",$J)",GMPLMODE)
117EDQ S:'VALMCC VALMBCK="R" S VALMSG=$$MSG^GMPLX
118 Q
Note: See TracBrowser for help on using the repository browser.