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