Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BTIUPLST

BTIUPLST.m

Go to the documentation of this file. 
  1. BTIUPLST ; IHS/ITSC/LJF - Enter/edit personal document pick-list ;
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004
  1.  ;IHS version of TIUPLST
  1.  ;    -- changed intro text and how it is called
  1.  ;    -- allowed user holding TIUZCMGR key to edit other users' lists
  1.  ;    -- removed create another list if user already has one
  1.  ;    -- changed input template so timestamp xref would be fired
  1.  ;
  1. MAIN ; Control branching
  1.  N DA,TIUFPRIV,TIUDUZ
  1.  S TIUFPRIV=1
  1.  D INTROTXT
  1.  D GETEDIT
  1.  Q
  1. INTROTXT ; Write Introductory Text for the Option
  1.  D ^XBCLS
  1.  D JUSTIFY^TIUU("--- Personal Document Lists ---","C")
  1.  D MSG^BTIUU(" ",1,0,0)
  1.  F I=1:1 S X=$P($T(HELP+I),";;",2) Q:X=""  D MSG^BTIUU(X,1,0,0)
  1.  D MSG^BTIUU(" ",1,0,0)
  1.  Q
  1.  ;
  1. HELP ;;
  1.  ;;Use this option to maintain your personal list of frequently used;;
  1.  ;;document titles.  You can enter up to 18 titles on your list.  In;;
  1.  ;;the event you need to select a title not on your personal list,;;
  1.  ;;that option will always be able to you.;;
  1.  Q
  1. GETEDIT ; Get record in picklist file, determine action
  1.  N DIC,X,Y,CREATE,PROMPT
  1.  S TIUDUZ=$$SETDUZ Q:TIUDUZ<1
  1.  S X=$P(^VA(200,+$G(TIUDUZ),0),U)
  1.  W !,"   Enter/edit Personal Document List for "
  1.  W $$NAME^TIULS(X,"FIRST LAST")
  1.  I +$O(^TIU(8925.98,"B",TIUDUZ,0))'>0 D  Q
  1.  . S Y=+$$NEWLIST(X,1)
  1.  . I +Y>0 S DA=+Y D EDIT
  1.  I TIUDUZ=DUZ W !!,"You already have a Personal List...",!
  1.  E  W !!,"This TIU user already has a Personal List...",!
  1.  S PROMPT="You may (E)dit, or (D)elete the List: "
  1.  S CREATE=$P($$READ^TIUU("SA^E:edit;D:delete",PROMPT,"EDIT"),U)
  1.  I CREATE="" Q
  1.  S Y=$O(^TIU(8925.98,"B",TIUDUZ,0))
  1.  I CREATE="D" D DELETE(+Y) Q
  1.  S DA=+Y D EDIT
  1.  Q
  1. NEWLIST(X,ASK) ; Create a new List for the user
  1.  N ASKNEW,DIC,DLAYGO,Y S (DIC,DLAYGO)=8925.98,DIC(0)="ELMZ",ASKNEW=1
  1.  I +$G(ASK) S ASKNEW=$$READ^TIUU("Y","Add a new Personal Document List","YES")
  1.  I +ASKNEW'>0 S Y=-1 G NEWX
  1.  S X=""""_X_"""",DIC(0)="LXZ",DIC("DR")=".02////38" D ^DIC
  1. NEWX Q +$G(Y)
  1.  ;
  1. DELETE(DA) ; Call ^DIK to delete the list
  1.  N DIK,YASURE,TIUNAME S YASURE=0
  1.  S TIUNAME=$$UP^XLFSTR($$PNAME^TIULC1($P(^TIU(8925.98,+DA,0),U,2)))
  1.  W !!,"You are about to delete your entry for CLASS "
  1.  W TIUNAME,!
  1.  S YASURE=$$READ^TIUU("Y","Are you SURE","NO")
  1.  I +YASURE'>0 W !,"Nothing deleted...No harm done!" Q
  1.  S DIK="^TIU(8925.98,"
  1.  D ^DIK
  1.  W !,TIUNAME," List DELETED."
  1.  Q
  1. EDIT ; Call ^DIE to edit the record
  1.  N DIE,DR,TIUCLASS,TIUASK
  1.  S DIE=8925.98
  1.  ;S DR="[TIU ENTER/EDIT PERSONAL LIST]"  ;original VA
  1.  S DR="[BTIU PERSONAL LIST EDIT]"        ;use IHS input template
  1.  D ^DIE
  1.  Q
  1.  ;
  1. PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
  1.  Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
  1.  ;
  1. SP(NUM) ; -- SUBRTN to pad spaces
  1.  Q $$PAD(" ",NUM)
  1.  ;
  1. SETDUZ() ; -- returns user to edit
  1.  I '$D(^XUSEC("TIUZCMGR",DUZ)) Q DUZ
  1.  NEW DIC,Y
  1.  S DIC=200,DIC(0)="AEMQZ",DIC("A")="Select TIU User: " D ^DIC Q +Y