source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFLF8.m@ 1046

Last change on this file since 1046 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.0 KB
RevLine 
[613]1TIUFLF8 ; SLC/MAM - Library; File 8925.1 Related: SELTYPE(FILEDA,DEFLT), EDOWN(DA,XFLG) ;7/1/97 20:39
2 ;;1.0;TEXT INTEGRATION UTILITIES;**2**;Jun 20, 1997
3 ;
4SELTYPE(FILEDA,DEFLT) ; Function Prompts for Type, Returns Selected Type: CL, DC, TL, CO, O, [N for NONE], "" if nothing selected or @ entered.
5 ; Optional FILEDA: if not received, include 'NONE' as selectable Type.
6 ; Optional DEFLT = 'CLASS', 'TITLE' etc.
7 ; FILEDA, DEFLT are needed when editing Type; NOT needed when selecting Type for SORT. Assume for SORT if FILEDA is not received.
8 ; If used for editing Type, requires TIUFTLST as set in TYPELIST
9 N DIR,X,Y,TYPE,CHOICE,TMP
10 K DIRUT,DUOUT,DIROUT
11 S FILEDA=+$G(FILEDA)
12 S DIR(0)=$S(TIUFXNOD["Sort"!(TIUFXNOD["Change View"):"FA0^1:14",1:"FA^1:9"),(DIR("?"),DIR("??"))="^D TYPE^TIUFXHLX"
13 I $D(DEFLT) S DIR("B")=DEFLT
14 S CHOICE=""
15 I FILEDA F TYPE="CL","DC","DOC","CO","O" D
16 . I TIUFTLST[(U_TYPE_U) S:TYPE="DOC" TYPE="TL" S CHOICE=CHOICE_$S(CHOICE'="":"/"_TYPE,1:TYPE)
17 I 'FILEDA S CHOICE="CL/DC/TL/CO/O/N"
18 S CHOICE="("_CHOICE_")"
19 S DIR("A")=$S('FILEDA:"Select TYPE",1:"TYPE")_": "_CHOICE_": "
20 D ^DIR I $D(DTOUT)!$D(DUOUT) S TYPE="" G SELTX
21 S TYPE=$$UPPER^TIULS(Y)
22 D
23 . I $E(TYPE,1,2)="CL","CLASS"[TYPE W:(TYPE'="CLASS") " CLASS" S TYPE="CL" Q
24 . I TYPE="DC" W " DOCUMENT CLASS" Q
25 . I $E(TYPE,1,2)="DO","DOCUMENT CLASS"[TYPE W:(TYPE'="DOCUMENT CLASS") " DOCUMENT CLASS" S TYPE="DC" Q
26 . I TYPE="TL" W " TITLE" Q
27 . I $E(TYPE,1,2)="TI","TITLE"[TYPE W:(TYPE'="TITLE") " TITLE" S TYPE="TL" Q
28 . I $E(TYPE,1,2)="CO","COMPONENT"[TYPE W:(TYPE'="COMPONENT") " COMPONENT" S TYPE="CO" Q
29 . I TYPE="O" W " OBJECT" Q
30 . I $E(TYPE,1,2)="OB","OBJECT"[TYPE W:(TYPE'="OBJECT") " OBJECT" S TYPE="O" Q
31 . I 'FILEDA,$E(TYPE)="N","NONE"[TYPE W:(TYPE'="NONE") " NONE" S TYPE="NONE" Q
32 . S TYPE=""
33 I FILEDA D
34 . S TMP=TYPE I TMP="TL" S TMP="DOC"
35 . I TMP'="",TIUFTLST'[(U_TMP_U) S TYPE="" ; User entered something not permitted.
36SELTX Q TYPE
37 ;
38EDOWN(DA,XFLG) ; User edit Owner.
39 ; Returns XFLG=1 if user ^exited, else as received.
40 N DR,DIE,X,Y,NODE0,POWNER,COWNER
41 D GET(DA,.NODE0,.POWNER,.COWNER)
42 D FULL^VALM1 S TIUFFULL=1,DIE=8925.1 K DUOUT
43 I POWNER,'COWNER D OWNPERS(DA,.NODE0,.POWNER,.COWNER) G:$D(DTOUT)!$D(DUOUT) EDOWX D:'POWNER OWNCLAS(DA,.NODE0,.POWNER,.COWNER) G EDOWX
44 I COWNER,'POWNER D OWNCLAS(DA,.NODE0,.POWNER,.COWNER) G:$D(DTOUT)!$D(DUOUT) EDOWX D:'COWNER OWNPERS(DA,.NODE0,.POWNER,.COWNER) G EDOWX
45 I 'POWNER,'COWNER D OWNCLAS(DA,.NODE0,.POWNER,.COWNER) G:$D(DTOUT)!$D(DUOUT) EDOWX D:'COWNER OWNPERS(DA,.NODE0,.POWNER,.COWNER) G EDOWX
46 I POWNER,COWNER D OWNCLAS(DA,.NODE0,.POWNER,.COWNER) G:$D(DTOUT)!$D(DUOUT) EDOWX D:COWNER OWNPERS(DA,.NODE0,.POWNER,.COWNER) G EDOWX
47EDOWX S:$D(DUOUT)!$D(DTOUT) XFLG=1
48 D OWNCHEC(DA)
49 Q
50 ;
51OWNCHEC(DA) ; Check for no owners, both owners, stuff personal owner if problem
52 N NODE0,POWNER,COWNER,DR,DIE,X,Y
53 D GET(DA,.NODE0,.POWNER,.COWNER) S DIE=8925.1
54 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
55 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
56 Q
57 ;
58GET(DA,NODE0,POWNER,COWNER) ; Get Owner data
59 S NODE0=^TIU(8925.1,DA,0),POWNER=$P(NODE0,U,5),COWNER=$P(NODE0,U,6)
60 Q
61 ;
62OWNCLAS(FILEDA,NODE0,POWNER,COWNER) ; Edit Owner Class
63 N DIR,X,Y,ANS,DIE,DR,DA
64 I 'COWNER,$G(^TMP("TIUF",$J,"CLPAC")) S DIR("B")="CLINICAL COORDINATOR"
65 S DA=FILEDA
66 S DIR(0)="8925.1,.06O",DIE=8925.1 D ^DIR I $D(DTOUT)!$D(DUOUT) Q
67 S:X="@" Y=X S:Y Y=+Y S ANS=Y ; Y was returned like 17^CLINICAL COORDINATOR
68 S DR=".06////^S X=ANS" D ^DIE
69 D GET(FILEDA,.NODE0,.POWNER,.COWNER)
70 Q
71 ;
72OWNPERS(FILEDA,NODE0,POWNER,COWNER) ; Edit Personal Owner
73 N DIR,X,Y,ANS,DIE,DR
74 S DA=FILEDA,DIR(0)="8925.1,.05O",DIE=8925.1 D ^DIR I $D(DTOUT)!$D(DUOUT) Q
75 S:X="@" Y=X S:Y Y=+Y S ANS=Y
76 S DR=".05////^S X=ANS" D ^DIE
77 D GET(FILEDA,.NODE0,.POWNER,.COWNER)
78 Q
79 ;
Note: See TracBrowser for help on using the repository browser.