source: FOIAVistA/trunk/r/PROBLEM_LIST-GMPL/GMPLBLD.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 5.9 KB
Line 
1GMPLBLD ; SLC/MKB -- Build Problem Selection Lists ; 3/12/03 9:31
2 ;;2.0;Problem List;**3,28,33**;Aug 25, 1994
3 ;
4 ;This routine invokes IA #3991
5 ;
6EN ; -- main entry point
7 D EN^VALM("GMPL SELECTION LIST BUILD")
8 Q
9 ;
10HDR ; -- header code
11 N NAME,NUM,DATE
12 S NUM=+^TMP("GMPLST",$J,0)_" categor"_$S(+^TMP("GMPLST",$J,0)'=1:"ies",1:"y")
13 S DATE="Last Modified: "_$S(+$P(GMPLSLST,U,3):$$FMTE^XLFDT($P(GMPLSLST,U,3)),1:"<new list>")
14 S VALMHDR(1)=DATE_$J(NUM,79-$L(DATE))
15 S NAME=$P(GMPLSLST,U,2),VALMHDR(2)=$J(NAME,$L(NAME)\2+41)
16 Q
17 ;
18INIT ; -- init variables and list array
19 S GMPLSLST=$$LIST^GMPLBLD2("L") I GMPLSLST="^" S VALMQUIT=1 Q
20 L +^GMPL(125,+GMPLSLST,0):1 I '$T D G INIT
21 . W $C(7),!!,"This list is currently being edited by another user!",!
22 S GMPLMODE="E",VALMSG=$$MSG^GMPLX
23 D GETLIST,BUILD("^TMP(""GMPLIST"",$J)",GMPLMODE)
24 D LENGTH
25 Q
26 ;
27GETLIST ; Build ^TMP("GMPLIST",$J,#)
28 N IFN,SEQ,GRP,ITEM,CNT K ^TMP("GMPLIST",$J) S CNT=0
29 W !,"Searching for the list ..."
30 F IFN=0:0 S IFN=$O(^GMPL(125.1,"B",+GMPLSLST,IFN)) Q:IFN'>0 D
31 . S ITEM=$G(^GMPL(125.1,IFN,0)),SEQ=$P(ITEM,U,2),GRP=$P(ITEM,U,3)
32 . S ^TMP("GMPLIST",$J,IFN)=$P(ITEM,U,2,5),CNT=CNT+1 ; seq ^ group ^ subhdr ^ probs
33 . S (^TMP("GMPLIST",$J,"GRP",GRP),^TMP("GMPLIST",$J,"SEQ",SEQ))=IFN
34 S ^TMP("GMPLIST",$J,0)=CNT
35 Q
36 ;
37BUILD(LIST,MODE) ; Build ^TMP("GMPLST",$J,)
38 N SEQ,LCNT,NUM,HDR,GROUP,IFN,ITEM,PSEQ D CLEAN^VALM10
39 S:'$D(^TMP("GMPLIST",$J,0)) ^TMP("GMPLIST",$J,0)=0
40 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
41 S (LCNT,NUM,SEQ)=0
42 F S SEQ=$O(^TMP("GMPLIST",$J,"SEQ",SEQ)) Q:SEQ'>0 D
43 . S IFN=^TMP("GMPLIST",$J,"SEQ",SEQ),LCNT=LCNT+1,NUM=NUM+1
44 . S GROUP=$P(^TMP("GMPLIST",$J,IFN),U,2),HDR=$P(^TMP("GMPLIST",$J,IFN),U,3)
45 . S:'$L(HDR) HDR="<no header>"
46 . I LCNT>1,+$P(^TMP("GMPLIST",$J,IFN),U,4),^TMP("GMPLST",$J,LCNT-1,0)'=" " S LCNT=LCNT+1,^TMP("GMPLST",$J,LCNT,0)=" "
47 . S ^TMP("GMPLST",$J,LCNT,0)=$S(MODE="I":$J("<"_SEQ_">",8),1:" ")_$J(NUM,4)_" "_HDR,^TMP("GMPLST",$J,"B",NUM)=IFN
48 . D CNTRL^VALM10(LCNT,9,5,IOINHI,IOINORM)
49 . Q:'+$P(^TMP("GMPLIST",$J,IFN),U,4)
50 . D CNTRL^VALM10(LCNT,14,$L(HDR),IOUON,IOUOFF)
51 . F PSEQ=0:0 S PSEQ=$O(^GMPL(125.12,"C",+GROUP,PSEQ)) Q:PSEQ'>0 D
52 . . S IFN=$O(^GMPL(125.12,"C",+GROUP,PSEQ,0)),LCNT=LCNT+1
53 . . S ITEM=$G(^GMPL(125.12,IFN,0)),^TMP("GMPLST",$J,LCNT,0)=" "_$P(ITEM,U,4)
54 . . I $L($P(ITEM,U,5)) D
55 ... S ^TMP("GMPLST",$J,LCNT,0)=^TMP("GMPLST",$J,LCNT,0)_" ("_$P(ITEM,U,5)_")"
56 ... I $$STATCHK^ICDAPIU($P(ITEM,U,5),DT) Q ; code is active
57 ... S ^TMP("GMPLST",$J,LCNT,0)=^TMP("GMPLST",$J,LCNT,0)_" <INACTIVE CODE>"
58 . S LCNT=LCNT+1,^TMP("GMPLST",$J,LCNT,0)=" "
59 S ^TMP("GMPLST",$J,0)=NUM_U_LCNT,VALMCNT=LCNT
60 Q
61 ;
62HELP ; -- help code
63 N X
64 W !!?4,"You may take a variety of actions to update this selection list."
65 W !?4,"New categories may be added to this list, or an existing one"
66 W !?4,"removed; Edit Category will allow you to change the contents of"
67 W !?4,"a category, or create a new one that may be added to this list."
68 W !?4,"You may also change how each category appears in this list,"
69 W !?4,"view each category's sequence number to facilitate resequencing,"
70 W !?4,"assign this list to a clinic or user(s), or edit a different list."
71 W !!,"Press <return> to continue ..." R X:DTIME
72 S VALMSG=$$MSG^GMPLX,VALMBCK=$S(VALMCC:"",1:"R")
73 Q
74 ;
75EXIT ; -- exit code
76 I $D(GMPLSAVE),$$CKSAVE^GMPLBLD2 D
77 . D SAVE^GMPLBLD2
78 . S ^GMPL(125,+GMPLSLST,0)=$P(GMPLSLST,U,2)_U_DT_U_$P(GMPLSLST,U,4)
79 L -^GMPL(125,+GMPLSLST,0)
80 K GMPLIST,GMPLST,GMPLMODE,GMPLSLST,GMPLSAVE,GMPREBLD,GMPQUIT,RT,TMPLST
81 K ^TMP("GMPLIST",$J),^TMP("GMPLST",$J)
82 Q
83 ;
84ADD ; Add group(s)
85 N SEQ,GROUP,HDR,IFN,GMPQUIT,GMPREBLD D FULL^VALM1
86 F D Q:$D(GMPQUIT) W !
87 . S GROUP=$$GROUP^GMPLBLD2("") I GROUP="^" S GMPQUIT=1 Q
88 . I $D(^TMP("GMPLIST",$J,"GRP",+GROUP)) W !?4,">>> This category is already part of this list!" Q
89 . I '$$VALGRP^GMPLBLD2(+GROUP) D Q
90 .. D FULL^VALM1
91 .. W !!,$C(7),"This category contains one or more problems with inactive ICD-9 codes. "
92 .. W !,"These codes must be updated before adding the category to a selection list."
93 .. N DIR,DTOUT,DIRUT,DUOUT,X,Y
94 .. S DIR(0)="E" D ^DIR
95 .. S VALMBCK="R"
96 . S HDR=$$HDR^GMPLBLD1($P(GROUP,U,2)) I HDR="^" S GMPQUIT=1 Q
97 . S RT="^TMP(""GMPLIST"",$J,""SEQ"",",SEQ=+$$LAST^GMPLBLD2(RT)+1
98 . S SEQ=$$SEQ^GMPLBLD1(SEQ) I SEQ="^" S GMPQUIT=1 Q
99 . S IFN=$$TMPIFN^GMPLBLD1,^TMP("GMPLIST",$J,IFN)=SEQ_U_+GROUP_U_HDR_"^1"
100 . S (^TMP("GMPLIST",$J,"GRP",+GROUP),^TMP("GMPLIST",$J,"SEQ",SEQ))=IFN,^TMP("GMPLIST",$J,0)=^TMP("GMPLIST",$J,0)+1,GMPREBLD=1
101 I $D(GMPREBLD) S VALMBCK="R",GMPLSAVE=1 D BUILD("^TMP(""GMPLIST"",$J)",GMPLMODE),HDR
102 S VALMBCK="R",VALMSG=$$MSG^GMPLX
103 Q
104 ;
105EDIT ; Edit category contents
106 N GMPLIST,GMPLST,GMPLMODE,GMPLGRP,GMPLSAVE
107 D EN^VALM("GMPL SELECTION GROUP BUILD")
108 S GMPLMODE="E"
109 D GETLIST,BUILD("TMP(""GMPLIST"",$J)",GMPLMODE)
110 S VALMBCK="R",VALMSG=$$MSG^GMPLX
111 Q
112 ;
113REMOVE ; Remove group
114 N NUM,IFN,SEQ,GRP,DIR,X,Y S VALMBCK=""
115 S NUM=$$SEL1^GMPLBLD1 G:NUM="^" RMQ
116 S IFN=$G(^TMP("GMPLST",$J,"B",NUM)) G:+IFN'>0 RMQ
117 I "@"[$G(^TMP("GMPLIST",$J,IFN)) W $C(7),!!,"Category is not part of this list!" H 2 G RMQ
118 S DIR("A")="Are you sure you want to remove '"_$P(^TMP("GMPLIST",$J,IFN),U,3)_"'? "
119 S DIR("?")="Enter YES to delete this category from the current list; enter NO to exit."
120 S DIR(0)="YA",DIR("B")="NO" D ^DIR
121 I 'Y W !?5,"< Nothing removed! >" H 1 G RMQ
122 D DELETE^GMPLBLD1(IFN) S VALMBCK="R",GMPLSAVE=1
123 D BUILD("^TMP(""GMPLIST"",$J)",GMPLMODE),HDR
124RMQ S:'VALMCC VALMBCK="R" S VALMSG=$$MSG^GMPLX
125 Q
126 ;
127LENGTH ;SHORTEN THE ICD9'S DESCRIPTION TO FIT SCREEN
128 S LLCNT=0
129 F S LLCNT=$O(^TMP("GMPLST",$J,LLCNT)) Q:LLCNT="" Q:LLCNT'?1N.N D
130 .; I '$D(^TMP("GMPLST",$J,LLCNT,O)) Q
131 . S ICD9VAR=^TMP("GMPLST",$J,LLCNT,0) I $L(ICD9VAR)>50 D
132 .. S ICD9VAR=$P(ICD9VAR,"(",1)
133 .. S ICD9VAR=$E(ICD9VAR,1,50)_" ("_$P(^TMP("GMPLST",$J,LLCNT,0),"(",2)
134 .. S ^TMP("GMPLST",$J,LLCNT,0)=ICD9VAR
135 Q
Note: See TracBrowser for help on using the repository browser.