| [613] | 1 | TIUPLST ; 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
|
|---|
| 3 | MAIN ; 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
|
|---|
| 10 | INTROTXT ; 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
|
|---|
| 31 | GETEDIT ; 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
|
|---|
| 54 | DOCNAME(TIUDA) ; Get the NAME (.01) field of the document
|
|---|
| 55 | Q $P($G(^TIU(8925.1,+TIUDA,0)),U)
|
|---|
| 56 | NEWLIST(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
|
|---|
| 69 | NEWX Q +$G(Y)
|
|---|
| 70 | ;
|
|---|
| 71 | DELETE(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
|
|---|
| 84 | DIK(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
|
|---|
| 90 | EDIT(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
|
|---|
| 97 | ALREADY(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
|
|---|
