TIUFX ; SLC/MAM - LM Screen X (Boilerplate Text) INIT, DS/BOILTX ;10/26/95 15:35
;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
;
HDR ; -- header code
S VALMHDR(1)=$$FHDR
HDRX ;
Q
;
FHDR() ; Function returns Type_Name for headers; Requires Array TIUFNOD0.
N NAME,TYPE
S NAME=$P(TIUFNOD0,U)
S TYPE=$$MIXED^TIULS(TIUFNOD0("TYPE"))
I TYPE'="" S TYPE=TYPE_" "
Q $$CENTER^TIUFL(TYPE_NAME,79)
;
INIT ; -- init variables and list array
N TEMPLATE
K ^TMP("TIUF3",$J),^TMP("TIUF3IDX",$J)
D CLEAN^VALM10
S VALMCNT=0 D DSBOILTX^TIUFD(.VALMCNT)
INITX I $D(DTOUT) S VALMQUIT=1
Q
;
STATUS ; Action Status for Subtemplate X Boilerplate Text
N FILEDA,PFILEDA,FIELDS,DTOUT,DIRUT,DIROUT
S VALMBCK=""
S FILEDA=$P(TIUFINFO,U,2),PFILEDA=+$O(^TIU(8925.1,"AD",FILEDA,0)),FIELDS=";.07;"
L +^TIU(8925.1,FILEDA):1 I '$T W !!," Another user is editing this entry.",! H 2 G STATX
D ASKFLDS^TIUFLF1(FILEDA,FIELDS,PFILEDA)
D NODE0ARR^TIUFLF(FILEDA,.TIUFNOD0) G:$D(DTOUT) STATX
STATX ;
L -^TIU(8925.1,+$G(FILEDA))
I $D(DTOUT) S VALMBCK="Q"
I $G(TIUFFULL) S VALMBCK="R" D RESET^TIUFXHLX
Q
;
EXIT ; -- Exit Code for LM Template X
N NEWSTAT,NEWHASBT,CNTCHNG,LINENO
I TIUFTMPL="A" D ; Update line if no new status and yes new boil and Type is Title
. S NEWSTAT=$S(TIUFNOD0("STATUS")'=TIUFXSTA:1,1:0)
. S NEWHASBT=$S(TIUFNOD0("BOILPT")'=TIUFXBT:1,1:0)
. I 'NEWSTAT,NEWHASBT,(TIUFNOD0("TYPE")="TITLE") D AUPDATE^TIUFLA1(TIUFNOD0,FILEDA,.CNTCHNG) S:CNTCHNG TIUFVCN1=TIUFVCN1-1 ;doesn't match.
. I NEWSTAT!(NEWHASBT&(TIUFNOD0("TYPE")="COMPONENT")) S TIUFREDO=1 ; One new status affects status globally. One new CO Boilerplate Text affects Has Boil globally.
; Update entry itself in TIUFTMPL; entry will be reexpanded when leave EV:
I "HC"[TIUFTMPL D LINEUP^TIUFLLM1(.TIUFINFO,TIUFTMPL)
K ^TMP("TIUF3",$J),^TMP("TIUFB",$J),^TMP("TIUF3IDX",$J),^TMP("TIUFBIDX",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFX 1914 printed Dec 13, 2024@02:41:27 Page 2
TIUFX ; SLC/MAM - LM Screen X (Boilerplate Text) INIT, DS/BOILTX ;10/26/95 15:35
+1 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
+2 ;
HDR ; -- header code
+1 SET VALMHDR(1)=$$FHDR
HDRX ;
+1 QUIT
+2 ;
FHDR() ; Function returns Type_Name for headers; Requires Array TIUFNOD0.
+1 NEW NAME,TYPE
+2 SET NAME=$PIECE(TIUFNOD0,U)
+3 SET TYPE=$$MIXED^TIULS(TIUFNOD0("TYPE"))
+4 IF TYPE'=""
SET TYPE=TYPE_" "
+5 QUIT $$CENTER^TIUFL(TYPE_NAME,79)
+6 ;
INIT ; -- init variables and list array
+1 NEW TEMPLATE
+2 KILL ^TMP("TIUF3",$JOB),^TMP("TIUF3IDX",$JOB)
+3 DO CLEAN^VALM10
+4 SET VALMCNT=0
DO DSBOILTX^TIUFD(.VALMCNT)
INITX IF $DATA(DTOUT)
SET VALMQUIT=1
+1 QUIT
+2 ;
STATUS ; Action Status for Subtemplate X Boilerplate Text
+1 NEW FILEDA,PFILEDA,FIELDS,DTOUT,DIRUT,DIROUT
+2 SET VALMBCK=""
+3 SET FILEDA=$PIECE(TIUFINFO,U,2)
SET PFILEDA=+$ORDER(^TIU(8925.1,"AD",FILEDA,0))
SET FIELDS=";.07;"
+4 LOCK +^TIU(8925.1,FILEDA):1
IF '$TEST
WRITE !!," Another user is editing this entry.",!
HANG 2
GOTO STATX
+5 DO ASKFLDS^TIUFLF1(FILEDA,FIELDS,PFILEDA)
+6 DO NODE0ARR^TIUFLF(FILEDA,.TIUFNOD0)
if $DATA(DTOUT)
GOTO STATX
STATX ;
+1 LOCK -^TIU(8925.1,+$GET(FILEDA))
+2 IF $DATA(DTOUT)
SET VALMBCK="Q"
+3 IF $GET(TIUFFULL)
SET VALMBCK="R"
DO RESET^TIUFXHLX
+4 QUIT
+5 ;
EXIT ; -- Exit Code for LM Template X
+1 NEW NEWSTAT,NEWHASBT,CNTCHNG,LINENO
+2 ; Update line if no new status and yes new boil and Type is Title
IF TIUFTMPL="A"
Begin DoDot:1
+3 SET NEWSTAT=$SELECT(TIUFNOD0("STATUS")'=TIUFXSTA:1,1:0)
+4 SET NEWHASBT=$SELECT(TIUFNOD0("BOILPT")'=TIUFXBT:1,1:0)
+5 ;doesn't match.
IF 'NEWSTAT
IF NEWHASBT
IF (TIUFNOD0("TYPE")="TITLE")
DO AUPDATE^TIUFLA1(TIUFNOD0,FILEDA,.CNTCHNG)
if CNTCHNG
SET TIUFVCN1=TIUFVCN1-1
+6 ; One new status affects status globally. One new CO Boilerplate Text affects Has Boil globally.
IF NEWSTAT!(NEWHASBT&(TIUFNOD0("TYPE")="COMPONENT"))
SET TIUFREDO=1
End DoDot:1
+7 ; Update entry itself in TIUFTMPL; entry will be reexpanded when leave EV:
+8 IF "HC"[TIUFTMPL
DO LINEUP^TIUFLLM1(.TIUFINFO,TIUFTMPL)
+9 KILL ^TMP("TIUF3",$JOB),^TMP("TIUFB",$JOB),^TMP("TIUF3IDX",$JOB),^TMP("TIUFBIDX",$JOB)
+10 QUIT
