source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPLST.m@ 724

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

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1TIUPLST ; SLC/JER - Enter/edit personal document pick-list ;13-JUL-2000 10:43:41
2 ;;1.0;TEXT INTEGRATION UTILITIES;**91,103**;Jun 20, 1997
3MAIN ; Control branching
4 N DA,TIUFPRIV,DUOUT,DTOUT
5 S TIUFPRIV=1
6 D INTROTXT
7 I $S($D(DUOUT):1,$D(DTOUT):1,$D(DIROUT):1,1:0) Q
8 D GETEDIT
9 Q
10INTROTXT ; Write Introductory Text for the Option
11 W !
12 D JUSTIFY^TIUU("--- Personal Document Lists ---","C")
13 W !!,"This option allows you to create and maintain lists of TITLES for any of the"
14 W !,"active CLASSES of documents supported by TIU at your site.",!
15 I '$$READ^TIUU("Y","Explain Details","NO") Q
16 W !!,"When you use the option to enter a document belonging to a given class"
17 W !,"you will be asked to select a TITLE belonging to that class."
18 W !!,"For any particular class, you may find that you only wish to choose from"
19 W !,"among a few highly specific titles (e.g., if you are a Pulmonologist"
20 W !,"entering a PROGRESS NOTE, you may wish to choose from a short list of"
21 W !,"three or four titles related to Pulmonary Function, or Pulmonary Disease)."
22 W !,"Rather than presenting you with a list of hundreds of unrelated titles,"
23 W !,"TIU will present you with the list you name here."
24 W !!,"In the event that you need to select a TITLE which doesn't appear on your"
25 W !,"list, you will always be able to do so."
26 W !!,"NOTE: If you expect to enter a single title, or would be unduely restricted"
27 W !,"by use of a short list, then we recommend that you bypass the creation of"
28 W !,"a list, and simply enter a DEFAULT TITLE for the class...This option will"
29 W !,"afford you the opportunity to do so.",!
30 Q
31GETEDIT ; Get record in picklist file, determine action
32 N D,DIC,TIUNM,X,Y,CREATE,PROMPT
33 S TIUNM=$P(^VA(200,+$G(DUZ),0),U)
34 W !," Enter/edit Personal Document List"
35 I +$O(^TIU(8925.98,"B",DUZ,0))'>0 D Q
36 . S Y=+$$NEWLIST(TIUNM,1)
37 . I +Y>0 D EDIT(+Y)
38 W !!,"You already have one or more Personal Lists...",!
39 S PROMPT="You may (E)dit, (D)elete, or (C)reate a List: "
40 S CREATE=$P($$READ^TIUU("SA^E:edit;D:delete;C:create",PROMPT,"EDIT"),U)
41 I $S(CREATE="":1,$D(DUOUT):1,$D(DTOUT):1,$D(DIROUT):1,1:0) Q
42 I CREATE="C" S Y=+$$NEWLIST(TIUNM) D:+Y>0 EDIT(+Y) Q
43 W !!,"Please choose a list to ",$S(CREATE="E":"Edit",1:"Delete"),"...",!
44 S DIC=8925.98,DIC(0)="ENZ",D="B",X=DUZ
45 S DIC("S")="I +$G(^TIU(8925.98,+Y,0))=DUZ"
46 S DIC("W")="W ?21,"" "",$E($$DOCNAME^TIUPLST($P(^TIU(8925.98,+Y,0),U,2)),1,34)"
47 D IX^DIC
48 ;TIU*1*91 limit NEWLIST to CREATE=E (If include D & get good Y from NEWLIST, still deletes, never get to edit):
49 I +Y'>0,CREATE="E" W !!,"No List Selected...",! S Y=+$$NEWLIST(TIUNM,1)
50 I +Y'>0 W !!,"No changes made..." Q
51 I CREATE="D" D DELETE(+Y) Q
52 D EDIT(+Y)
53 Q
54DOCNAME(TIUDA) ; Get the NAME (.01) field of the document
55 Q $P($G(^TIU(8925.1,+TIUDA,0)),U)
56NEWLIST(TIUNM,ASK) ; Create a new List for the user
57 N ASKNEW,DIC,DLAYGO,Y
58 S DIC="^TIU(8925.98,",DLAYGO=8925.98,DIC(0)="UNXLZ",ASKNEW=1
59 I +$G(ASK) S ASKNEW=$$READ^TIUU("Y","Add a new Personal Document List","YES")
60 I +ASKNEW'>0 S Y=-1 G NEWX
61 S X=DUZ,D="B"
62 S X=""""_"`"_X_""""
63 W !!,"Creating a new Personal Document List...",!
64 D IX^DIC
65 ;TIU*1*91 If DIC adds new entry, can get anyone w/ same name:
66 I Y>0,+Y(0)'=DUZ N DA,DIK D
67 . W !!," Sorry, you can create lists for YOURSELF only. Please try again."
68 . I $P(Y,U,3)=1 S DA=+Y,DIK="^TIU(8925.98," D ^DIK S Y=-1
69NEWX Q +$G(Y)
70 ;
71DELETE(DA) ; Call ^DIK to delete the list
72 N YASURE,TIUNAME S YASURE=0
73 S TIUNAME=$$UP^XLFSTR($$PNAME^TIULC1($P(^TIU(8925.98,+DA,0),U,2)))
74 I TIUNAME'="UNKNOWN" D
75 . W !!,"You are about to DELETE your entry for CLASS "
76 . W TIUNAME,!
77 . S YASURE=$$READ^TIUU("Y","Are you SURE","NO")
78 I TIUNAME="UNKNOWN" D
79 . W !!,"You must specify a CLASS in order to maintain the list.",!
80 . S YASURE=1
81 I +YASURE'>0 W !!,"Nothing deleted...No harm done!" Q
82 D DIK(DA,TIUNAME)
83 Q
84DIK(DA,TIUNAME) ; Remove a list
85 N DIK
86 S DIK="^TIU(8925.98,"
87 D ^DIK
88 I $G(TIUNAME)]"" W !,TIUNAME," List DELETED."
89 Q
90EDIT(DA) ; Call ^DIE to edit the record
91 N DIE,DIRUT,DIROUT,DTOUT,DR,X,Y,TIUCLASS,TIUASK
92 S DIE=8925.98
93 S DR="[TIU ENTER/EDIT PERSONAL LIST]"
94 D ^DIE Q:$D(Y)!$D(DTOUT)
95 I $G(TIUCLASS)="" D DIK(DA,"")
96 Q
97ALREADY(TIUCLASS) ; Indicate that a List for TIUCLASS already exists
98 W !!,$C(7),"You already have a list for class ",$$PNAME^TIULC1(TIUCLASS),"."
99 W !!,"Please Edit that list instead..."
100 Q
Note: See TracBrowser for help on using the repository browser.