- 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 Jan 18, 2025@03:42:17 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 ;