TIUFLF8 ; SLC/MAM - Library; File 8925.1 Related: SELTYPE(FILEDA,DEFLT), EDOWN(DA,XFLG) ;7/1/97 20:39
;;1.0;TEXT INTEGRATION UTILITIES;**2**;Jun 20, 1997
;
SELTYPE(FILEDA,DEFLT) ; Function Prompts for Type, Returns Selected Type: CL, DC, TL, CO, O, [N for NONE], "" if nothing selected or @ entered.
; Optional FILEDA: if not received, include 'NONE' as selectable Type.
; Optional DEFLT = 'CLASS', 'TITLE' etc.
; FILEDA, DEFLT are needed when editing Type; NOT needed when selecting Type for SORT. Assume for SORT if FILEDA is not received.
; If used for editing Type, requires TIUFTLST as set in TYPELIST
N DIR,X,Y,TYPE,CHOICE,TMP
K DIRUT,DUOUT,DIROUT
S FILEDA=+$G(FILEDA)
S DIR(0)=$S(TIUFXNOD["Sort"!(TIUFXNOD["Change View"):"FA0^1:14",1:"FA^1:9"),(DIR("?"),DIR("??"))="^D TYPE^TIUFXHLX"
I $D(DEFLT) S DIR("B")=DEFLT
S CHOICE=""
I FILEDA F TYPE="CL","DC","DOC","CO","O" D
. I TIUFTLST[(U_TYPE_U) S:TYPE="DOC" TYPE="TL" S CHOICE=CHOICE_$S(CHOICE'="":"/"_TYPE,1:TYPE)
I 'FILEDA S CHOICE="CL/DC/TL/CO/O/N"
S CHOICE="("_CHOICE_")"
S DIR("A")=$S('FILEDA:"Select TYPE",1:"TYPE")_": "_CHOICE_": "
D ^DIR I $D(DTOUT)!$D(DUOUT) S TYPE="" G SELTX
S TYPE=$$UPPER^TIULS(Y)
D
. I $E(TYPE,1,2)="CL","CLASS"[TYPE W:(TYPE'="CLASS") " CLASS" S TYPE="CL" Q
. I TYPE="DC" W " DOCUMENT CLASS" Q
. I $E(TYPE,1,2)="DO","DOCUMENT CLASS"[TYPE W:(TYPE'="DOCUMENT CLASS") " DOCUMENT CLASS" S TYPE="DC" Q
. I TYPE="TL" W " TITLE" Q
. I $E(TYPE,1,2)="TI","TITLE"[TYPE W:(TYPE'="TITLE") " TITLE" S TYPE="TL" Q
. I $E(TYPE,1,2)="CO","COMPONENT"[TYPE W:(TYPE'="COMPONENT") " COMPONENT" S TYPE="CO" Q
. I TYPE="O" W " OBJECT" Q
. I $E(TYPE,1,2)="OB","OBJECT"[TYPE W:(TYPE'="OBJECT") " OBJECT" S TYPE="O" Q
. I 'FILEDA,$E(TYPE)="N","NONE"[TYPE W:(TYPE'="NONE") " NONE" S TYPE="NONE" Q
. S TYPE=""
I FILEDA D
. S TMP=TYPE I TMP="TL" S TMP="DOC"
. I TMP'="",TIUFTLST'[(U_TMP_U) S TYPE="" ; User entered something not permitted.
SELTX Q TYPE
;
EDOWN(DA,XFLG) ; User edit Owner.
; Returns XFLG=1 if user ^exited, else as received.
N DR,DIE,X,Y,NODE0,POWNER,COWNER
D GET(DA,.NODE0,.POWNER,.COWNER)
D FULL^VALM1 S TIUFFULL=1,DIE=8925.1 K DUOUT
I POWNER,'COWNER D OWNPERS(DA,.NODE0,.POWNER,.COWNER) G:$D(DTOUT)!$D(DUOUT) EDOWX D:'POWNER OWNCLAS(DA,.NODE0,.POWNER,.COWNER) G EDOWX
I COWNER,'POWNER D OWNCLAS(DA,.NODE0,.POWNER,.COWNER) G:$D(DTOUT)!$D(DUOUT) EDOWX D:'COWNER OWNPERS(DA,.NODE0,.POWNER,.COWNER) G EDOWX
I 'POWNER,'COWNER D OWNCLAS(DA,.NODE0,.POWNER,.COWNER) G:$D(DTOUT)!$D(DUOUT) EDOWX D:'COWNER OWNPERS(DA,.NODE0,.POWNER,.COWNER) G EDOWX
I POWNER,COWNER D OWNCLAS(DA,.NODE0,.POWNER,.COWNER) G:$D(DTOUT)!$D(DUOUT) EDOWX D:COWNER OWNPERS(DA,.NODE0,.POWNER,.COWNER) G EDOWX
EDOWX S:$D(DUOUT)!$D(DTOUT) XFLG=1
D OWNCHEC(DA)
Q
;
OWNCHEC(DA) ; Check for no owners, both owners, stuff personal owner if problem
N NODE0,POWNER,COWNER,DR,DIE,X,Y
D GET(DA,.NODE0,.POWNER,.COWNER) S DIE=8925.1
I 'POWNER,'COWNER W !!,"Since Entry has no Owner, you have been made the Personal Owner.",!! D:'$D(DTOUT) PAUSE^TIUFXHLX S DR=".05////^S X=DUZ" D ^DIE
I POWNER,COWNER W !!,"Since Entry has both Personal and Class Owners, Class Owner has been deleted",!,"and you have been made the Personal Owner.",!! D:'$D(DTOUT) PAUSE^TIUFXHLX S DR=".05////^S X=DUZ;.06///@" D ^DIE
Q
;
GET(DA,NODE0,POWNER,COWNER) ; Get Owner data
S NODE0=^TIU(8925.1,DA,0),POWNER=$P(NODE0,U,5),COWNER=$P(NODE0,U,6)
Q
;
OWNCLAS(FILEDA,NODE0,POWNER,COWNER) ; Edit Owner Class
N DIR,X,Y,ANS,DIE,DR,DA
I 'COWNER,$G(^TMP("TIUF",$J,"CLPAC")) S DIR("B")="CLINICAL COORDINATOR"
S DA=FILEDA
S DIR(0)="8925.1,.06O",DIE=8925.1 D ^DIR I $D(DTOUT)!$D(DUOUT) Q
S:X="@" Y=X S:Y Y=+Y S ANS=Y ; Y was returned like 17^CLINICAL COORDINATOR
S DR=".06////^S X=ANS" D ^DIE
D GET(FILEDA,.NODE0,.POWNER,.COWNER)
Q
;
OWNPERS(FILEDA,NODE0,POWNER,COWNER) ; Edit Personal Owner
N DIR,X,Y,ANS,DIE,DR
S DA=FILEDA,DIR(0)="8925.1,.05O",DIE=8925.1 D ^DIR I $D(DTOUT)!$D(DUOUT) Q
S:X="@" Y=X S:Y Y=+Y S ANS=Y
S DR=".05////^S X=ANS" D ^DIE
D GET(FILEDA,.NODE0,.POWNER,.COWNER)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFLF8 4135 printed Oct 16, 2024@18:41:48 Page 2
TIUFLF8 ; SLC/MAM - Library; File 8925.1 Related: SELTYPE(FILEDA,DEFLT), EDOWN(DA,XFLG) ;7/1/97 20:39
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**2**;Jun 20, 1997
+2 ;
SELTYPE(FILEDA,DEFLT) ; Function Prompts for Type, Returns Selected Type: CL, DC, TL, CO, O, [N for NONE], "" if nothing selected or @ entered.
+1 ; Optional FILEDA: if not received, include 'NONE' as selectable Type.
+2 ; Optional DEFLT = 'CLASS', 'TITLE' etc.
+3 ; FILEDA, DEFLT are needed when editing Type; NOT needed when selecting Type for SORT. Assume for SORT if FILEDA is not received.
+4 ; If used for editing Type, requires TIUFTLST as set in TYPELIST
+5 NEW DIR,X,Y,TYPE,CHOICE,TMP
+6 KILL DIRUT,DUOUT,DIROUT
+7 SET FILEDA=+$GET(FILEDA)
+8 SET DIR(0)=$SELECT(TIUFXNOD["Sort"!(TIUFXNOD["Change View"):"FA0^1:14",1:"FA^1:9")
SET (DIR("?"),DIR("??"))="^D TYPE^TIUFXHLX"
+9 IF $DATA(DEFLT)
SET DIR("B")=DEFLT
+10 SET CHOICE=""
+11 IF FILEDA
FOR TYPE="CL","DC","DOC","CO","O"
Begin DoDot:1
+12 IF TIUFTLST[(U_TYPE_U)
if TYPE="DOC"
SET TYPE="TL"
SET CHOICE=CHOICE_$SELECT(CHOICE'="":"/"_TYPE,1:TYPE)
End DoDot:1
+13 IF 'FILEDA
SET CHOICE="CL/DC/TL/CO/O/N"
+14 SET CHOICE="("_CHOICE_")"
+15 SET DIR("A")=$SELECT('FILEDA:"Select TYPE",1:"TYPE")_": "_CHOICE_": "
+16 DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET TYPE=""
GOTO SELTX
+17 SET TYPE=$$UPPER^TIULS(Y)
+18 Begin DoDot:1
+19 IF $EXTRACT(TYPE,1,2)="CL"
IF "CLASS"[TYPE
if (TYPE'="CLASS")
WRITE " CLASS"
SET TYPE="CL"
QUIT
+20 IF TYPE="DC"
WRITE " DOCUMENT CLASS"
QUIT
+21 IF $EXTRACT(TYPE,1,2)="DO"
IF "DOCUMENT CLASS"[TYPE
if (TYPE'="DOCUMENT CLASS")
WRITE " DOCUMENT CLASS"
SET TYPE="DC"
QUIT
+22 IF TYPE="TL"
WRITE " TITLE"
QUIT
+23 IF $EXTRACT(TYPE,1,2)="TI"
IF "TITLE"[TYPE
if (TYPE'="TITLE")
WRITE " TITLE"
SET TYPE="TL"
QUIT
+24 IF $EXTRACT(TYPE,1,2)="CO"
IF "COMPONENT"[TYPE
if (TYPE'="COMPONENT")
WRITE " COMPONENT"
SET TYPE="CO"
QUIT
+25 IF TYPE="O"
WRITE " OBJECT"
QUIT
+26 IF $EXTRACT(TYPE,1,2)="OB"
IF "OBJECT"[TYPE
if (TYPE'="OBJECT")
WRITE " OBJECT"
SET TYPE="O"
QUIT
+27 IF 'FILEDA
IF $EXTRACT(TYPE)="N"
IF "NONE"[TYPE
if (TYPE'="NONE")
WRITE " NONE"
SET TYPE="NONE"
QUIT
+28 SET TYPE=""
End DoDot:1
+29 IF FILEDA
Begin DoDot:1
+30 SET TMP=TYPE
IF TMP="TL"
SET TMP="DOC"
+31 ; User entered something not permitted.
IF TMP'=""
IF TIUFTLST'[(U_TMP_U)
SET TYPE=""
End DoDot:1
SELTX QUIT TYPE
+1 ;
EDOWN(DA,XFLG) ; User edit Owner.
+1 ; Returns XFLG=1 if user ^exited, else as received.
+2 NEW DR,DIE,X,Y,NODE0,POWNER,COWNER
+3 DO GET(DA,.NODE0,.POWNER,.COWNER)
+4 DO FULL^VALM1
SET TIUFFULL=1
SET DIE=8925.1
KILL DUOUT
+5 IF POWNER
IF 'COWNER
DO OWNPERS(DA,.NODE0,.POWNER,.COWNER)
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO EDOWX
if 'POWNER
DO OWNCLAS(DA,.NODE0,.POWNER,.COWNER)
GOTO EDOWX
+6 IF COWNER
IF 'POWNER
DO OWNCLAS(DA,.NODE0,.POWNER,.COWNER)
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO EDOWX
if 'COWNER
DO OWNPERS(DA,.NODE0,.POWNER,.COWNER)
GOTO EDOWX
+7 IF 'POWNER
IF 'COWNER
DO OWNCLAS(DA,.NODE0,.POWNER,.COWNER)
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO EDOWX
if 'COWNER
DO OWNPERS(DA,.NODE0,.POWNER,.COWNER)
GOTO EDOWX
+8 IF POWNER
IF COWNER
DO OWNCLAS(DA,.NODE0,.POWNER,.COWNER)
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO EDOWX
if COWNER
DO OWNPERS(DA,.NODE0,.POWNER,.COWNER)
GOTO EDOWX
EDOWX if $DATA(DUOUT)!$DATA(DTOUT)
SET XFLG=1
+1 DO OWNCHEC(DA)
+2 QUIT
+3 ;
OWNCHEC(DA) ; Check for no owners, both owners, stuff personal owner if problem
+1 NEW NODE0,POWNER,COWNER,DR,DIE,X,Y
+2 DO GET(DA,.NODE0,.POWNER,.COWNER)
SET DIE=8925.1
+3 IF 'POWNER
IF 'COWNER
WRITE !!,"Since Entry has no Owner, you have been made the Personal Owner.",!!
if '$DATA(DTOUT)
DO PAUSE^TIUFXHLX
SET DR=".05////^S X=DUZ"
DO ^DIE
+4 IF POWNER
IF COWNER
WRITE !!,"Since Entry has both Personal and Class Owners, Class Owner has been deleted",!,"and you have been made the Personal Owner.",!!
if '$DATA(DTOUT)
DO PAUSE^TIUFXHLX
SET DR=".05////^S X=DUZ;.06///@"
DO ^DIE
+5 QUIT
+6 ;
GET(DA,NODE0,POWNER,COWNER) ; Get Owner data
+1 SET NODE0=^TIU(8925.1,DA,0)
SET POWNER=$PIECE(NODE0,U,5)
SET COWNER=$PIECE(NODE0,U,6)
+2 QUIT
+3 ;
OWNCLAS(FILEDA,NODE0,POWNER,COWNER) ; Edit Owner Class
+1 NEW DIR,X,Y,ANS,DIE,DR,DA
+2 IF 'COWNER
IF $GET(^TMP("TIUF",$JOB,"CLPAC"))
SET DIR("B")="CLINICAL COORDINATOR"
+3 SET DA=FILEDA
+4 SET DIR(0)="8925.1,.06O"
SET DIE=8925.1
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+5 ; Y was returned like 17^CLINICAL COORDINATOR
if X="@"
SET Y=X
if Y
SET Y=+Y
SET ANS=Y
+6 SET DR=".06////^S X=ANS"
DO ^DIE
+7 DO GET(FILEDA,.NODE0,.POWNER,.COWNER)
+8 QUIT
+9 ;
OWNPERS(FILEDA,NODE0,POWNER,COWNER) ; Edit Personal Owner
+1 NEW DIR,X,Y,ANS,DIE,DR
+2 SET DA=FILEDA
SET DIR(0)="8925.1,.05O"
SET DIE=8925.1
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+3 if X="@"
SET Y=X
if Y
SET Y=+Y
SET ANS=Y
+4 SET DR=".05////^S X=ANS"
DO ^DIE
+5 DO GET(FILEDA,.NODE0,.POWNER,.COWNER)
+6 QUIT
+7 ;
