TIUFA ; SLC/MAM - LM Template A (DDEFs By Attribute) INIT ;10/26/95 15:33
;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
;
EN ; -- main entry point for Options TIUFA SORT DDEFS CLIN/MGR/NATL
; Requires TIUFWHO, set in above options
N TIUF,TIUFTMPL,TIUFATTR,TIUFAVAL,TIUFSTRT,TIUFVCN1,TIUFXNOD
N TIUFREDO,X,XQORM,TIUFLFT
S TIUFTMPL="A",TIUFREDO=0
N TIUFPRIV D SETUP^TIUFL S:$D(DTOUT) VALMQUIT=1 G:$G(VALMQUIT) ENX
S TIUFXNOD="^^Sort^"
S X=^TMP("TIUF",$J,"SORT")_";ORD(101," D EN^XQOR
G:$D(DTOUT)!'$D(TIUFSTRT) ENX
I TIUFWHO="C" D EN^VALM("TIUFA SORT DDEFS CLIN")
I "MN"[TIUFWHO D EN^VALM("TIUFA SORT DDEFS MGR")
ENX Q
;
HDR ; -- header code
; Requires Attribute TIUFATTR as set in protocols TIUF SORT BY (ALL,
;TYPE, OWNER, STATUS, WAY USED, PARENTAGE):
; TIUFATTR = A^ALL, T^TYPE, O^OWNER, S^STATUS, U^WAY USED, P^PARENTAGE;
; Requires Attribute Value TIUFAVAL as set in TIUF SORT BY ALL;
;TIUF TYPE /CLASS,DOCUMENT CLASS,MULTIAUTHOR DC,DOCUMENT,COMPONENT,NONE;
;TIUF OWNER /CLASS,INDIVIDUAL,PERSONAL,NONE; TIUF STATUS /INACTIVE,
;TEST,ACTIVE,NONE; TIUF USED BY DOCMTS/YES,NO,NA,UNKNOWN; TIUF PARENTAGE/ORPHAN,NONORPHAN.
; e.g. TIUFAVAL =
; ALL^ALL if attribute is ALL;
; CL^CLASS if attribute is Type and Type is Class;
; NONE^NONE if attr is Type and attr value is NONE.
; 546^PROVIDER^C if attr is Owner, Kind of Owner is Class Owner,
; and Class Owner is Provider Class (IFN 546).
; 0^NONE if attr is Owner, attr value is NONE.
; 13^INACTIVE if attr is Status and Status is Inactive (IFN 13).
; 0^NONE if attr is Owner and Owner is NONE.
; YES if attr is Way Used and Way Used is YES:
; YES/NO/NA
; O^ORPHAN if attr is ORPHAN and attr value is Orphan.
; N^NONORPHAN if attr is ORPHAN and attr value is Nonorphan.
; Requires TIUFSTRT = e.g. " ^ZZZZZZZZ" as set in SELSTART^TIUFLA.
N ATTR1,HDR2,MODE,OWN,FROM,TO,HDR3,VHDR1,VHDR2
S ATTR1=$P(TIUFATTR,U)
I ATTR1="T" S HDR2=$S($P(TIUFAVAL,U)'="NONE":" of Type "_$P(TIUFAVAL,U,2),1:" with NO Type")
I ATTR1="O" S MODE=$P(TIUFAVAL,U,3),OWN=$P(TIUFAVAL,U,2) D
. S HDR2=$S(MODE="P":" Personally Owned by "_OWN,MODE="C":" Owned by Class "_OWN,MODE="I":" Owned by Individual "_OWN,1:" with No Owner")
I ATTR1="S" S HDR2=$S($P(TIUFAVAL,U)'="N":" of Status "_$P(TIUFAVAL,U,2),1:" with NO Status")
S FROM=$S($P(TIUFSTRT,U)=" ":"FIRST",1:$P(TIUFSTRT,U))
S TO=$S($P(TIUFSTRT,U)=" ":"LAST",$P(TIUFSTRT,U,2)="ZZZZZZZZ":"LAST",1:$P(TIUFSTRT,U,2))
S HDR3=$S(TIUFSTRT'=" ^ZZZZZZZZ":" from "_FROM_" to "_TO,1:"")
I ATTR1="U" S MODE=TIUFAVAL D
. S HDR2=$S(MODE="YES":" In Use",1:" NOT In Use")
. I HDR3'="" S HDR2=HDR2_","
I ATTR1="P" S HDR2=$S($P(TIUFAVAL,U)="O":" which are ORPHANS",1:" which are NOT ORPHANS")
I "TOSUP"[ATTR1 S VALMHDR(1)=$$CENTER^TIUFL("Entries"_HDR2_HDR3,79)
I ATTR1="A" S VALMHDR(1)=$$CENTER^TIUFL("ALL Entries"_$S(HDR3'="":", "_HDR3,1:""),79)
HDRX ;
Q
;
INIT ; -- init variables and list array. Called by Templates A and J AND by Subtemplates.
; Requires TIUFATTR, TIUFAVAL, TIUFSTRT. See HDR^TIUFA
K ^TMP("TIUF1",$J),^TMP("TIUF1IDX",$J),^TMP("TIUFB",$J),^TMP("TIUFBIDX",$J)
I '$D(TIUFSTMP) D CLEAN^VALM10 ; Clean IF called from active Template.
N LINENO,STRTNM,ENDNM,FILEDA,NAME,PASTEND
I '$D(TIUFSTMP) S VALM("TITLE")=$S(TIUFTMPL="J":"Objects",$P(TIUFATTR,U)'="A":"Sort by "_$S($P(TIUFATTR,U,2)="WAY USED":"IN USE Value",1:$P(TIUFATTR,U,2)),1:"ALL Document Definitions")
S (TIUFVCN1,LINENO)=0,STRTNM=$P(TIUFSTRT,U),ENDNM=$P(TIUFSTRT,U,2)
I $O(^TIU(8925.1,"B",STRTNM,"")) D
. S FILEDA=""
. F S FILEDA=$O(^TIU(8925.1,"B",STRTNM,FILEDA)) Q:'FILEDA D INIT1
G:$D(DTOUT) INITX
S NAME=STRTNM
F S NAME=$O(^TIU(8925.1,"B",NAME)) Q:NAME="" D Q:$G(PASTEND) G:$D(DTOUT) INITX
. I NAME]ENDNM S PASTEND=1 Q
. S FILEDA=""
. F S FILEDA=$O(^TIU(8925.1,"B",NAME,FILEDA)) Q:'FILEDA D INIT1
. Q
I LINENO D UPDATE^TIUFLLM1("A",LINENO,0) S TIUFVCN1=TIUFVCN1+LINENO
INITX ;
S:$D(DTOUT) VALMQUIT=1
S:'$D(TIUFSTMP) VALMCNT=TIUFVCN1
Q
;
INIT1 ; Puts FILEDA in Buffer array.
N NODE0,INFO
Q:'$D(^TIU(8925.1,FILEDA,0))
Q:'$$MATCH^TIUFLA(FILEDA)
S LINENO=LINENO+1 ; Needed for NINFO.
D NINFO^TIUFLLM(LINENO,FILEDA,.INFO),PARSE^TIUFLLM(.INFO),NODE0ARR^TIUFLF(FILEDA,.NODE0) Q:$D(DTOUT)
I NODE0="" W !!," Entry "_FILEDA_" in 'B' Cross Reference does not exist in the file; See IRM",! D PAUSE^TIUFXHLX S LINENO=LINENO-1 Q
D BUFENTRY^TIUFLLM2(.INFO,.NODE0,TIUFTMPL) W "."
Q
;
EXIT ; -- exit code
K ^TMP("TIUF1",$J),^TMP("TIUFB",$J),^TMP("TIUF1IDX",$J),^TMP("TIUFBIDX",$J),^TMP("TIUF",$J),IOELALL
D CLEAN^VALM10
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFA 4694 printed Jan 18, 2025@03:41:41 Page 2
TIUFA ; SLC/MAM - LM Template A (DDEFs By Attribute) INIT ;10/26/95 15:33
+1 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
+2 ;
EN ; -- main entry point for Options TIUFA SORT DDEFS CLIN/MGR/NATL
+1 ; Requires TIUFWHO, set in above options
+2 NEW TIUF,TIUFTMPL,TIUFATTR,TIUFAVAL,TIUFSTRT,TIUFVCN1,TIUFXNOD
+3 NEW TIUFREDO,X,XQORM,TIUFLFT
+4 SET TIUFTMPL="A"
SET TIUFREDO=0
+5 NEW TIUFPRIV
DO SETUP^TIUFL
if $DATA(DTOUT)
SET VALMQUIT=1
if $GET(VALMQUIT)
GOTO ENX
+6 SET TIUFXNOD="^^Sort^"
+7 SET X=^TMP("TIUF",$JOB,"SORT")_";ORD(101,"
DO EN^XQOR
+8 if $DATA(DTOUT)!'$DATA(TIUFSTRT)
GOTO ENX
+9 IF TIUFWHO="C"
DO EN^VALM("TIUFA SORT DDEFS CLIN")
+10 IF "MN"[TIUFWHO
DO EN^VALM("TIUFA SORT DDEFS MGR")
ENX QUIT
+1 ;
HDR ; -- header code
+1 ; Requires Attribute TIUFATTR as set in protocols TIUF SORT BY (ALL,
+2 ;TYPE, OWNER, STATUS, WAY USED, PARENTAGE):
+3 ; TIUFATTR = A^ALL, T^TYPE, O^OWNER, S^STATUS, U^WAY USED, P^PARENTAGE;
+4 ; Requires Attribute Value TIUFAVAL as set in TIUF SORT BY ALL;
+5 ;TIUF TYPE /CLASS,DOCUMENT CLASS,MULTIAUTHOR DC,DOCUMENT,COMPONENT,NONE;
+6 ;TIUF OWNER /CLASS,INDIVIDUAL,PERSONAL,NONE; TIUF STATUS /INACTIVE,
+7 ;TEST,ACTIVE,NONE; TIUF USED BY DOCMTS/YES,NO,NA,UNKNOWN; TIUF PARENTAGE/ORPHAN,NONORPHAN.
+8 ; e.g. TIUFAVAL =
+9 ; ALL^ALL if attribute is ALL;
+10 ; CL^CLASS if attribute is Type and Type is Class;
+11 ; NONE^NONE if attr is Type and attr value is NONE.
+12 ; 546^PROVIDER^C if attr is Owner, Kind of Owner is Class Owner,
+13 ; and Class Owner is Provider Class (IFN 546).
+14 ; 0^NONE if attr is Owner, attr value is NONE.
+15 ; 13^INACTIVE if attr is Status and Status is Inactive (IFN 13).
+16 ; 0^NONE if attr is Owner and Owner is NONE.
+17 ; YES if attr is Way Used and Way Used is YES:
+18 ; YES/NO/NA
+19 ; O^ORPHAN if attr is ORPHAN and attr value is Orphan.
+20 ; N^NONORPHAN if attr is ORPHAN and attr value is Nonorphan.
+21 ; Requires TIUFSTRT = e.g. " ^ZZZZZZZZ" as set in SELSTART^TIUFLA.
+22 NEW ATTR1,HDR2,MODE,OWN,FROM,TO,HDR3,VHDR1,VHDR2
+23 SET ATTR1=$PIECE(TIUFATTR,U)
+24 IF ATTR1="T"
SET HDR2=$SELECT($PIECE(TIUFAVAL,U)'="NONE":" of Type "_$PIECE(TIUFAVAL,U,2),1:" with NO Type")
+25 IF ATTR1="O"
SET MODE=$PIECE(TIUFAVAL,U,3)
SET OWN=$PIECE(TIUFAVAL,U,2)
Begin DoDot:1
+26 SET HDR2=$SELECT(MODE="P":" Personally Owned by "_OWN,MODE="C":" Owned by Class "_OWN,MODE="I":" Owned by Individual "_OWN,1:" with No Owner")
End DoDot:1
+27 IF ATTR1="S"
SET HDR2=$SELECT($PIECE(TIUFAVAL,U)'="N":" of Status "_$PIECE(TIUFAVAL,U,2),1:" with NO Status")
+28 SET FROM=$SELECT($PIECE(TIUFSTRT,U)=" ":"FIRST",1:$PIECE(TIUFSTRT,U))
+29 SET TO=$SELECT($PIECE(TIUFSTRT,U)=" ":"LAST",$PIECE(TIUFSTRT,U,2)="ZZZZZZZZ":"LAST",1:$PIECE(TIUFSTRT,U,2))
+30 SET HDR3=$SELECT(TIUFSTRT'=" ^ZZZZZZZZ":" from "_FROM_" to "_TO,1:"")
+31 IF ATTR1="U"
SET MODE=TIUFAVAL
Begin DoDot:1
+32 SET HDR2=$SELECT(MODE="YES":" In Use",1:" NOT In Use")
+33 IF HDR3'=""
SET HDR2=HDR2_","
End DoDot:1
+34 IF ATTR1="P"
SET HDR2=$SELECT($PIECE(TIUFAVAL,U)="O":" which are ORPHANS",1:" which are NOT ORPHANS")
+35 IF "TOSUP"[ATTR1
SET VALMHDR(1)=$$CENTER^TIUFL("Entries"_HDR2_HDR3,79)
+36 IF ATTR1="A"
SET VALMHDR(1)=$$CENTER^TIUFL("ALL Entries"_$SELECT(HDR3'="":", "_HDR3,1:""),79)
HDRX ;
+1 QUIT
+2 ;
INIT ; -- init variables and list array. Called by Templates A and J AND by Subtemplates.
+1 ; Requires TIUFATTR, TIUFAVAL, TIUFSTRT. See HDR^TIUFA
+2 KILL ^TMP("TIUF1",$JOB),^TMP("TIUF1IDX",$JOB),^TMP("TIUFB",$JOB),^TMP("TIUFBIDX",$JOB)
+3 ; Clean IF called from active Template.
IF '$DATA(TIUFSTMP)
DO CLEAN^VALM10
+4 NEW LINENO,STRTNM,ENDNM,FILEDA,NAME,PASTEND
+5 IF '$DATA(TIUFSTMP)
SET VALM("TITLE")=$SELECT(TIUFTMPL="J":"Objects",$PIECE(TIUFATTR,U)'="A":"Sort by "_$SELECT($PIECE(TIUFATTR,U,2)="WAY USED":"IN USE Value",1:$PIECE(TIUFATTR,U,2)),1:"ALL Document Definitions")
+6 SET (TIUFVCN1,LINENO)=0
SET STRTNM=$PIECE(TIUFSTRT,U)
SET ENDNM=$PIECE(TIUFSTRT,U,2)
+7 IF $ORDER(^TIU(8925.1,"B",STRTNM,""))
Begin DoDot:1
+8 SET FILEDA=""
+9 FOR
SET FILEDA=$ORDER(^TIU(8925.1,"B",STRTNM,FILEDA))
if 'FILEDA
QUIT
DO INIT1
End DoDot:1
+10 if $DATA(DTOUT)
GOTO INITX
+11 SET NAME=STRTNM
+12 FOR
SET NAME=$ORDER(^TIU(8925.1,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+13 IF NAME]ENDNM
SET PASTEND=1
QUIT
+14 SET FILEDA=""
+15 FOR
SET FILEDA=$ORDER(^TIU(8925.1,"B",NAME,FILEDA))
if 'FILEDA
QUIT
DO INIT1
+16 QUIT
End DoDot:1
if $GET(PASTEND)
QUIT
if $DATA(DTOUT)
GOTO INITX
+17 IF LINENO
DO UPDATE^TIUFLLM1("A",LINENO,0)
SET TIUFVCN1=TIUFVCN1+LINENO
INITX ;
+1 if $DATA(DTOUT)
SET VALMQUIT=1
+2 if '$DATA(TIUFSTMP)
SET VALMCNT=TIUFVCN1
+3 QUIT
+4 ;
INIT1 ; Puts FILEDA in Buffer array.
+1 NEW NODE0,INFO
+2 if '$DATA(^TIU(8925.1,FILEDA,0))
QUIT
+3 if '$$MATCH^TIUFLA(FILEDA)
QUIT
+4 ; Needed for NINFO.
SET LINENO=LINENO+1
+5 DO NINFO^TIUFLLM(LINENO,FILEDA,.INFO)
DO PARSE^TIUFLLM(.INFO)
DO NODE0ARR^TIUFLF(FILEDA,.NODE0)
if $DATA(DTOUT)
QUIT
+6 IF NODE0=""
WRITE !!," Entry "_FILEDA_" in 'B' Cross Reference does not exist in the file; See IRM",!
DO PAUSE^TIUFXHLX
SET LINENO=LINENO-1
QUIT
+7 DO BUFENTRY^TIUFLLM2(.INFO,.NODE0,TIUFTMPL)
WRITE "."
+8 QUIT
+9 ;
EXIT ; -- exit code
+1 KILL ^TMP("TIUF1",$JOB),^TMP("TIUFB",$JOB),^TMP("TIUF1IDX",$JOB),^TMP("TIUFBIDX",$JOB),^TMP("TIUF",$JOB),IOELALL
+2 DO CLEAN^VALM10
+3 QUIT
+4 ;
