- 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 Feb 19, 2025@00:07:39 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 ;