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

TIUFLF3.m

Go to the documentation of this file.
  1. TIUFLF3 ; SLC/MAM - Library; File 8925.1 Related: CHECK(FILEDA,PFILEDA,DETAILS,MSGARRAY), DESCCK(FILEDA), OBJECT 8/28/97 18:20
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**2,5,12,13,17**;Jun 20, 1997
  1. ;
  1. CHECK(FILEDA,PFILEDA,DETAILS,MSGARRAY) ; Module Checks Docmt Def FILEDA for completeness/correctness.
  1. ; If FILEDA is a TITLE, check includes completeness/correctness check of DESCENDANT COMPONENTS.
  1. ; If FILEDA is a TITLE or COMPONENT, check includes check of BOILERPLATE TEXT of entry/Descendants.
  1. ; Requires FILEDA.
  1. ; If FILEDA has an actual or prospective parent (as in Create, Add
  1. ;Items), requires PFILEDA to check if entry Type is right, given
  1. ;parent, to NOT set Orphan if it has a prospective parent, to check
  1. ;inheritance, etc.
  1. ; Sets MSGARRAY
  1. ; MSGARRAY=1 if OK;
  1. ; 0[^First Reason Whynot] if Not OK - Used in msgs like 'Can't Add Item:','Status limited to I:'
  1. ; If +MSGARRAY=0 then MSGARRAY(subscript)=WHYNOT as in CHECK("F") etc.
  1. ; Requires DETAILS:
  1. ; = 1 for yes if want all the subscripted problem msgs
  1. ; 0 for no if want only to know if good or bad ie first msg is enough
  1. ;
  1. ; NOTE: if you add a new subscript here, be sure to add it also in
  1. ;rtn TIUFHA6, which writes it out when user TRIES entry.
  1. ;
  1. N NODE0,WHYNOT,TYPE,POSSTYPE,LP,LC,POSSSTAT,PARENT,MSG,NODE6,NODE61
  1. N ICUSTOM,TIUFI,MISSITEM,CHECK,SHARED,VALUE
  1. S CHECK("F")="Does not Exist in File"
  1. S CHECK("I")="Has Nonexistent Item; See IRM"
  1. S CHECK("T")="No Type/Wrong Type"
  1. S CHECK("C")="Shared; Not Component"
  1. S CHECK("B")="Personal AND Class Owners"
  1. S CHECK("O")="No Owner"
  1. S CHECK("S")="No Status/Wrong Status for Type" ;For nonshared entries
  1. S CHECK("J")="No Object Method"
  1. F LETTER="N","A","P" S CHECK("J"_LETTER)="Ambiguous. Object "_$S(LETTER="N":"Name",LETTER="A":"Abbreviation",1:"Print Name")_" could be any of several objects."
  1. S CHECK("P")="Orphan"
  1. S CHECK("M")="Multiple Parents" ;For nonshared entries
  1. S CHECK("U")="Unshared, with Shared Parent"
  1. ; For subscripts OBJ and OBJINACT see rtn TIUFLX.
  1. S CHECK("A")="Natl with NonNatl Ancestor" ;For nonshared entries
  1. S CHECK("E")="No Edit Template" ; Set only if entry is Title, is/will be in hierarchy, has no explicit value, has/will have no inherited value.
  1. S CHECK("R")="No Print Method" ; see E
  1. S CHECK("V")="No Visit Linkage Method" ; see E
  1. S CHECK("D")="No Validation Method" ; see E
  1. S CHECK("H")="No Print Form Header" ; Set only if entry is Title, is/will be in hierarchy, has no explicit value, has/will have no inherited value, and if entry's DC allows Custom Form Headers.
  1. S CHECK("N")="No Print Form Number" ; see H
  1. S CHECK("G")="No Print Group" ; see H
  1. ; For subscript DESC see DESCCK
  1. S NODE0=$G(^TIU(8925.1,+FILEDA,0)) I NODE0="" D SET("F") G CHECX
  1. S MISSITEM=$$MISSITEM^TIUFLF4(FILEDA)
  1. I MISSITEM D SET("I") Q:'DETAILS
  1. S PFILEDA=+$G(PFILEDA) S POSSTYPE=$$POSSTYPE^TIUFLF7(PFILEDA) G:$D(DTOUT) CHECX
  1. S TYPE=$P(NODE0,U,4) I TYPE=""!(POSSTYPE'[(U_TYPE_U)) D SET("T") Q:'DETAILS
  1. S SHARED=$P(NODE0,U,10) I SHARED,TYPE'="CO" D SET("C") Q:'DETAILS
  1. S LP=$L($P(NODE0,U,5)),LC=$L($P(NODE0,U,6))
  1. I LP&LC D SET("B") Q:'DETAILS
  1. I 'LP&'LC D SET("O") Q:'DETAILS
  1. I '$P(NODE0,U,7),'$P(NODE0,U,10) D SET("S") Q:'DETAILS
  1. I $P(NODE0,U,7),'$P(NODE0,U,10) S POSSSTAT=$$POSSSTAT^TIUFLF5(TYPE) I POSSSTAT'[$E($$STATWORD^TIUFLF5($P(NODE0,U,7))) D SET("S") Q:'DETAILS
  1. I TYPE="O" D OBJECT G CHECX
  1. I 'PFILEDA!$P(NODE0,U,13) N ANCESTOR D ANCESTOR^TIUFLF4(FILEDA,NODE0,.ANCESTOR)
  1. I 'PFILEDA,$$ORPHAN^TIUFLF4(FILEDA,NODE0)="YES" D SET("P") Q:'DETAILS
  1. S PARENT=+$O(^TIU(8925.1,"AD",FILEDA,0))
  1. I $O(^TIU(8925.1,"AD",FILEDA,PARENT)),'$P(NODE0,U,10) D SET("M") Q:'DETAILS
  1. I '$P(NODE0,U,10),$P($G(^TIU(8925.1,PARENT,0)),U,10) D SET("U") Q:'DETAILS
  1. ; Check Btext. If problem, set MSGARRAY("OBJ"). If FIRST problem, set
  1. ;MSGARRAY=0^Bad/Inactive Object in Boilerplate Text:
  1. I $$HASBOIL^TIUFLF(FILEDA,NODE0) D XCHECK^TIUFLX(FILEDA,1,DETAILS,.MSGARRAY),DCHECK^TIUFLX(FILEDA,1,DETAILS,.MSGARRAY) I 'DETAILS,$D(MSGARRAY) G CHECX
  1. I $P(NODE0,U,13),'$P(NODE0,U,10) D I 'DETAILS,$D(MSGARRAY) G CHECX
  1. . S TIUFI=0
  1. . F S TIUFI=$O(ANCESTOR(TIUFI)) Q:'TIUFI I '$P(^TIU(8925.1,ANCESTOR(TIUFI),0),U,13) D SET("A") Q
  1. ; If Title, NOT an ADDENDUM, must have flds 5-8. Ignore for entries remaining orphans:
  1. I TYPE="DOC",FILEDA'=81,'$D(MSGARRAY("P")) D
  1. . I $G(^TIU(8925.1,FILEDA,5))="" D INHERIT^TIUFLD(FILEDA,PFILEDA,5,"","","",.VALUE) I VALUE="" D SET("E") Q:'DETAILS
  1. . I $G(^TIU(8925.1,FILEDA,6))="" D INHERIT^TIUFLD(FILEDA,PFILEDA,6,"","","",.VALUE) I VALUE="" D SET("R") Q:'DETAILS
  1. . I $G(^TIU(8925.1,FILEDA,7))="" D INHERIT^TIUFLD(FILEDA,PFILEDA,7,"","","",.VALUE) I VALUE="" D SET("V") Q:'DETAILS
  1. . I $G(^TIU(8925.1,FILEDA,8))="" D INHERIT^TIUFLD(FILEDA,PFILEDA,8,"","","",.VALUE) I VALUE="" D SET("D") Q:'DETAILS
  1. . ; If TL, NOT Addendum, check for flds 6.1, 6.12, 6.13;
  1. . ;6.14 will be there, it's set to 1 for Clinical Documents.
  1. . S NODE61=$G(^TIU(8925.1,FILEDA,6.1))
  1. . D INHERIT^TIUFLD(FILEDA,PFILEDA,6.14,"","","",.ICUSTOM)
  1. . ; If parent Allows Custom Hdrs, then Require 6.1/6.12/6.13 (can be inherited):
  1. . Q:'ICUSTOM
  1. . I $P(NODE61,U)="" D INHERIT^TIUFLD(FILEDA,PFILEDA,6.1,"","","",.VALUE) I VALUE="" D SET("H") Q:'DETAILS
  1. . I $P(NODE61,U,2)="" D INHERIT^TIUFLD(FILEDA,PFILEDA,6.12,"","","",.VALUE) I VALUE="" D SET("N") Q:'DETAILS
  1. . I $P(NODE61,U,3)="" D INHERIT^TIUFLD(FILEDA,PFILEDA,6.13,"","","",.VALUE) I VALUE="" D SET("G") Q:'DETAILS
  1. CHECX Q:$D(DTOUT)
  1. I $D(MSGARRAY) Q ;bad entry or bad descendant or bad btext
  1. I TYPE="DOC"!(TYPE="CO") D DESCCK(FILEDA,.MSGARRAY) I $D(MSGARRAY) Q
  1. S MSGARRAY=1
  1. Q
  1. ;
  1. DESCCK(FILEDA,MSGARRAY) ; Module Checks FILEDA Components for correctness/completeness.
  1. ; Requires FILEDA, MSGARRAY from CHECK.
  1. ; If some descendant has problem, sets MSGARRAY("DESC"), and MSGARRAY=
  1. ;0^Entry has Faulty Descendant.
  1. ; Ignores descendant boilerplate text problems since they are already
  1. ;caught for original entry.
  1. N TIUI,IFILEDA,DESCCK
  1. S TIUI=0
  1. F S TIUI=$O(^TIU(8925.1,FILEDA,10,TIUI)) Q:'TIUI D Q:'DESCCK
  1. . S IFILEDA=+^TIU(8925.1,FILEDA,10,TIUI,0)
  1. . D CHECK(IFILEDA,FILEDA,0,.DESCCK)
  1. . I 'DESCCK S MSGARRAY("DESC")="Entry has Faulty Descendant",MSGARRAY="0^"_MSGARRAY("DESC") I "MN"[TIUFWHO S MSGARRAY("DESC")=MSGARRAY("DESC")_" IFN "_IFILEDA
  1. Q
  1. ;
  1. OBJECT ; Set MSGARRAY for objects (subscripts J; JN,JA,JP if DETAILS)
  1. ; Needs variables from CHECK
  1. N TIUFI,NAP,LETTER,XREF,OFILEDA ; NAP is for NAME/ABBREV/PRINTNAME
  1. I $G(^TIU(8925.1,FILEDA,9))="" D SET("J")
  1. I 'DETAILS Q ;Ignore ambiguity here, ambiguity done in TIUFLX
  1. F TIUFI=1:1:3 S NAP=$P(NODE0,U,TIUFI) Q:NAP="" D
  1. . S LETTER=$S(TIUFI=1:"N",TIUFI=2:"A",1:"P")
  1. . F XREF="B","C","D" D
  1. . . S OFILEDA=0 F S OFILEDA=$O(^TIU(8925.1,XREF,NAP,OFILEDA)) Q:'OFILEDA D Q:$D(MSGARRAY("J"_LETTER))
  1. . . . Q:'$D(^TIU(8925.1,"AT","O",OFILEDA))
  1. . . . I OFILEDA'=FILEDA D SET("J"_LETTER)
  1. Q
  1. ;
  1. SET(SUBS) ; Sets MSGARRAY
  1. ; Requires vars from CHECK
  1. S MSGARRAY(SUBS)=CHECK(SUBS) I $G(MSGARRAY)="" S MSGARRAY=0_U_MSGARRAY(SUBS)
  1. Q