Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUFLF5

TIUFLF5.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. STATSCRN() ; Function returns DD Status Screen for Status Field .07:
  1. ;Permits only Statuses which apply to Document Definitions.
  1. ; Used only as an additional safeguard for persons using FILEMAN.
  1. ;INACTIVE, TEST, ACTIVE.
  1. Q "I ($P(^(0),U,4)=""DEF"")"
  1. ;
  1. 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.
  1. N ANS,STAT,MSG
  1. S STAT=$$POSSSTAT(TYPE)
  1. I STAT[NEWSTAT S ANS=1 G STOKX
  1. 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))
  1. W !!,MSG,!
  1. S ANS=0
  1. STOKX Q ANS
  1. ;
  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.
  1. ; Requires PFILEDA if FILEDA has an actual or prospective parent
  1. ;(as in Create, Add Items).
  1. ; 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.
  1. ; Optional STATLIST: Returns STATLIST = subset of "AIT", representing acceptable Statuses.
  1. ; STATLIST is called BEFORE user edits status of particular entry.
  1. N NODE0,TYPE,POSSSTAT,ANCSTAT,STATUS
  1. S PFILEDA=+$G(PFILEDA),STATMSG=""
  1. S NODE0=^TIU(8925.1,FILEDA,0),TYPE=$P(NODE0,U,4),POSSSTAT=$$POSSSTAT(TYPE)
  1. N TIUFCK D CHECK^TIUFLF3(FILEDA,PFILEDA,1,.TIUFCK) G:$D(DTOUT) STATX
  1. ; Problem with Check:
  1. I 'TIUFCK D I $L($G(STATMSG)) G STATX
  1. . ; Problem with Check is Wrong Status:
  1. . I $D(TIUFCK("S")) D Q
  1. . . S STATLIST=POSSSTAT
  1. . . ; If going to change Status to permissable one, and Status is the ONLY problem, don't set msg:
  1. . . I $D(NEWSTAT),POSSSTAT[$E(NEWSTAT) K TIUFCK("S") I $D(TIUFCK)'>9 Q
  1. . . ; If present Status is wrong set msg:
  1. . . I TYPE="CL"!(TYPE="DC")!(TYPE="O") S STATMSG=" Status Limited to A or I: "_^TMP("TIUF",$J,"TYPE"_TYPE) Q
  1. . K TIUFCK("S") I $D(TIUFCK)'>9 Q
  1. . ; Problem with Check is not Status:
  1. . I $G(NEWSTAT)'="I" S STATLIST="I",STATMSG=" Status Limited to I: "_$P(TIUFCK,U,2)
  1. ; Inactive Ancestor Problem:
  1. I 'PFILEDA G STATX
  1. S ANCSTAT=$$ANCSTAT(FILEDA,PFILEDA)
  1. I ANCSTAT D S STATLIST="I" G STATX
  1. . ; Limits STATLIST to I if entry has inactive (or no status) ancestor.
  1. . ;Sets Ancestor msg only if inactive ancestor AND user has mistakenly chosen something other than inactive on the first try at editing
  1. . S STATUS=$S($G(Y):$E($G(^TMP("TIUF",$J,"STAT"_Y))),1:$G(NEWSTAT))
  1. . I STATUS'="I" S STATMSG=" Status Limited to I: Inactive Ancestor"
  1. STATX I '$D(STATLIST) D
  1. . I POSSSTAT="I" S STATLIST="I" Q:$G(NEWSTAT)="I"
  1. . I POSSSTAT="A" S STATLIST="A" Q:$G(NEWSTAT)="A"
  1. . I POSSSTAT="IA" S STATLIST="IA" Q:"IA"[$G(NEWSTAT)
  1. . I '$D(STATLIST) S STATLIST="ITA" Q
  1. . I TYPE="CL"!(TYPE="DC")!(TYPE="O") S STATMSG=" Status Limited to A or I: "_^TMP("TIUF",$J,"TYPE"_TYPE) Q
  1. Q
  1. ;
  1. ANCSTAT(FILEDA,PFILEDA) ; Function returns 1 if any Ancestor is Inactive [or has no status];
  1. N PNODE0,PANCEST,ANSTAT,TIUI,PANCSTAT
  1. ;Check parent separately since item may have only PROSPECTIVE parent:
  1. S ANSTAT=0,PNODE0=^TIU(8925.1,PFILEDA,0),PANCSTAT=$P(PNODE0,U,7)
  1. I PANCSTAT=+^TMP("TIUF",$J,"STATI")!'PANCSTAT S ANSTAT=1 G ANCSX
  1. D ANCESTOR^TIUFLF4(PFILEDA,PNODE0,.PANCEST)
  1. F TIUI=1:1 Q:'$G(PANCEST(TIUI)) D Q:ANSTAT
  1. . S PANCSTAT=$P(^TIU(8925.1,PANCEST(TIUI),0),U,7)
  1. . I PANCSTAT=+^TMP("TIUF",$J,"STATI")!'PANCSTAT S ANSTAT=1
  1. ANCSX Q ANSTAT
  1. ;
  1. POSSSTAT(TYPE) ; Function returns permissible Statuses for Type
  1. ; Permissible Statuses is string subset of ITA: (Inactive, Test, Active)
  1. ; Requires internal Type e.g. CL
  1. N POSSSTAT
  1. 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.
  1. Q POSSSTAT
  1. ;
  1. 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.
  1. ; Optional PFILEDA
  1. ; Optional DEFLT = 'INACTIVE', etc.
  1. ; FILEDA, PFILEDA,DEFLT are needed when editing Status under Edit Basics
  1. ;NOT needed when selecting Status for Edit Status.
  1. ;
  1. ; Requires TIUFXNOD
  1. ; 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.
  1. N DIR,X,Y,DA,STATUS,AOK,INACTOK,TOK,CHOICE,STATSCRN,TIUFSMSG
  1. N TIUFSLST,STATOK
  1. I '$G(FILEDA) S FILEDA=0
  1. S DIR(0)=$S(TIUFXNOD["Status...":"FAO^1:9",1:"FA^1:9"),(DIR("?"),DIR("??"))="^D STATUS^TIUFXHLX"
  1. I $D(DEFLT) S DIR("B")=DEFLT
  1. ;TIUFSMSG, TIUFSLST set by STATLIST; used in Xecut help
  1. I FILEDA D STATLIST(FILEDA,+$G(PFILEDA),0,.TIUFSMSG,.TIUFSLST) G:$D(DTOUT) SELSX D
  1. . S (AOK,INACTOK,TOK)=0
  1. . S:TIUFSLST["A" AOK=1 S:TIUFSLST["I" INACTOK=1 S:TIUFSLST["T" TOK=1
  1. . S CHOICE=""
  1. . I AOK S CHOICE=CHOICE_$S(CHOICE'="":"/A",1:"A")
  1. . I INACTOK S CHOICE=CHOICE_$S(CHOICE'="":"/I",1:"I")
  1. . I TOK S CHOICE=CHOICE_$S(CHOICE'="":"/T",1:"T")
  1. . S CHOICE="("_CHOICE_")"
  1. I 'FILEDA D
  1. . I TIUFXNOD["Status..." D
  1. . . 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
  1. . . S CHOICE="(A/I/T)",TIUFSLST="AIT"
  1. S DIR("A")=$S('FILEDA:"Select STATUS",1:"STATUS")_": "_CHOICE_": "
  1. AGAIN D ^DIR I $D(DTOUT)!$D(DUOUT) S STATUS="" G SELSX
  1. S STATUS=$$UPPER^TIULS(Y)
  1. D I 'STATOK G AGAIN
  1. . S STATOK=1
  1. . I $E(STATUS)="A","ACTIVE"[STATUS W:(STATUS'="ACTIVE") " ACTIVE" S STATUS=^TMP("TIUF",$J,"STATA") Q ;11^ACTIVE
  1. . I $E(STATUS)="I","INACTIVE"[STATUS W:(STATUS'="INACTIVE") " INACTIVE" S STATUS=^TMP("TIUF",$J,"STATI") Q
  1. . I $E(STATUS)="T","TEST"[STATUS W:(STATUS'="TEST") " TEST" S STATUS=^TMP("TIUF",$J,"STATT") Q
  1. . I STATUS'="" W " ?? Enter '^' to exit" S STATOK=0 Q
  1. I FILEDA,STATUS,TIUFSLST'[$E($P(STATUS,U,2)) S STATUS="" W " ??" G AGAIN ; User entered something that doesn't pass screen.
  1. SELSX S:$D(DTOUT) STATUS=""
  1. Q STATUS
  1. ;
  1. 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.
  1. ; Requires PIECE7= fld .07 of 8925.1 entry, could be null
  1. N STATANS
  1. I '$D(^TMP("TIUF",$J,"STATI")) D SETUP^TIUFL
  1. S STATANS=$G(^TMP("TIUF",$J,"STAT"_+PIECE7))
  1. I (STATANS'="ACTIVE"),(STATANS'="TEST"),(STATANS'="INACTIVE") S STATANS="NO/BAD"
  1. Q STATANS
  1. ;