source: FOIAVistA/trunk/r/PROBLEM_LIST-GMPL/GMPLMENU.m@ 1742

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

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1GMPLMENU ; SLC/MKB -- VALM Utilities for Add Menu sub-list ;5/26/94 15:55
2 ;;2.0;Problem List;**11**;Aug 25, 1994
3HDR ; -- header code
4 N PAT,NUM,LIST S NUM=GMPLCNT_" problem(s) added"
5 S PAT=$P(GMPDFN,U,2)_" ("_$P(GMPDFN,U,3)_")"
6 S VALMHDR(1)=PAT_$J(NUM,79-$L(PAT)),LIST=$P(GMPLSLST,U,2)
7 S VALMHDR(2)=$J(LIST,$L(LIST)\2+41)
8 Q
9 ;
10HELP ; -- help code
11 N X,CNT S CNT=+$G(^TMP("GMPLMENU",$J,"LIST",0))
12 W !!?4,"You may select one or more of the above listed items by entering"
13 W !?4,"its display number (1-"_CNT_") at the prompt; if the text if followed"
14 W !?4,"by '...', all problems under that heading will be displayed for"
15 W !?4,"selection. Enter AD to select a problem not listed above."
16 W !?4,"If you enter a list or range of numbers to add several problems,"
17 W !?4,"you will be presented with each to complete, one at a time."
18 W:VALMCNT>10 !?4,"Enter + to see more items, as in the problem list."
19 W !!,"Press <return> to continue ..." R X:DTIME
20 S VALMSG=$$MSG,VALMBCK=$S(VALMCC:"",1:"R")
21 Q
22EXIT ; -- exit code
23 N I F I=0:0 S I=$O(XQORM("KEY",I)) Q:I'>0 K XQORM("KEY",I)
24 K ^TMP("GMPLMENU",$J),GMPLCNT
25 Q
26 ;
27MSG() ; -- set LMgr msg bar
28 Q "Enter the number of the item(s) you wish to select"
29 ;
30BUILD ; -- Build ^TMP("GMPLMENU",$J,"LIST") list to display
31 N I,LCNT,NUM,ITEM,CODE,GRP,PROBS,ADDED
32 S (GRP,NUM,LCNT)=0 D CLEAN^VALM10
33 F S GRP=$O(^TMP("GMPLMENU",$J,GRP)) Q:GRP'>0 D
34 . S ITEM=$G(^TMP("GMPLMENU",$J,GRP,0)),PROBS=+$P(ITEM,U,2)
35 . I 'PROBS D Q
36 . . S LCNT=LCNT+1,NUM=NUM+1,^TMP("GMPLMENU",$J,"IDX",NUM)=U_GRP_U_LCNT
37 . . S ^TMP("GMPLMENU",$J,"LIST",LCNT,0)=$J(NUM,5)_" "_$P(ITEM,U)_" ..."
38 . . D CNTRL^VALM10(LCNT,1,5,IOINHI,IOINORM)
39BLD1 . I LCNT,^TMP("GMPLMENU",$J,"LIST",LCNT,0)'=" " S LCNT=LCNT+1,^TMP("GMPLMENU",$J,"LIST",LCNT,0)=" "
40 . S:+$G(GMPLGRP)=GRP VALMBG=LCNT+1 ; start list display here
41 . I $L($P(ITEM,U)) D ; have a hdr
42 . . S LCNT=LCNT+1,^TMP("GMPLMENU",$J,"LIST",LCNT,0)=" "_$P(ITEM,U)
43 . . D CNTRL^VALM10(LCNT,7,$L($P(ITEM,U)),IOUON,IOUOFF)
44 . S I=0 F S I=$O(^TMP("GMPLMENU",$J,GRP,I)) Q:I'>0 D
45 . . S LCNT=LCNT+1,NUM=NUM+1
46 . . S ITEM=$G(^TMP("GMPLMENU",$J,GRP,I)),CODE=$P(ITEM,U,3),ADDED=+$P(ITEM,U,4) ; ITEM=term^text^code, _"^1" if added
47 . . S ^TMP("GMPLMENU",$J,"LIST",LCNT,0)=$S(ADDED:" X",1:" ")_$J(NUM,3)_" "_$P(ITEM,U,2)_$S($L(CODE):" ("_CODE_")",1:"")
48 . . S ^TMP("GMPLMENU",$J,"IDX",NUM)=I_U_GRP_U_LCNT_U_ITEM
49 . . D CNTRL^VALM10(LCNT,1,5,IOINHI,IOINORM)
50 . S LCNT=LCNT+1,^TMP("GMPLMENU",$J,"LIST",LCNT,0)=" "
51BLDQ S ^TMP("GMPLMENU",$J,"LIST",0)=NUM_U_LCNT,VALMCNT=LCNT,GMPLCNT=0,VALMSG=$$MSG
52 D KEYS
53 Q
54 ;
55KEYS ; -- setup XQORM("KEY") array for menu
56 N I,PROTCL,NUM S NUM=+$G(^TMP("GMPLMENU",$J,"LIST",0))
57 S PROTCL=$O(^ORD(101,"B","GMPL LIST SELECT ITEM",0))_"^1"
58 F I=1:1:NUM S XQORM("KEY",I)=PROTCL
59 S VALMSG=$$MSG
60 Q
61 ;
62CK ; -- check whether to stop processing after each problem
63 ; Called from exit action of GMPL LIST XXX protocols
64 S:$D(GMPQUIT) XQORPOP=1 K GMPQUIT
65 I $D(DTOUT)!($G(VALMBCK)="Q") S VALMBCK="Q" Q
66 S VALMBCK="R",VALMSG=$$MSG
67 Q
68 ;
69ITEM ; -- select item from menu
70 N NUM,GMPROB,GMPTERM,GMPICD,GMPSAVED,LCNT,LINE,DUP,ITEM,CODE,GRP,PROB,GMPINDEX
71 S NUM=+$P(XQORNOD(0),U,3) Q:NUM'>0
72 S GMPINDEX=$G(^TMP("GMPLMENU",$J,"IDX",NUM)),PROB=+GMPINDEX,GRP=$P(GMPINDEX,U,2)
73 I 'PROB D Q ; expand category
74 . S ITEM=$G(^TMP("GMPLMENU",$J,+GRP,0)) S:'$D(GMPLGRP) GMPLGRP=+GRP
75 . S ^TMP("GMPLMENU",$J,+GRP,0)=$P(ITEM,U)_"^1"
76 S ITEM=$P(GMPINDEX,U,4,6) ; CLU^text^code
77 S GMPTERM=$S(+ITEM>1:$P(ITEM,U,1,2),1:""),GMPROB=$P(ITEM,U,2)
78 S CODE=$P(ITEM,U,3),GMPICD=$S('$L(CODE):"799.9",1:CODE)
79 W !!!,">>> Adding problem #"_NUM_" '"_GMPROB_"' ..."
80 S DUP=$$DUPL^GMPLX(+GMPDFN,+GMPTERM,GMPROB)
81 I DUP,'$$DUPLOK^GMPLX(DUP) G ITQ
82 D ADD1^GMPL1
83ITQ I $D(GMPSAVED) D D HDR
84 . S GMPREBLD=1,GMPLCNT=GMPLCNT+1,LCNT=+$P(GMPINDEX,U,3)
85 . S LINE=$G(^TMP("GMPLMENU",$J,"LIST",LCNT,0)),^TMP("GMPLMENU",$J,"LIST",LCNT,0)=" X"_$E(LINE,3,999)
86 . S ^TMP("GMPLMENU",$J,+GRP,+PROB)=ITEM_"^1" ; problem added
87 Q
88 ;
89CLU ; -- add problem not on menu, from CLU
90 N GMPSAVED W !!!,">>> Adding a problem not on the menu ..."
91 W @IOF D FULL^VALM1,ADD^GMPL1 S VALMBCK="R" I $D(GMPSAVED) S GMPREBLD=1,GMPLCNT=GMPLCNT+1 K VALMHDR
92 Q
Note: See TracBrowser for help on using the repository browser.