TIUFLF5 ; 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
;;1.0;TEXT INTEGRATION UTILITIES;**5**;Jun 20, 1997
;
STATSCRN() ; Function returns DD Status Screen for Status Field .07:
;Permits only Statuses which apply to Document Definitions.
; Used only as an additional safeguard for persons using FILEMAN.
;INACTIVE, TEST, ACTIVE.
Q "I ($P(^(0),U,4)=""DEF"")"
;
STATOK(TYPE,NEWSTAT) ; Function returns 1/0 if NEWSTAT is/isn't permissible for TYPE.
; Requires internal Type e.g. CL; Requires NEWSTAT= I, T, or A.
N ANS,STAT,MSG
S STAT=$$POSSSTAT(TYPE)
I STAT[NEWSTAT S ANS=1 G STOKX
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))
W !!,MSG,!
S ANS=0
STOKX Q ANS
;
STATLIST(FILEDA,PFILEDA,NEWSTAT,STATMSG,STATLIST) ; Module sets List of possible Statuses, sets msg explaining any limitations on Status
; Requires FILEDA of 8925.1 entry whose Status is being edited, as set in ASKSTAT^TIUFLF6.
; Requires PFILEDA if FILEDA has an actual or prospective parent
;(as in Create, Add Items).
; 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.
; Optional STATLIST: Returns STATLIST = subset of "AIT", representing acceptable Statuses.
; STATLIST is called BEFORE user edits status of particular entry.
N NODE0,TYPE,POSSSTAT,ANCSTAT,STATUS
S PFILEDA=+$G(PFILEDA),STATMSG=""
S NODE0=^TIU(8925.1,FILEDA,0),TYPE=$P(NODE0,U,4),POSSSTAT=$$POSSSTAT(TYPE)
N TIUFCK D CHECK^TIUFLF3(FILEDA,PFILEDA,1,.TIUFCK) G:$D(DTOUT) STATX
; Problem with Check:
I 'TIUFCK D I $L($G(STATMSG)) G STATX
. ; Problem with Check is Wrong Status:
. I $D(TIUFCK("S")) D Q
. . S STATLIST=POSSSTAT
. . ; If going to change Status to permissable one, and Status is the ONLY problem, don't set msg:
. . I $D(NEWSTAT),POSSSTAT[$E(NEWSTAT) K TIUFCK("S") I $D(TIUFCK)'>9 Q
. . ; If present Status is wrong set msg:
. . I TYPE="CL"!(TYPE="DC")!(TYPE="O") S STATMSG=" Status Limited to A or I: "_^TMP("TIUF",$J,"TYPE"_TYPE) Q
. K TIUFCK("S") I $D(TIUFCK)'>9 Q
. ; Problem with Check is not Status:
. I $G(NEWSTAT)'="I" S STATLIST="I",STATMSG=" Status Limited to I: "_$P(TIUFCK,U,2)
; Inactive Ancestor Problem:
I 'PFILEDA G STATX
S ANCSTAT=$$ANCSTAT(FILEDA,PFILEDA)
I ANCSTAT D S STATLIST="I" G STATX
. ; Limits STATLIST to I if entry has inactive (or no status) ancestor.
. ;Sets Ancestor msg only if inactive ancestor AND user has mistakenly chosen something other than inactive on the first try at editing
. S STATUS=$S($G(Y):$E($G(^TMP("TIUF",$J,"STAT"_Y))),1:$G(NEWSTAT))
. I STATUS'="I" S STATMSG=" Status Limited to I: Inactive Ancestor"
STATX I '$D(STATLIST) D
. I POSSSTAT="I" S STATLIST="I" Q:$G(NEWSTAT)="I"
. I POSSSTAT="A" S STATLIST="A" Q:$G(NEWSTAT)="A"
. I POSSSTAT="IA" S STATLIST="IA" Q:"IA"[$G(NEWSTAT)
. I '$D(STATLIST) S STATLIST="ITA" Q
. I TYPE="CL"!(TYPE="DC")!(TYPE="O") S STATMSG=" Status Limited to A or I: "_^TMP("TIUF",$J,"TYPE"_TYPE) Q
Q
;
ANCSTAT(FILEDA,PFILEDA) ; Function returns 1 if any Ancestor is Inactive [or has no status];
N PNODE0,PANCEST,ANSTAT,TIUI,PANCSTAT
;Check parent separately since item may have only PROSPECTIVE parent:
S ANSTAT=0,PNODE0=^TIU(8925.1,PFILEDA,0),PANCSTAT=$P(PNODE0,U,7)
I PANCSTAT=+^TMP("TIUF",$J,"STATI")!'PANCSTAT S ANSTAT=1 G ANCSX
D ANCESTOR^TIUFLF4(PFILEDA,PNODE0,.PANCEST)
F TIUI=1:1 Q:'$G(PANCEST(TIUI)) D Q:ANSTAT
. S PANCSTAT=$P(^TIU(8925.1,PANCEST(TIUI),0),U,7)
. I PANCSTAT=+^TMP("TIUF",$J,"STATI")!'PANCSTAT S ANSTAT=1
ANCSX Q ANSTAT
;
POSSSTAT(TYPE) ; Function returns permissible Statuses for Type
; Permissible Statuses is string subset of ITA: (Inactive, Test, Active)
; Requires internal Type e.g. CL
N POSSSTAT
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.
Q POSSSTAT
;
SELSTAT(FILEDA,PFILEDA,DEFLT) ; Function Prompts for Status, Returns Selected Status: ActiveIFN^ACTIVE, InactiveIFN^INACTIVE, TestIFN^TEST, "" if nothing selected or @ entered.
; Optional FILEDA: not received for Edit Status.
; Optional PFILEDA
; Optional DEFLT = 'INACTIVE', etc.
; FILEDA, PFILEDA,DEFLT are needed when editing Status under Edit Basics
;NOT needed when selecting Status for Edit Status.
;
; Requires TIUFXNOD
; 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.
N DIR,X,Y,DA,STATUS,AOK,INACTOK,TOK,CHOICE,STATSCRN,TIUFSMSG
N TIUFSLST,STATOK
I '$G(FILEDA) S FILEDA=0
S DIR(0)=$S(TIUFXNOD["Status...":"FAO^1:9",1:"FA^1:9"),(DIR("?"),DIR("??"))="^D STATUS^TIUFXHLX"
I $D(DEFLT) S DIR("B")=DEFLT
;TIUFSMSG, TIUFSLST set by STATLIST; used in Xecut help
I FILEDA D STATLIST(FILEDA,+$G(PFILEDA),0,.TIUFSMSG,.TIUFSLST) G:$D(DTOUT) SELSX D
. S (AOK,INACTOK,TOK)=0
. S:TIUFSLST["A" AOK=1 S:TIUFSLST["I" INACTOK=1 S:TIUFSLST["T" TOK=1
. S CHOICE=""
. I AOK S CHOICE=CHOICE_$S(CHOICE'="":"/A",1:"A")
. I INACTOK S CHOICE=CHOICE_$S(CHOICE'="":"/I",1:"I")
. I TOK S CHOICE=CHOICE_$S(CHOICE'="":"/T",1:"T")
. S CHOICE="("_CHOICE_")"
I 'FILEDA D
. I TIUFXNOD["Status..." D
. . 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
. . S CHOICE="(A/I/T)",TIUFSLST="AIT"
S DIR("A")=$S('FILEDA:"Select STATUS",1:"STATUS")_": "_CHOICE_": "
AGAIN D ^DIR I $D(DTOUT)!$D(DUOUT) S STATUS="" G SELSX
S STATUS=$$UPPER^TIULS(Y)
D I 'STATOK G AGAIN
. S STATOK=1
. I $E(STATUS)="A","ACTIVE"[STATUS W:(STATUS'="ACTIVE") " ACTIVE" S STATUS=^TMP("TIUF",$J,"STATA") Q ;11^ACTIVE
. I $E(STATUS)="I","INACTIVE"[STATUS W:(STATUS'="INACTIVE") " INACTIVE" S STATUS=^TMP("TIUF",$J,"STATI") Q
. I $E(STATUS)="T","TEST"[STATUS W:(STATUS'="TEST") " TEST" S STATUS=^TMP("TIUF",$J,"STATT") Q
. I STATUS'="" W " ?? Enter '^' to exit" S STATOK=0 Q
I FILEDA,STATUS,TIUFSLST'[$E($P(STATUS,U,2)) S STATUS="" W " ??" G AGAIN ; User entered something that doesn't pass screen.
SELSX S:$D(DTOUT) STATUS=""
Q STATUS
;
STATWORD(PIECE7) ; Function returns Status as a word: ACTIVE, TEST, INACTIVE or NO/BAD
; 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.
; Requires PIECE7= fld .07 of 8925.1 entry, could be null
N STATANS
I '$D(^TMP("TIUF",$J,"STATI")) D SETUP^TIUFL
S STATANS=$G(^TMP("TIUF",$J,"STAT"_+PIECE7))
I (STATANS'="ACTIVE"),(STATANS'="TEST"),(STATANS'="INACTIVE") S STATANS="NO/BAD"
Q STATANS
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFLF5 7049 printed Dec 13, 2024@02:41:08 Page 2
TIUFLF5 ; 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
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**5**;Jun 20, 1997
+2 ;
STATSCRN() ; Function returns DD Status Screen for Status Field .07:
+1 ;Permits only Statuses which apply to Document Definitions.
+2 ; Used only as an additional safeguard for persons using FILEMAN.
+3 ;INACTIVE, TEST, ACTIVE.
+4 QUIT "I ($P(^(0),U,4)=""DEF"")"
+5 ;
STATOK(TYPE,NEWSTAT) ; Function returns 1/0 if NEWSTAT is/isn't permissible for TYPE.
+1 ; Requires internal Type e.g. CL; Requires NEWSTAT= I, T, or A.
+2 NEW ANS,STAT,MSG
+3 SET STAT=$$POSSSTAT(TYPE)
+4 IF STAT[NEWSTAT
SET ANS=1
GOTO STOKX
+5 SET MSG=" Status Limited to "_$SELECT(STAT="ITA":"I, T, or A: ",STAT="IA":"I or A: ",1:"I: ")_$SELECT(STAT="I":"No Type/Bad Type",1:^TMP("TIUF",$JOB,"TYPE"_TYPE))
+6 WRITE !!,MSG,!
+7 SET ANS=0
STOKX QUIT ANS
+1 ;
STATLIST(FILEDA,PFILEDA,NEWSTAT,STATMSG,STATLIST) ; Module sets List of possible Statuses, sets msg explaining any limitations on Status
+1 ; Requires FILEDA of 8925.1 entry whose Status is being edited, as set in ASKSTAT^TIUFLF6.
+2 ; Requires PFILEDA if FILEDA has an actual or prospective parent
+3 ;(as in Create, Add Items).
+4 ; 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.
+5 ; Optional STATLIST: Returns STATLIST = subset of "AIT", representing acceptable Statuses.
+6 ; STATLIST is called BEFORE user edits status of particular entry.
+7 NEW NODE0,TYPE,POSSSTAT,ANCSTAT,STATUS
+8 SET PFILEDA=+$GET(PFILEDA)
SET STATMSG=""
+9 SET NODE0=^TIU(8925.1,FILEDA,0)
SET TYPE=$PIECE(NODE0,U,4)
SET POSSSTAT=$$POSSSTAT(TYPE)
+10 NEW TIUFCK
DO CHECK^TIUFLF3(FILEDA,PFILEDA,1,.TIUFCK)
if $DATA(DTOUT)
GOTO STATX
+11 ; Problem with Check:
+12 IF 'TIUFCK
Begin DoDot:1
+13 ; Problem with Check is Wrong Status:
+14 IF $DATA(TIUFCK("S"))
Begin DoDot:2
+15 SET STATLIST=POSSSTAT
+16 ; If going to change Status to permissable one, and Status is the ONLY problem, don't set msg:
+17 IF $DATA(NEWSTAT)
IF POSSSTAT[$EXTRACT(NEWSTAT)
KILL TIUFCK("S")
IF $DATA(TIUFCK)'>9
QUIT
+18 ; If present Status is wrong set msg:
+19 IF TYPE="CL"!(TYPE="DC")!(TYPE="O")
SET STATMSG=" Status Limited to A or I: "_^TMP("TIUF",$JOB,"TYPE"_TYPE)
QUIT
End DoDot:2
QUIT
+20 KILL TIUFCK("S")
IF $DATA(TIUFCK)'>9
QUIT
+21 ; Problem with Check is not Status:
+22 IF $GET(NEWSTAT)'="I"
SET STATLIST="I"
SET STATMSG=" Status Limited to I: "_$PIECE(TIUFCK,U,2)
End DoDot:1
IF $LENGTH($GET(STATMSG))
GOTO STATX
+23 ; Inactive Ancestor Problem:
+24 IF 'PFILEDA
GOTO STATX
+25 SET ANCSTAT=$$ANCSTAT(FILEDA,PFILEDA)
+26 IF ANCSTAT
Begin DoDot:1
+27 ; Limits STATLIST to I if entry has inactive (or no status) ancestor.
+28 ;Sets Ancestor msg only if inactive ancestor AND user has mistakenly chosen something other than inactive on the first try at editing
+29 SET STATUS=$SELECT($GET(Y):$EXTRACT($GET(^TMP("TIUF",$JOB,"STAT"_Y))),1:$GET(NEWSTAT))
+30 IF STATUS'="I"
SET STATMSG=" Status Limited to I: Inactive Ancestor"
End DoDot:1
SET STATLIST="I"
GOTO STATX
STATX IF '$DATA(STATLIST)
Begin DoDot:1
+1 IF POSSSTAT="I"
SET STATLIST="I"
if $GET(NEWSTAT)="I"
QUIT
+2 IF POSSSTAT="A"
SET STATLIST="A"
if $GET(NEWSTAT)="A"
QUIT
+3 IF POSSSTAT="IA"
SET STATLIST="IA"
if "IA"[$GET(NEWSTAT)
QUIT
+4 IF '$DATA(STATLIST)
SET STATLIST="ITA"
QUIT
+5 IF TYPE="CL"!(TYPE="DC")!(TYPE="O")
SET STATMSG=" Status Limited to A or I: "_^TMP("TIUF",$JOB,"TYPE"_TYPE)
QUIT
End DoDot:1
+6 QUIT
+7 ;
ANCSTAT(FILEDA,PFILEDA) ; Function returns 1 if any Ancestor is Inactive [or has no status];
+1 NEW PNODE0,PANCEST,ANSTAT,TIUI,PANCSTAT
+2 ;Check parent separately since item may have only PROSPECTIVE parent:
+3 SET ANSTAT=0
SET PNODE0=^TIU(8925.1,PFILEDA,0)
SET PANCSTAT=$PIECE(PNODE0,U,7)
+4 IF PANCSTAT=+^TMP("TIUF",$JOB,"STATI")!'PANCSTAT
SET ANSTAT=1
GOTO ANCSX
+5 DO ANCESTOR^TIUFLF4(PFILEDA,PNODE0,.PANCEST)
+6 FOR TIUI=1:1
if '$GET(PANCEST(TIUI))
QUIT
Begin DoDot:1
+7 SET PANCSTAT=$PIECE(^TIU(8925.1,PANCEST(TIUI),0),U,7)
+8 IF PANCSTAT=+^TMP("TIUF",$JOB,"STATI")!'PANCSTAT
SET ANSTAT=1
End DoDot:1
if ANSTAT
QUIT
ANCSX QUIT ANSTAT
+1 ;
POSSSTAT(TYPE) ; Function returns permissible Statuses for Type
+1 ; Permissible Statuses is string subset of ITA: (Inactive, Test, Active)
+2 ; Requires internal Type e.g. CL
+3 NEW POSSSTAT
+4 ; Inactive for bad or no Type.
SET POSSSTAT=$SELECT(TYPE="CL":"IA",TYPE="DC":"IA",TYPE="DOC":"ITA",TYPE="CO":"ITA",TYPE="O":"IA",1:"I")
+5 QUIT POSSSTAT
+6 ;
SELSTAT(FILEDA,PFILEDA,DEFLT) ; Function Prompts for Status, Returns Selected Status: ActiveIFN^ACTIVE, InactiveIFN^INACTIVE, TestIFN^TEST, "" if nothing selected or @ entered.
+1 ; Optional FILEDA: not received for Edit Status.
+2 ; Optional PFILEDA
+3 ; Optional DEFLT = 'INACTIVE', etc.
+4 ; FILEDA, PFILEDA,DEFLT are needed when editing Status under Edit Basics
+5 ;NOT needed when selecting Status for Edit Status.
+6 ;
+7 ; Requires TIUFXNOD
+8 ; 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.
+9 NEW DIR,X,Y,DA,STATUS,AOK,INACTOK,TOK,CHOICE,STATSCRN,TIUFSMSG
+10 NEW TIUFSLST,STATOK
+11 IF '$GET(FILEDA)
SET FILEDA=0
+12 SET DIR(0)=$SELECT(TIUFXNOD["Status...":"FAO^1:9",1:"FA^1:9")
SET (DIR("?"),DIR("??"))="^D STATUS^TIUFXHLX"
+13 IF $DATA(DEFLT)
SET DIR("B")=DEFLT
+14 ;TIUFSMSG, TIUFSLST set by STATLIST; used in Xecut help
+15 IF FILEDA
DO STATLIST(FILEDA,+$GET(PFILEDA),0,.TIUFSMSG,.TIUFSLST)
if $DATA(DTOUT)
GOTO SELSX
Begin DoDot:1
+16 SET (AOK,INACTOK,TOK)=0
+17 if TIUFSLST["A"
SET AOK=1
if TIUFSLST["I"
SET INACTOK=1
if TIUFSLST["T"
SET TOK=1
+18 SET CHOICE=""
+19 IF AOK
SET CHOICE=CHOICE_$SELECT(CHOICE'="":"/A",1:"A")
+20 IF INACTOK
SET CHOICE=CHOICE_$SELECT(CHOICE'="":"/I",1:"I")
+21 IF TOK
SET CHOICE=CHOICE_$SELECT(CHOICE'="":"/T",1:"T")
+22 SET CHOICE="("_CHOICE_")"
End DoDot:1
+23 IF 'FILEDA
Begin DoDot:1
+24 IF TIUFXNOD["Status..."
Begin DoDot:2
+25 IF $PIECE($GET(TIUFATTR),U)="T"
IF $PIECE($GET(TIUFAVAL),U)="O"
SET CHOICE="(A/I)"
SET TIUFSLST="AI"
SET TIUFSMSG="Status limited to A or I: OBJECT"
QUIT
+26 SET CHOICE="(A/I/T)"
SET TIUFSLST="AIT"
End DoDot:2
End DoDot:1
+27 SET DIR("A")=$SELECT('FILEDA:"Select STATUS",1:"STATUS")_": "_CHOICE_": "
AGAIN DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET STATUS=""
GOTO SELSX
+1 SET STATUS=$$UPPER^TIULS(Y)
+2 Begin DoDot:1
+3 SET STATOK=1
+4 ;11^ACTIVE
IF $EXTRACT(STATUS)="A"
IF "ACTIVE"[STATUS
if (STATUS'="ACTIVE")
WRITE " ACTIVE"
SET STATUS=^TMP("TIUF",$JOB,"STATA")
QUIT
+5 IF $EXTRACT(STATUS)="I"
IF "INACTIVE"[STATUS
if (STATUS'="INACTIVE")
WRITE " INACTIVE"
SET STATUS=^TMP("TIUF",$JOB,"STATI")
QUIT
+6 IF $EXTRACT(STATUS)="T"
IF "TEST"[STATUS
if (STATUS'="TEST")
WRITE " TEST"
SET STATUS=^TMP("TIUF",$JOB,"STATT")
QUIT
+7 IF STATUS'=""
WRITE " ?? Enter '^' to exit"
SET STATOK=0
QUIT
End DoDot:1
IF 'STATOK
GOTO AGAIN
+8 ; User entered something that doesn't pass screen.
IF FILEDA
IF STATUS
IF TIUFSLST'[$EXTRACT($PIECE(STATUS,U,2))
SET STATUS=""
WRITE " ??"
GOTO AGAIN
SELSX if $DATA(DTOUT)
SET STATUS=""
+1 QUIT STATUS
+2 ;
STATWORD(PIECE7) ; Function returns Status as a word: ACTIVE, TEST, INACTIVE or NO/BAD
+1 ; 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.
+2 ; Requires PIECE7= fld .07 of 8925.1 entry, could be null
+3 NEW STATANS
+4 IF '$DATA(^TMP("TIUF",$JOB,"STATI"))
DO SETUP^TIUFL
+5 SET STATANS=$GET(^TMP("TIUF",$JOB,"STAT"_+PIECE7))
+6 IF (STATANS'="ACTIVE")
IF (STATANS'="TEST")
IF (STATANS'="INACTIVE")
SET STATANS="NO/BAD"
+7 QUIT STATANS
+8 ;
