source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFLF5.m@ 1259

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

initial load of WorldVistAEHR
File size: 6.8 KB
Line 
1TIUFLF5 ; SLC/MAM - Library; File 8925.1 Related: STATSCRN(),STATLIST(FILEDA,PFILEDA,NEWSTAT,STATMSG,STATLIST), ANCSTAT(FILEDA), POSSSTAT(TYPE), STATOK(TYPE,NEWSTAT), SELSTAT(FILEDA,PFILEDA,DEFLT),STATWORD(PIECE7) ;4/17/97 23:35
2 ;;1.0;TEXT INTEGRATION UTILITIES;**5**;Jun 20, 1997
3 ;
4STATSCRN() ; Function returns DD Status Screen for Status Field .07:
5 ;Permits only Statuses which apply to Document Definitions.
6 ; Used only as an additional safeguard for persons using FILEMAN.
7 ;INACTIVE, TEST, ACTIVE.
8 Q "I ($P(^(0),U,4)=""DEF"")"
9 ;
10STATOK(TYPE,NEWSTAT) ; Function returns 1/0 if NEWSTAT is/isn't permissible for TYPE.
11 ; Requires internal Type e.g. CL; Requires NEWSTAT= I, T, or A.
12 N ANS,STAT,MSG
13 S STAT=$$POSSSTAT(TYPE)
14 I STAT[NEWSTAT S ANS=1 G STOKX
15 S MSG=" Status Limited to "_$S(STAT="ITA":"I, T, or A: ",STAT="IA":"I or A: ",1:"I: ")_$S(STAT="I":"No Type/Bad Type",1:^TMP("TIUF",$J,"TYPE"_TYPE))
16 W !!,MSG,!
17 S ANS=0
18STOKX Q ANS
19 ;
20STATLIST(FILEDA,PFILEDA,NEWSTAT,STATMSG,STATLIST) ; Module sets List of possible Statuses, sets msg explaining any limitations on Status
21 ; Requires FILEDA of 8925.1 entry whose Status is being edited, as set in ASKSTAT^TIUFLF6.
22 ; Requires PFILEDA if FILEDA has an actual or prospective parent
23 ;(as in Create, Add Items).
24 ; Optional NEWSTAT = I, T, or A for anticipated new status. If entry hs bad status but user is correcting it, don't tell them it's bad.
25 ; Optional STATLIST: Returns STATLIST = subset of "AIT", representing acceptable Statuses.
26 ; STATLIST is called BEFORE user edits status of particular entry.
27 N NODE0,TYPE,POSSSTAT,ANCSTAT,STATUS
28 S PFILEDA=+$G(PFILEDA),STATMSG=""
29 S NODE0=^TIU(8925.1,FILEDA,0),TYPE=$P(NODE0,U,4),POSSSTAT=$$POSSSTAT(TYPE)
30 N TIUFCK D CHECK^TIUFLF3(FILEDA,PFILEDA,1,.TIUFCK) G:$D(DTOUT) STATX
31 ; Problem with Check:
32 I 'TIUFCK D I $L($G(STATMSG)) G STATX
33 . ; Problem with Check is Wrong Status:
34 . I $D(TIUFCK("S")) D Q
35 . . S STATLIST=POSSSTAT
36 . . ; If going to change Status to permissable one, and Status is the ONLY problem, don't set msg:
37 . . I $D(NEWSTAT),POSSSTAT[$E(NEWSTAT) K TIUFCK("S") I $D(TIUFCK)'>9 Q
38 . . ; If present Status is wrong set msg:
39 . . I TYPE="CL"!(TYPE="DC")!(TYPE="O") S STATMSG=" Status Limited to A or I: "_^TMP("TIUF",$J,"TYPE"_TYPE) Q
40 . K TIUFCK("S") I $D(TIUFCK)'>9 Q
41 . ; Problem with Check is not Status:
42 . I $G(NEWSTAT)'="I" S STATLIST="I",STATMSG=" Status Limited to I: "_$P(TIUFCK,U,2)
43 ; Inactive Ancestor Problem:
44 I 'PFILEDA G STATX
45 S ANCSTAT=$$ANCSTAT(FILEDA,PFILEDA)
46 I ANCSTAT D S STATLIST="I" G STATX
47 . ; Limits STATLIST to I if entry has inactive (or no status) ancestor.
48 . ;Sets Ancestor msg only if inactive ancestor AND user has mistakenly chosen something other than inactive on the first try at editing
49 . S STATUS=$S($G(Y):$E($G(^TMP("TIUF",$J,"STAT"_Y))),1:$G(NEWSTAT))
50 . I STATUS'="I" S STATMSG=" Status Limited to I: Inactive Ancestor"
51STATX I '$D(STATLIST) D
52 . I POSSSTAT="I" S STATLIST="I" Q:$G(NEWSTAT)="I"
53 . I POSSSTAT="A" S STATLIST="A" Q:$G(NEWSTAT)="A"
54 . I POSSSTAT="IA" S STATLIST="IA" Q:"IA"[$G(NEWSTAT)
55 . I '$D(STATLIST) S STATLIST="ITA" Q
56 . I TYPE="CL"!(TYPE="DC")!(TYPE="O") S STATMSG=" Status Limited to A or I: "_^TMP("TIUF",$J,"TYPE"_TYPE) Q
57 Q
58 ;
59ANCSTAT(FILEDA,PFILEDA) ; Function returns 1 if any Ancestor is Inactive [or has no status];
60 N PNODE0,PANCEST,ANSTAT,TIUI,PANCSTAT
61 ;Check parent separately since item may have only PROSPECTIVE parent:
62 S ANSTAT=0,PNODE0=^TIU(8925.1,PFILEDA,0),PANCSTAT=$P(PNODE0,U,7)
63 I PANCSTAT=+^TMP("TIUF",$J,"STATI")!'PANCSTAT S ANSTAT=1 G ANCSX
64 D ANCESTOR^TIUFLF4(PFILEDA,PNODE0,.PANCEST)
65 F TIUI=1:1 Q:'$G(PANCEST(TIUI)) D Q:ANSTAT
66 . S PANCSTAT=$P(^TIU(8925.1,PANCEST(TIUI),0),U,7)
67 . I PANCSTAT=+^TMP("TIUF",$J,"STATI")!'PANCSTAT S ANSTAT=1
68ANCSX Q ANSTAT
69 ;
70POSSSTAT(TYPE) ; Function returns permissible Statuses for Type
71 ; Permissible Statuses is string subset of ITA: (Inactive, Test, Active)
72 ; Requires internal Type e.g. CL
73 N POSSSTAT
74 S POSSSTAT=$S(TYPE="CL":"IA",TYPE="DC":"IA",TYPE="DOC":"ITA",TYPE="CO":"ITA",TYPE="O":"IA",1:"I") ; Inactive for bad or no Type.
75 Q POSSSTAT
76 ;
77SELSTAT(FILEDA,PFILEDA,DEFLT) ; Function Prompts for Status, Returns Selected Status: ActiveIFN^ACTIVE, InactiveIFN^INACTIVE, TestIFN^TEST, "" if nothing selected or @ entered.
78 ; Optional FILEDA: not received for Edit Status.
79 ; Optional PFILEDA
80 ; Optional DEFLT = 'INACTIVE', etc.
81 ; FILEDA, PFILEDA,DEFLT are needed when editing Status under Edit Basics
82 ;NOT needed when selecting Status for Edit Status.
83 ;
84 ; Requires TIUFXNOD
85 ; NOTE: In order to write reasons for limits on status when editing status, edit is done with a FREE TEXT reader call, a list of permissible statuses, and a check of the result. So don't look for a screen on the status field.
86 N DIR,X,Y,DA,STATUS,AOK,INACTOK,TOK,CHOICE,STATSCRN,TIUFSMSG
87 N TIUFSLST,STATOK
88 I '$G(FILEDA) S FILEDA=0
89 S DIR(0)=$S(TIUFXNOD["Status...":"FAO^1:9",1:"FA^1:9"),(DIR("?"),DIR("??"))="^D STATUS^TIUFXHLX"
90 I $D(DEFLT) S DIR("B")=DEFLT
91 ;TIUFSMSG, TIUFSLST set by STATLIST; used in Xecut help
92 I FILEDA D STATLIST(FILEDA,+$G(PFILEDA),0,.TIUFSMSG,.TIUFSLST) G:$D(DTOUT) SELSX D
93 . S (AOK,INACTOK,TOK)=0
94 . S:TIUFSLST["A" AOK=1 S:TIUFSLST["I" INACTOK=1 S:TIUFSLST["T" TOK=1
95 . S CHOICE=""
96 . I AOK S CHOICE=CHOICE_$S(CHOICE'="":"/A",1:"A")
97 . I INACTOK S CHOICE=CHOICE_$S(CHOICE'="":"/I",1:"I")
98 . I TOK S CHOICE=CHOICE_$S(CHOICE'="":"/T",1:"T")
99 . S CHOICE="("_CHOICE_")"
100 I 'FILEDA D
101 . I TIUFXNOD["Status..." D
102 . . I $P($G(TIUFATTR),U)="T",$P($G(TIUFAVAL),U)="O" S CHOICE="(A/I)",TIUFSLST="AI",TIUFSMSG="Status limited to A or I: OBJECT" Q
103 . . S CHOICE="(A/I/T)",TIUFSLST="AIT"
104 S DIR("A")=$S('FILEDA:"Select STATUS",1:"STATUS")_": "_CHOICE_": "
105AGAIN D ^DIR I $D(DTOUT)!$D(DUOUT) S STATUS="" G SELSX
106 S STATUS=$$UPPER^TIULS(Y)
107 D I 'STATOK G AGAIN
108 . S STATOK=1
109 . I $E(STATUS)="A","ACTIVE"[STATUS W:(STATUS'="ACTIVE") " ACTIVE" S STATUS=^TMP("TIUF",$J,"STATA") Q ;11^ACTIVE
110 . I $E(STATUS)="I","INACTIVE"[STATUS W:(STATUS'="INACTIVE") " INACTIVE" S STATUS=^TMP("TIUF",$J,"STATI") Q
111 . I $E(STATUS)="T","TEST"[STATUS W:(STATUS'="TEST") " TEST" S STATUS=^TMP("TIUF",$J,"STATT") Q
112 . I STATUS'="" W " ?? Enter '^' to exit" S STATOK=0 Q
113 I FILEDA,STATUS,TIUFSLST'[$E($P(STATUS,U,2)) S STATUS="" W " ??" G AGAIN ; User entered something that doesn't pass screen.
114SELSX S:$D(DTOUT) STATUS=""
115 Q STATUS
116 ;
117STATWORD(PIECE7) ; Function returns Status as a word: ACTIVE, TEST, INACTIVE or NO/BAD
118 ; NO/BAD if no status or status is missing from 8925.6 status file, or status is not entry active, test or inactive in 8925.6.
119 ; Requires PIECE7= fld .07 of 8925.1 entry, could be null
120 N STATANS
121 I '$D(^TMP("TIUF",$J,"STATI")) D SETUP^TIUFL
122 S STATANS=$G(^TMP("TIUF",$J,"STAT"_+PIECE7))
123 I (STATANS'="ACTIVE"),(STATANS'="TEST"),(STATANS'="INACTIVE") S STATANS="NO/BAD"
124 Q STATANS
125 ;
Note: See TracBrowser for help on using the repository browser.