Routine: TIUPLST

TIUPLST ; SLC/JER - Enter/edit personal document pick-list ;13-JUL-2000 10:43:41

 ;;1.0;TEXT INTEGRATION UTILITIES;**91,103**;Jun 20, 1997

MAIN ; Control branching

 N DA,TIUFPRIV,DUOUT,DTOUT

 S TIUFPRIV=1

 D INTROTXT

 I $S($D(DUOUT):1,$D(DTOUT):1,$D(DIROUT):1,1:0) Q

 D GETEDIT

INTROTXT ; Write Introductory Text for the Option

W !

 D JUSTIFY^TIUU("--- Personal Document Lists ---","C")

 W !!,"This option allows you to create and maintain lists of TITLES for any of the"

 W !,"active CLASSES of documents supported by TIU at your site.",!

 I '$$READ^TIUU("Y","Explain Details","NO") Q

 W !!,"When you use the option to enter a document belonging to a given class"

 W !,"you will be asked to select a TITLE belonging to that class."

 W !!,"For any particular class, you may find that you only wish to choose from"

 W !,"among a few highly specific titles (e.g., if you are a Pulmonologist"

 W !,"entering a PROGRESS NOTE, you may wish to choose from a short list of"

 W !,"three or four titles related to Pulmonary Function, or Pulmonary Disease)."

 W !,"Rather than presenting you with a list of hundreds of unrelated titles,"

 W !,"TIU will present you with the list you name here."

 W !!,"In the event that you need to select a TITLE which doesn't appear on your"

 W !,"list, you will always be able to do so."

 W !!,"NOTE:  If you expect to enter a single title, or would be unduely restricted"

 W !,"by use of a short list, then we recommend that you bypass the creation of"

 W !,"a list, and simply enter a DEFAULT TITLE for the class...This option will"

 W !,"afford you the opportunity to do so.",!

GETEDIT ; Get record in picklist file, determine action

 N D,DIC,TIUNM,X,Y,CREATE,PROMPT

 S TIUNM=$P(^VA(200,+$G(DUZ),0),U)

 W !,"   Enter/edit Personal Document List"

 I +$O(^TIU(8925.98,"B",DUZ,0))'>0 D  Q

 . S Y=+$$NEWLIST(TIUNM,1)

 . I +Y>0 D EDIT(+Y)

 W !!,"You already have one or more Personal Lists...",!

 S PROMPT="You may (E)dit, (D)elete, or (C)reate a List: "

 S CREATE=$P($$READ^TIUU("SA^E:edit;D:delete;C:create",PROMPT,"EDIT"),U)

 I $S(CREATE="":1,$D(DUOUT):1,$D(DTOUT):1,$D(DIROUT):1,1:0) Q

 I CREATE="C" S Y=+$$NEWLIST(TIUNM) D:+Y>0 EDIT(+Y) Q

 W !!,"Please choose a list to ",$S(CREATE="E":"Edit",1:"Delete"),"...",!

 S DIC=8925.98,DIC(0)="ENZ",D="B",X=DUZ

 S DIC("S")="I +$G(^TIU(8925.98,+Y,0))=DUZ"

 S DIC("W")="W ?21,"" "",$E($$DOCNAME^TIUPLST($P(^TIU(8925.98,+Y,0),U,2)),1,34)"

 D IX^DIC

 ;TIU*1*91 limit NEWLIST to CREATE=E (If include D & get good Y from NEWLIST, still deletes, never get to edit):

 I +Y'>0,CREATE="E" W !!,"No List Selected...",! S Y=+$$NEWLIST(TIUNM,1)

 I +Y'>0 W !!,"No changes made..." Q

 I CREATE="D" D DELETE(+Y) Q

 D EDIT(+Y)

DOCNAME(TIUDA) ; Get the NAME (.01) field of the document

 Q $P($G(^TIU(8925.1,+TIUDA,0)),U)

NEWLIST(TIUNM,ASK) ; Create a new List for the user

 N ASKNEW,DIC,DLAYGO,Y

 S DIC="^TIU(8925.98,",DLAYGO=8925.98,DIC(0)="UNXLZ",ASKNEW=1

 I +$G(ASK) S ASKNEW=$$READ^TIUU("Y","Add a new Personal Document List","YES")

 I +ASKNEW'>0 S Y=-1 G NEWX

 S X=DUZ,D="B"

 S X=""""_"`"_X_""""

 W !!,"Creating a new Personal Document List...",!

 D IX^DIC

 ;TIU*1*91 If DIC adds new entry, can get anyone w/ same name:

 I Y>0,+Y(0)'=DUZ N DA,DIK D

 . W !!,"   Sorry, you can create lists for YOURSELF only.  Please try again."

 . I $P(Y,U,3)=1 S DA=+Y,DIK="^TIU(8925.98," D ^DIK S Y=-1

NEWX Q +$G(Y)

DELETE(DA) ; Call ^DIK to delete the list

 N YASURE,TIUNAME S YASURE=0

 S TIUNAME=$$UP^XLFSTR($$PNAME^TIULC1($P(^TIU(8925.98,+DA,0),U,2)))

 I TIUNAME'="UNKNOWN" D

 . W !!,"You are about to DELETE your entry for CLASS "

 . W TIUNAME,!

 . S YASURE=$$READ^TIUU("Y","Are you SURE","NO")

 I TIUNAME="UNKNOWN" D

 . W !!,"You must specify a CLASS in order to maintain the list.",!

 . S YASURE=1

 I +YASURE'>0 W !!,"Nothing deleted...No harm done!" Q

 D DIK(DA,TIUNAME)

DIK(DA,TIUNAME) ; Remove a list

 N DIK

 S DIK="^TIU(8925.98,"

 D ^DIK

 I $G(TIUNAME)]"" W !,TIUNAME," List DELETED."

EDIT(DA) ; Call ^DIE to edit the record

 N DIE,DIRUT,DIROUT,DTOUT,DR,X,Y,TIUCLASS,TIUASK

 S DIE=8925.98

 S DR="[TIU ENTER/EDIT PERSONAL LIST]"

 D ^DIE  Q:$D(Y)!$D(DTOUT)

 I $G(TIUCLASS)="" D DIK(DA,"")

ALREADY(TIUCLASS) ; Indicate that a List for TIUCLASS already exists

 W !!,$C(7),"You already have a list for class ",$$PNAME^TIULC1(TIUCLASS),"."

 W !!,"Please Edit that list instead..."

TIUPLST   ; SLC/JER - Enter/edit personal document pick-list ;13-JUL-2000 10:43:41

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**91,103**;Jun 20, 1997

MAIN      ; Control branching

 +1        NEW DA,TIUFPRIV,DUOUT,DTOUT

 +2        SET TIUFPRIV=1

 +3        DO INTROTXT

 +4        IF $SELECT($DATA(DUOUT):1,$DATA(DTOUT):1,$DATA(DIROUT):1,1:0)

               QUIT

 +5        DO GETEDIT

 +6        QUIT

INTROTXT  ; Write Introductory Text for the Option

 +1        WRITE !

 +2        DO JUSTIFY^TIUU("--- Personal Document Lists ---","C")

 +3        WRITE !!,"This option allows you to create and maintain lists of TITLES for any of the"

 +4        WRITE !,"active CLASSES of documents supported by TIU at your site.",!

 +5        IF '$$READ^TIUU("Y","Explain Details","NO")

               QUIT

 +6        WRITE !!,"When you use the option to enter a document belonging to a given class"

 +7        WRITE !,"you will be asked to select a TITLE belonging to that class."

 +8        WRITE !!,"For any particular class, you may find that you only wish to choose from"

 +9        WRITE !,"among a few highly specific titles (e.g., if you are a Pulmonologist"

 +10       WRITE !,"entering a PROGRESS NOTE, you may wish to choose from a short list of"

 +11       WRITE !,"three or four titles related to Pulmonary Function, or Pulmonary Disease)."

 +12       WRITE !,"Rather than presenting you with a list of hundreds of unrelated titles,"

 +13       WRITE !,"TIU will present you with the list you name here."

 +14       WRITE !!,"In the event that you need to select a TITLE which doesn't appear on your"

 +15       WRITE !,"list, you will always be able to do so."

 +16       WRITE !!,"NOTE:  If you expect to enter a single title, or would be unduely restricted"

 +17       WRITE !,"by use of a short list, then we recommend that you bypass the creation of"

 +18       WRITE !,"a list, and simply enter a DEFAULT TITLE for the class...This option will"

 +19       WRITE !,"afford you the opportunity to do so.",!

 +20       QUIT

GETEDIT   ; Get record in picklist file, determine action

 +1        NEW D,DIC,TIUNM,X,Y,CREATE,PROMPT

 +2        SET TIUNM=$PIECE(^VA(200,+$GET(DUZ),0),U)

 +3        WRITE !,"   Enter/edit Personal Document List"

 +4        IF +$ORDER(^TIU(8925.98,"B",DUZ,0))'>0

               Begin DoDot:1

 +5                SET Y=+$$NEWLIST(TIUNM,1)

 +6                IF +Y>0

                       DO EDIT(+Y)

               End DoDot:1

               QUIT

 +7        WRITE !!,"You already have one or more Personal Lists...",!

 +8        SET PROMPT="You may (E)dit, (D)elete, or (C)reate a List: "

 +9        SET CREATE=$PIECE($$READ^TIUU("SA^E:edit;D:delete;C:create",PROMPT,"EDIT"),U)

 +10       IF $SELECT(CREATE="":1,$DATA(DUOUT):1,$DATA(DTOUT):1,$DATA(DIROUT):1,1:0)

               QUIT

 +11       IF CREATE="C"

               SET Y=+$$NEWLIST(TIUNM)

               IF +Y>0

                   DO EDIT(+Y)

               QUIT

 +12       WRITE !!,"Please choose a list to ",$SELECT(CREATE="E":"Edit",1:"Delete"),"...",!

 +13       SET DIC=8925.98

           SET DIC(0)="ENZ"

           SET D="B"

           SET X=DUZ

 +14       SET DIC("S")="I +$G(^TIU(8925.98,+Y,0))=DUZ"

 +15       SET DIC("W")="W ?21,"" "",$E($$DOCNAME^TIUPLST($P(^TIU(8925.98,+Y,0),U,2)),1,34)"

 +16       DO IX^DIC

 +17      ;TIU*1*91 limit NEWLIST to CREATE=E (If include D & get good Y from NEWLIST, still deletes, never get to edit):

 +18       IF +Y'>0

               IF CREATE="E"

                   WRITE !!,"No List Selected...",!

                   SET Y=+$$NEWLIST(TIUNM,1)

 +19       IF +Y'>0

               WRITE !!,"No changes made..."

               QUIT

 +20       IF CREATE="D"

               DO DELETE(+Y)

               QUIT

 +21       DO EDIT(+Y)

 +22       QUIT

DOCNAME(TIUDA) ; Get the NAME (.01) field of the document

 +1        QUIT $PIECE($GET(^TIU(8925.1,+TIUDA,0)),U)

NEWLIST(TIUNM,ASK) ; Create a new List for the user

 +1        NEW ASKNEW,DIC,DLAYGO,Y

 +2        SET DIC="^TIU(8925.98,"

           SET DLAYGO=8925.98

           SET DIC(0)="UNXLZ"

           SET ASKNEW=1

 +3        IF +$GET(ASK)

               SET ASKNEW=$$READ^TIUU("Y","Add a new Personal Document List","YES")

 +4        IF +ASKNEW'>0

               SET Y=-1

               GOTO NEWX

 +5        SET X=DUZ

           SET D="B"

 +6        SET X=""""_"`"_X_""""

 +7        WRITE !!,"Creating a new Personal Document List...",!

 +8        DO IX^DIC

 +9       ;TIU*1*91 If DIC adds new entry, can get anyone w/ same name:

 +10       IF Y>0

               IF +Y(0)'=DUZ

                   NEW DA,DIK

                   Begin DoDot:1

 +11                   WRITE !!,"   Sorry, you can create lists for YOURSELF only.  Please try again."

 +12                   IF $PIECE(Y,U,3)=1

                           SET DA=+Y

                           SET DIK="^TIU(8925.98,"

                           DO ^DIK

                           SET Y=-1

                   End DoDot:1

NEWX       QUIT +$GET(Y)

 +1       ;

DELETE(DA) ; Call ^DIK to delete the list

 +1        NEW YASURE,TIUNAME

           SET YASURE=0

 +2        SET TIUNAME=$$UP^XLFSTR($$PNAME^TIULC1($PIECE(^TIU(8925.98,+DA,0),U,2)))

 +3        IF TIUNAME'="UNKNOWN"

               Begin DoDot:1

 +4                WRITE !!,"You are about to DELETE your entry for CLASS "

 +5                WRITE TIUNAME,!

 +6                SET YASURE=$$READ^TIUU("Y","Are you SURE","NO")

               End DoDot:1

 +7        IF TIUNAME="UNKNOWN"

               Begin DoDot:1

 +8                WRITE !!,"You must specify a CLASS in order to maintain the list.",!

 +9                SET YASURE=1

               End DoDot:1

 +10       IF +YASURE'>0

               WRITE !!,"Nothing deleted...No harm done!"

               QUIT

 +11       DO DIK(DA,TIUNAME)

 +12       QUIT

DIK(DA,TIUNAME) ; Remove a list

 +1        NEW DIK

 +2        SET DIK="^TIU(8925.98,"

 +3        DO ^DIK

 +4        IF $GET(TIUNAME)]""

               WRITE !,TIUNAME," List DELETED."

 +5        QUIT

EDIT(DA)  ; Call ^DIE to edit the record

 +1        NEW DIE,DIRUT,DIROUT,DTOUT,DR,X,Y,TIUCLASS,TIUASK

 +2        SET DIE=8925.98

 +3        SET DR="[TIU ENTER/EDIT PERSONAL LIST]"

 +4        DO ^DIE

           IF $DATA(Y)!$DATA(DTOUT)

               QUIT

 +5        IF $GET(TIUCLASS)=""

               DO DIK(DA,"")

 +6        QUIT

ALREADY(TIUCLASS) ; Indicate that a List for TIUCLASS already exists

 +1        WRITE !!,$CHAR(7),"You already have a list for class ",$$PNAME^TIULC1(TIUCLASS),"."

 +2        WRITE !!,"Please Edit that list instead..."

 +3        QUIT

TIUPLST.m