- TIUFLA ; SLC/MAM - Library; Template A Related: SELSTART, MATCH(FILEDA), TYPMATCH(FILEDA,ATYPE), OWNMATCH(FILEDA,AOWN), STTMATCH(FILEDA,ASTAT), USEMATCH(FILEDA,AUSE), STRMATCH(FILEDA,NODE0), PARMATCH(FILEDA,APARE) ;4/23/97 11:02
- ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
- ;
- SELSTART ; Select Docmt Def to Start with and to Go To
- ; Sets TIUFSTRT = Start^Stop where Start and Stop are characters to
- ;start and stop display with.
- N DIR,X,Y,START,GOTO
- W !! S DIR(0)="FO^1:60^S:$L($T(^TIULS)) X=$$UPPER^TIULS(X) K:'(X'?1P.E) X",(DIR("?"),DIR("??"))="^D HELP^TIUFLA(""start"")"
- S DIR("A")="START WITH DOCUMENT DEFINITION",DIR("B")="FIRST"
- I TIUFTMPL="J" S DIR("A")="START DISPLAY WITH OBJECT"
- D ^DIR I $D(DIRUT),'$D(TIUFSTRT) G SELSX
- S START=Y,START=$$UPPER^TIULS(START)
- I START="FIRST" S TIUFSTRT=" ^ZZZZZZZZ" G SELSX
- S DIR("A")="GO TO DOCUMENT DEFINITION",DIR("B")="LAST"
- I TIUFTMPL="J" S DIR("A")="GO TO OBJECT"
- S (DIR("?"),DIR("??"))="^D HELP^TIUFLA(""end"")"
- D ^DIR I $D(DIRUT) G SELSX
- S GOTO=$S(Y="LAST":"ZZZZZZZZ",1:Y),GOTO=$$UPPER^TIULS(GOTO)
- S TIUFSTRT=START_U_GOTO
- SELSX Q
- ;
- HELP(STRTEND) ; Writes help for SELSTART
- N DDEFOBJ S DDEFOBJ=$S(TIUFTMPL'="J":"Document Definition",1:"Object")
- W !,"What ",DDEFOBJ," would you like to ",STRTEND," the display with? Enter a",!,"partial/whole ",DDEFOBJ," name, or just enter some letters."
- Q
- ;
- MATCH(FILEDA) ; Function returns 1 if FILEDA matches Template A Sort
- ;Attribute, and Sort Attribute Value.
- ;Else Returns e.g. 0^TYPE if Type is where match fails.
- ; Requires TIUFATTR, TIUFAVAL. See HDR^TIUFA
- N ANS,ATTR1 S ANS=0
- S ATTR1=$P(TIUFATTR,U)
- I ATTR1="T" S ANS=$S($$TYPMATCH(FILEDA,TIUFAVAL):1,1:"0^TYPE")
- I ATTR1="O" S ANS=$S($$OWNMATCH(FILEDA,TIUFAVAL):1,1:"0^OWNER")
- I ATTR1="S" S ANS=$S($$STTMATCH(FILEDA,TIUFAVAL):1,1:"0^STATUS")
- I ATTR1="U" S ANS=$S($$USEMATCH(FILEDA,TIUFAVAL):1,1:"0^WAY USED")
- I ATTR1="P" S ANS=$S($$PARMATCH(FILEDA,TIUFAVAL):1,1:"0^PARENTAGE")
- I ATTR1="A" S ANS=1
- Q ANS
- ;
- TYPMATCH(FILEDA,ATYPE) ; Function returns 1 if Type of FILEDA matches
- ;Template A Type Value, else 0.
- ; Requires FILEDA; Requires ATYPE=TIUFAVAL when TIUFATTR="T^TYPE".
- ;See HDR^TIUFA. Requires TIUFATTR.
- N MATCH
- I '$G(FILEDA)!'$D(ATYPE)!(TIUFATTR'="T^TYPE") S MATCH="ERR" G TYPMX
- S MATCH=0,ATYPE=$P(ATYPE,U) I ATYPE="TL" S ATYPE="DOC"
- I ATYPE="NONE" S:($P(^TIU(8925.1,FILEDA,0),U,4)="") MATCH=1 G TYPMX
- I '$D(^TIU(8925.1,"AT",ATYPE,FILEDA)) G TYPMX
- S MATCH=1
- TYPMX Q MATCH
- ;
- OWNMATCH(FILEDA,AOWN) ; Function returns 1 if FILEDA matches Template A Owner
- ;Value, Else 0.
- ; Requires FILEDA; Requires AOWN=TIUFAVAL when TIUFATTR="O^OWNER".
- ;See HDR^TIUFA. Requires TIUFATTR.
- N MATCH,PERSOWNS,NODE0
- S MATCH=0
- I '$G(FILEDA)!'$D(AOWN) G OWNMX
- I $P(AOWN,U,3)="P"!($P(AOWN,U,3)="I")!(TIUFATTR'="O^OWNER") D G OWNMX
- . S PERSOWNS=$$PERSOWNS^TIUFLF2(FILEDA,+AOWN)
- . I $P(AOWN,U,3)="P",$P(PERSOWNS,U,2)'="P" Q
- . I $P(AOWN,U,3)="I",'PERSOWNS Q
- . S MATCH=1
- . Q
- I $P(AOWN,U,3)="C",'$D(^TIU(8925.1,"AC",+AOWN,FILEDA)) G OWNMX
- I $P(AOWN,U,2)="NONE" S NODE0=^TIU(8925.1,FILEDA,0) I $L($P(NODE0,U,5))!$L($P(NODE0,U,6)) G OWNMX
- S MATCH=1
- OWNMX Q MATCH
- ;
- STTMATCH(FILEDA,ASTAT) ; Function returns 1 if Status of FILEDA matches
- ;Template A STatus Value ASTAT, else 0.
- ; Fudge: If ASTAT is A, I, or T, don't match a shared Component no matter what its .07 fld value is. However, if ASTAT=0 (NONE), match Shared Component no matter what its .07 fld value is.
- ; Requires FILEDA; Requires ASTAT=TIUFAVAL when TIUFATTR="S^STATUS".
- ;See HDR^TIUFA. Requires TIUFATTR.
- N MATCH,NODE0
- S MATCH=0,ASTAT=$P(ASTAT,U)
- I '$G(FILEDA)!'$D(ASTAT)!(TIUFATTR'="S^STATUS") S MATCH="ERR" G STTMX
- I $D(^TIU(8925.1,"AS",ASTAT,FILEDA)) S NODE0=^TIU(8925.1,FILEDA,0) I '$P(NODE0,U,10) S MATCH=1 G STTMX
- I (ASTAT=0),'$P(^TIU(8925.1,FILEDA,0),U,7) S MATCH=1 G STTMX
- I (ASTAT=0) S NODE0=^TIU(8925.1,FILEDA,0) I $P(NODE0,U,10) S MATCH=1
- STTMX Q MATCH
- ;
- USEMATCH(FILEDA,AUSE) ; Function returns 1 if Way Used By Docmts of
- ;FILEDA matches Template A Way Used Value, else 0.
- ; Requires FILEDA; Requires AUSE=TIUFAVAL when TIUFATTR="U^WAY USED",
- ;=YES,NO,NA or UNKNOWN.
- ;See HDR^TIUFA. Requires TIUFATTR.
- N MATCH,DDEFUSED
- I '$G(FILEDA)!'$D(AUSE)!(TIUFATTR'="U^WAY USED") S MATCH="ERR" G USEMX
- S MATCH=0,DDEFUSED=$$DDEFUSED^TIUFLF(FILEDA)
- I DDEFUSED["UNKNOWN",AUSE="UNKNOWN" S MATCH=1 G USEMX ; UNKNOWN[NO!!!
- I DDEFUSED=AUSE S MATCH=1 G USEMX
- USEMX Q MATCH
- ;
- PARMATCH(FILEDA,APARE) ; Function returns 1 if Parentage of FILEDA matches
- ;Template A Parentage Value, else 0.
- ; Requires FILEDA; Requires APARE=TIUFAVAL when TIUFATTR="P^PARENTAGE".
- ;See HDR^TIUFA. Requires TIUFATTR.
- N MATCH,ORPHAN,NODE0
- S MATCH=0,APARE=$P(APARE,U)
- I '$G(FILEDA)!'$D(APARE)!(TIUFATTR'="P^PARENTAGE") S MATCH="ERR" G PARMX
- S NODE0=^TIU(8925.1,FILEDA,0),ORPHAN=$$ORPHAN^TIUFLF4(FILEDA,NODE0)
- I ORPHAN="YES",$P(APARE,U)="O" S MATCH=1
- I ORPHAN="NO",$P(APARE,U)="N" S MATCH=1
- PARMX Q MATCH
- ;
- STRMATCH(FILEDA,NODE0) ; Function returns 1 if FILEDA Name matches Template A
- ;Start With/Go To Value, Else 0.
- ; Requires FILEDA, NODE0= ^TIU(8925.1,FILEDA,0).
- ; Requires TIUFSTRT as set in SELSTART^TIUFLA.
- N NAME,ANS
- S NAME=$P(NODE0,U)
- I $P(TIUFSTRT,U)']NAME,NAME']$P(TIUFSTRT,U,2) S ANS=1 G STRMX
- S ANS=0
- STRMX Q ANS
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFLA 5403 printed Jan 18, 2025@03:42:08 Page 2
- TIUFLA ; SLC/MAM - Library; Template A Related: SELSTART, MATCH(FILEDA), TYPMATCH(FILEDA,ATYPE), OWNMATCH(FILEDA,AOWN), STTMATCH(FILEDA,ASTAT), USEMATCH(FILEDA,AUSE), STRMATCH(FILEDA,NODE0), PARMATCH(FILEDA,APARE) ;4/23/97 11:02
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
- +2 ;
- SELSTART ; Select Docmt Def to Start with and to Go To
- +1 ; Sets TIUFSTRT = Start^Stop where Start and Stop are characters to
- +2 ;start and stop display with.
- +3 NEW DIR,X,Y,START,GOTO
- +4 WRITE !!
- SET DIR(0)="FO^1:60^S:$L($T(^TIULS)) X=$$UPPER^TIULS(X) K:'(X'?1P.E) X"
- SET (DIR("?"),DIR("??"))="^D HELP^TIUFLA(""start"")"
- +5 SET DIR("A")="START WITH DOCUMENT DEFINITION"
- SET DIR("B")="FIRST"
- +6 IF TIUFTMPL="J"
- SET DIR("A")="START DISPLAY WITH OBJECT"
- +7 DO ^DIR
- IF $DATA(DIRUT)
- IF '$DATA(TIUFSTRT)
- GOTO SELSX
- +8 SET START=Y
- SET START=$$UPPER^TIULS(START)
- +9 IF START="FIRST"
- SET TIUFSTRT=" ^ZZZZZZZZ"
- GOTO SELSX
- +10 SET DIR("A")="GO TO DOCUMENT DEFINITION"
- SET DIR("B")="LAST"
- +11 IF TIUFTMPL="J"
- SET DIR("A")="GO TO OBJECT"
- +12 SET (DIR("?"),DIR("??"))="^D HELP^TIUFLA(""end"")"
- +13 DO ^DIR
- IF $DATA(DIRUT)
- GOTO SELSX
- +14 SET GOTO=$SELECT(Y="LAST":"ZZZZZZZZ",1:Y)
- SET GOTO=$$UPPER^TIULS(GOTO)
- +15 SET TIUFSTRT=START_U_GOTO
- SELSX QUIT
- +1 ;
- HELP(STRTEND) ; Writes help for SELSTART
- +1 NEW DDEFOBJ
- SET DDEFOBJ=$SELECT(TIUFTMPL'="J":"Document Definition",1:"Object")
- +2 WRITE !,"What ",DDEFOBJ," would you like to ",STRTEND," the display with? Enter a",!,"partial/whole ",DDEFOBJ," name, or just enter some letters."
- +3 QUIT
- +4 ;
- MATCH(FILEDA) ; Function returns 1 if FILEDA matches Template A Sort
- +1 ;Attribute, and Sort Attribute Value.
- +2 ;Else Returns e.g. 0^TYPE if Type is where match fails.
- +3 ; Requires TIUFATTR, TIUFAVAL. See HDR^TIUFA
- +4 NEW ANS,ATTR1
- SET ANS=0
- +5 SET ATTR1=$PIECE(TIUFATTR,U)
- +6 IF ATTR1="T"
- SET ANS=$SELECT($$TYPMATCH(FILEDA,TIUFAVAL):1,1:"0^TYPE")
- +7 IF ATTR1="O"
- SET ANS=$SELECT($$OWNMATCH(FILEDA,TIUFAVAL):1,1:"0^OWNER")
- +8 IF ATTR1="S"
- SET ANS=$SELECT($$STTMATCH(FILEDA,TIUFAVAL):1,1:"0^STATUS")
- +9 IF ATTR1="U"
- SET ANS=$SELECT($$USEMATCH(FILEDA,TIUFAVAL):1,1:"0^WAY USED")
- +10 IF ATTR1="P"
- SET ANS=$SELECT($$PARMATCH(FILEDA,TIUFAVAL):1,1:"0^PARENTAGE")
- +11 IF ATTR1="A"
- SET ANS=1
- +12 QUIT ANS
- +13 ;
- TYPMATCH(FILEDA,ATYPE) ; Function returns 1 if Type of FILEDA matches
- +1 ;Template A Type Value, else 0.
- +2 ; Requires FILEDA; Requires ATYPE=TIUFAVAL when TIUFATTR="T^TYPE".
- +3 ;See HDR^TIUFA. Requires TIUFATTR.
- +4 NEW MATCH
- +5 IF '$GET(FILEDA)!'$DATA(ATYPE)!(TIUFATTR'="T^TYPE")
- SET MATCH="ERR"
- GOTO TYPMX
- +6 SET MATCH=0
- SET ATYPE=$PIECE(ATYPE,U)
- IF ATYPE="TL"
- SET ATYPE="DOC"
- +7 IF ATYPE="NONE"
- if ($PIECE(^TIU(8925.1,FILEDA,0),U,4)="")
- SET MATCH=1
- GOTO TYPMX
- +8 IF '$DATA(^TIU(8925.1,"AT",ATYPE,FILEDA))
- GOTO TYPMX
- +9 SET MATCH=1
- TYPMX QUIT MATCH
- +1 ;
- OWNMATCH(FILEDA,AOWN) ; Function returns 1 if FILEDA matches Template A Owner
- +1 ;Value, Else 0.
- +2 ; Requires FILEDA; Requires AOWN=TIUFAVAL when TIUFATTR="O^OWNER".
- +3 ;See HDR^TIUFA. Requires TIUFATTR.
- +4 NEW MATCH,PERSOWNS,NODE0
- +5 SET MATCH=0
- +6 IF '$GET(FILEDA)!'$DATA(AOWN)
- GOTO OWNMX
- +7 IF $PIECE(AOWN,U,3)="P"!($PIECE(AOWN,U,3)="I")!(TIUFATTR'="O^OWNER")
- Begin DoDot:1
- +8 SET PERSOWNS=$$PERSOWNS^TIUFLF2(FILEDA,+AOWN)
- +9 IF $PIECE(AOWN,U,3)="P"
- IF $PIECE(PERSOWNS,U,2)'="P"
- QUIT
- +10 IF $PIECE(AOWN,U,3)="I"
- IF 'PERSOWNS
- QUIT
- +11 SET MATCH=1
- +12 QUIT
- End DoDot:1
- GOTO OWNMX
- +13 IF $PIECE(AOWN,U,3)="C"
- IF '$DATA(^TIU(8925.1,"AC",+AOWN,FILEDA))
- GOTO OWNMX
- +14 IF $PIECE(AOWN,U,2)="NONE"
- SET NODE0=^TIU(8925.1,FILEDA,0)
- IF $LENGTH($PIECE(NODE0,U,5))!$LENGTH($PIECE(NODE0,U,6))
- GOTO OWNMX
- +15 SET MATCH=1
- OWNMX QUIT MATCH
- +1 ;
- STTMATCH(FILEDA,ASTAT) ; Function returns 1 if Status of FILEDA matches
- +1 ;Template A STatus Value ASTAT, else 0.
- +2 ; Fudge: If ASTAT is A, I, or T, don't match a shared Component no matter what its .07 fld value is. However, if ASTAT=0 (NONE), match Shared Component no matter what its .07 fld value is.
- +3 ; Requires FILEDA; Requires ASTAT=TIUFAVAL when TIUFATTR="S^STATUS".
- +4 ;See HDR^TIUFA. Requires TIUFATTR.
- +5 NEW MATCH,NODE0
- +6 SET MATCH=0
- SET ASTAT=$PIECE(ASTAT,U)
- +7 IF '$GET(FILEDA)!'$DATA(ASTAT)!(TIUFATTR'="S^STATUS")
- SET MATCH="ERR"
- GOTO STTMX
- +8 IF $DATA(^TIU(8925.1,"AS",ASTAT,FILEDA))
- SET NODE0=^TIU(8925.1,FILEDA,0)
- IF '$PIECE(NODE0,U,10)
- SET MATCH=1
- GOTO STTMX
- +9 IF (ASTAT=0)
- IF '$PIECE(^TIU(8925.1,FILEDA,0),U,7)
- SET MATCH=1
- GOTO STTMX
- +10 IF (ASTAT=0)
- SET NODE0=^TIU(8925.1,FILEDA,0)
- IF $PIECE(NODE0,U,10)
- SET MATCH=1
- STTMX QUIT MATCH
- +1 ;
- USEMATCH(FILEDA,AUSE) ; Function returns 1 if Way Used By Docmts of
- +1 ;FILEDA matches Template A Way Used Value, else 0.
- +2 ; Requires FILEDA; Requires AUSE=TIUFAVAL when TIUFATTR="U^WAY USED",
- +3 ;=YES,NO,NA or UNKNOWN.
- +4 ;See HDR^TIUFA. Requires TIUFATTR.
- +5 NEW MATCH,DDEFUSED
- +6 IF '$GET(FILEDA)!'$DATA(AUSE)!(TIUFATTR'="U^WAY USED")
- SET MATCH="ERR"
- GOTO USEMX
- +7 SET MATCH=0
- SET DDEFUSED=$$DDEFUSED^TIUFLF(FILEDA)
- +8 ; UNKNOWN[NO!!!
- IF DDEFUSED["UNKNOWN"
- IF AUSE="UNKNOWN"
- SET MATCH=1
- GOTO USEMX
- +9 IF DDEFUSED=AUSE
- SET MATCH=1
- GOTO USEMX
- USEMX QUIT MATCH
- +1 ;
- PARMATCH(FILEDA,APARE) ; Function returns 1 if Parentage of FILEDA matches
- +1 ;Template A Parentage Value, else 0.
- +2 ; Requires FILEDA; Requires APARE=TIUFAVAL when TIUFATTR="P^PARENTAGE".
- +3 ;See HDR^TIUFA. Requires TIUFATTR.
- +4 NEW MATCH,ORPHAN,NODE0
- +5 SET MATCH=0
- SET APARE=$PIECE(APARE,U)
- +6 IF '$GET(FILEDA)!'$DATA(APARE)!(TIUFATTR'="P^PARENTAGE")
- SET MATCH="ERR"
- GOTO PARMX
- +7 SET NODE0=^TIU(8925.1,FILEDA,0)
- SET ORPHAN=$$ORPHAN^TIUFLF4(FILEDA,NODE0)
- +8 IF ORPHAN="YES"
- IF $PIECE(APARE,U)="O"
- SET MATCH=1
- +9 IF ORPHAN="NO"
- IF $PIECE(APARE,U)="N"
- SET MATCH=1
- PARMX QUIT MATCH
- +1 ;
- STRMATCH(FILEDA,NODE0) ; Function returns 1 if FILEDA Name matches Template A
- +1 ;Start With/Go To Value, Else 0.
- +2 ; Requires FILEDA, NODE0= ^TIU(8925.1,FILEDA,0).
- +3 ; Requires TIUFSTRT as set in SELSTART^TIUFLA.
- +4 NEW NAME,ANS
- +5 SET NAME=$PIECE(NODE0,U)
- +6 IF $PIECE(TIUFSTRT,U)']NAME
- IF NAME']$PIECE(TIUFSTRT,U,2)
- SET ANS=1
- GOTO STRMX
- +7 SET ANS=0
- STRMX QUIT ANS
- +1 ;