TIUFLF6 ; SLC/MAM - Library; File 8925.1 Related: ASKSTAT(FILEDA,NODE0,PFILEDA,NEWFLAG,XFLG), AUTOSTAT(FILEDA,NODE0,STAT),DESCSTAT(FILEDA,NEWSTAT) ; 03/16/2007
;;1.0;TEXT INTEGRATION UTILITIES;**13,211,225**;Jun 20, 1997;Build 13
;
ASKSTAT(FILEDA,NODE0,PFILEDA,NEWFLAG,XFLG) ; User edit FILEDA Status. Does AUTOSTAT.
; Requires FILEDA,NODE0
; Requires PFILEDA if FILEDA has an actual/prospective parent.
; Returns NEWFLAG=0 if Status unchanged, = 1^ExternalNewStatus if changed, e.g. 1^ACTIVE
; Returns XFLG=1 if user ^exited or timed out, else as received.
N XQORM,TIUJ,NEWSTAT,DIR,X,Y,TIUFSTAT,TIUFPFDA,CONTINUE
N STATUS,DEFLT
S NEWFLAG=0
S DEFLT=$$STATWORD^TIUFLF5($P(NODE0,U,7))
READST K DUOUT S:(DEFLT'="NO/BAD") STATUS=$$SELSTAT^TIUFLF5(FILEDA,PFILEDA,DEFLT) S:(DEFLT="NO/BAD") STATUS=$$SELSTAT^TIUFLF5(FILEDA,PFILEDA)
I $D(DUOUT)!$D(DTOUT) G ASKSX
I STATUS="" W " ?? Enter appropriate Status or '^' to exit",! H 2 G READST
S NEWSTAT=STATUS I +NEWSTAT'=$P(NODE0,U,7) S NEWFLAG="1^"_$P(NEWSTAT,U,2)
S NEWSTAT=$P(NEWSTAT,U,2) ;e.g. ACTIVE
I NEWFLAG,NEWSTAT="INACTIVE" D INACTIVE^TIUFHA3($P(NODE0,U,4),FILEDA,NODE0)
I 'NEWFLAG!(NEWSTAT'="INACTIVE") D AUTOSTAT(FILEDA,NODE0,NEWSTAT)
ASKSX S:$D(DUOUT)!$D(DTOUT) XFLG=1
Q
;
AUTOSTAT(FILEDA,NODE0,STAT) ; Auto edit FILEDA to Status STAT; Auto edit FILEDA descendants
N DIE,DR,X,Y,DA
S DA=FILEDA
I STAT="INACTIVE" D
. S DIE=8925.1,DR=".07///^S X=STAT" D ^DIE
. Q:$P(NODE0,U,4)="O"
. ;Inactivate descendants, all the way down
. D DESCSTAT(FILEDA,"INACTIVE")
I STAT="TEST" D
. S DIE=8925.1,DR=".07///^S X=STAT" D ^DIE
. D DESCSTAT(FILEDA,"TEST")
I STAT="ACTIVE" D
. N TIUOUT
. I ($P(NODE0,U,4)="DOC"),(+$G(^TIU(8925.1,DA,15))'>0) D Q:+$G(TIUOUT)
. . W !!,$C(7),"You MUST first map ",$P(NODE0,U),!
. . D DIRECT^TIUMAP2(DA)
. . I +$G(^TIU(8925.1,DA,15))'>0 W $C(7)," Status Unchanged...",! H 2
. . I S TIUOUT=1,VALMBCK="R"
. W " Entry Activated.",! H 1
. S DIE=8925.1,DR=".07///^S X=STAT" D ^DIE
. ; I DOC, activate all descendants.
. I $P(NODE0,U,4)="DOC" D DESCSTAT(FILEDA,STAT)
. ; I CL or DC, let user activate desc by using separate option
. ; I O, done.
Q
;
DESCSTAT(FILEDA,NEWSTAT) ; Edits Status of all descendants of FILEDA
;except Shared Components.
; Gives them Status NEWSTAT
; Requires FILEDA. Requires NEWSTAT = ACTIVE, TEST, or INACTIVE
; Called with NEWSTAT="ACTIVE" for Components ONLY.
N TIUI,IFILEDA,INODE0,DIE,X,Y,STATUS,DA
S TIUI=0,DIE=8925.1
F S TIUI=$O(^TIU(8925.1,FILEDA,10,TIUI)) Q:'TIUI D
. S IFILEDA=+^TIU(8925.1,FILEDA,10,TIUI,0)
. S INODE0=$G(^TIU(8925.1,IFILEDA,0))
. I INODE0="" W !!," File Entry "_FILEDA_" has Nonexistent item "_IFILEDA_"; See IRM",! H 5 Q
. I $P(INODE0,U,10) Q
. S DA=IFILEDA,DR=".07///^S X=NEWSTAT" D ^DIE
. D DESCSTAT(IFILEDA,NEWSTAT)
DESCX Q
;
CANEDIT(FILEDA) ; Function returns 1 if Shared Component can be edited, else 0
; Can be edited if all parent Titles are Inactive. Ignores parents which don't exist or have no Status.
N PFILEDA,PSTATUS,EDITANS,PNODE0,PTYPE
S EDITANS=1,PFILEDA=0
F S PFILEDA=$O(^TIU(8925.1,"AD",FILEDA,PFILEDA)) G:'PFILEDA CANEX D G:'EDITANS!$D(DTOUT) CANEX
. I '$D(^TIU(8925.1,PFILEDA,0)) W " File Entry "_PFILEDA_" from AD XREF is missing from the file: See IRM" D PAUSE^TIUFXHLX Q
. S PNODE0=^TIU(8925.1,PFILEDA,0),PTYPE=$P(PNODE0,U,4)
. I PTYPE="DOC" S PSTATUS=$P(PNODE0,U,7),PSTATUS=$$STATWORD^TIUFLF5(PSTATUS) I PSTATUS="NO/BAD" W " File Entry "_PFILEDA_" has No Status/Bad Status" D PAUSE^TIUFXHLX Q
. I PTYPE="DOC" S:(PSTATUS="ACTIVE"!(PSTATUS="TEST")) EDITANS=0 Q
. I PTYPE="CO" S EDITANS=$$CANEDIT(PFILEDA)
CANEX S:$D(DTOUT) EDITANS=0
Q EDITANS
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFLF6 3736 printed Apr 09, 2024@21:47:15 Page 2
TIUFLF6 ; SLC/MAM - Library; File 8925.1 Related: ASKSTAT(FILEDA,NODE0,PFILEDA,NEWFLAG,XFLG), AUTOSTAT(FILEDA,NODE0,STAT),DESCSTAT(FILEDA,NEWSTAT) ; 03/16/2007
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**13,211,225**;Jun 20, 1997;Build 13
+2 ;
ASKSTAT(FILEDA,NODE0,PFILEDA,NEWFLAG,XFLG) ; User edit FILEDA Status. Does AUTOSTAT.
+1 ; Requires FILEDA,NODE0
+2 ; Requires PFILEDA if FILEDA has an actual/prospective parent.
+3 ; Returns NEWFLAG=0 if Status unchanged, = 1^ExternalNewStatus if changed, e.g. 1^ACTIVE
+4 ; Returns XFLG=1 if user ^exited or timed out, else as received.
+5 NEW XQORM,TIUJ,NEWSTAT,DIR,X,Y,TIUFSTAT,TIUFPFDA,CONTINUE
+6 NEW STATUS,DEFLT
+7 SET NEWFLAG=0
+8 SET DEFLT=$$STATWORD^TIUFLF5($PIECE(NODE0,U,7))
READST KILL DUOUT
if (DEFLT'="NO/BAD")
SET STATUS=$$SELSTAT^TIUFLF5(FILEDA,PFILEDA,DEFLT)
if (DEFLT="NO/BAD")
SET STATUS=$$SELSTAT^TIUFLF5(FILEDA,PFILEDA)
+1 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO ASKSX
+2 IF STATUS=""
WRITE " ?? Enter appropriate Status or '^' to exit",!
HANG 2
GOTO READST
+3 SET NEWSTAT=STATUS
IF +NEWSTAT'=$PIECE(NODE0,U,7)
SET NEWFLAG="1^"_$PIECE(NEWSTAT,U,2)
+4 ;e.g. ACTIVE
SET NEWSTAT=$PIECE(NEWSTAT,U,2)
+5 IF NEWFLAG
IF NEWSTAT="INACTIVE"
DO INACTIVE^TIUFHA3($PIECE(NODE0,U,4),FILEDA,NODE0)
+6 IF 'NEWFLAG!(NEWSTAT'="INACTIVE")
DO AUTOSTAT(FILEDA,NODE0,NEWSTAT)
ASKSX if $DATA(DUOUT)!$DATA(DTOUT)
SET XFLG=1
+1 QUIT
+2 ;
AUTOSTAT(FILEDA,NODE0,STAT) ; Auto edit FILEDA to Status STAT; Auto edit FILEDA descendants
+1 NEW DIE,DR,X,Y,DA
+2 SET DA=FILEDA
+3 IF STAT="INACTIVE"
Begin DoDot:1
+4 SET DIE=8925.1
SET DR=".07///^S X=STAT"
DO ^DIE
+5 if $PIECE(NODE0,U,4)="O"
QUIT
+6 ;Inactivate descendants, all the way down
+7 DO DESCSTAT(FILEDA,"INACTIVE")
End DoDot:1
+8 IF STAT="TEST"
Begin DoDot:1
+9 SET DIE=8925.1
SET DR=".07///^S X=STAT"
DO ^DIE
+10 DO DESCSTAT(FILEDA,"TEST")
End DoDot:1
+11 IF STAT="ACTIVE"
Begin DoDot:1
+12 NEW TIUOUT
+13 IF ($PIECE(NODE0,U,4)="DOC")
IF (+$GET(^TIU(8925.1,DA,15))'>0)
Begin DoDot:2
+14 WRITE !!,$CHAR(7),"You MUST first map ",$PIECE(NODE0,U),!
+15 DO DIRECT^TIUMAP2(DA)
+16 IF +$GET(^TIU(8925.1,DA,15))'>0
WRITE $CHAR(7)," Status Unchanged...",!
HANG 2
+17 IF $TEST
SET TIUOUT=1
SET VALMBCK="R"
End DoDot:2
if +$GET(TIUOUT)
QUIT
+18 WRITE " Entry Activated.",!
HANG 1
+19 SET DIE=8925.1
SET DR=".07///^S X=STAT"
DO ^DIE
+20 ; I DOC, activate all descendants.
+21 IF $PIECE(NODE0,U,4)="DOC"
DO DESCSTAT(FILEDA,STAT)
+22 ; I CL or DC, let user activate desc by using separate option
+23 ; I O, done.
End DoDot:1
+24 QUIT
+25 ;
DESCSTAT(FILEDA,NEWSTAT) ; Edits Status of all descendants of FILEDA
+1 ;except Shared Components.
+2 ; Gives them Status NEWSTAT
+3 ; Requires FILEDA. Requires NEWSTAT = ACTIVE, TEST, or INACTIVE
+4 ; Called with NEWSTAT="ACTIVE" for Components ONLY.
+5 NEW TIUI,IFILEDA,INODE0,DIE,X,Y,STATUS,DA
+6 SET TIUI=0
SET DIE=8925.1
+7 FOR
SET TIUI=$ORDER(^TIU(8925.1,FILEDA,10,TIUI))
if 'TIUI
QUIT
Begin DoDot:1
+8 SET IFILEDA=+^TIU(8925.1,FILEDA,10,TIUI,0)
+9 SET INODE0=$GET(^TIU(8925.1,IFILEDA,0))
+10 IF INODE0=""
WRITE !!," File Entry "_FILEDA_" has Nonexistent item "_IFILEDA_"; See IRM",!
HANG 5
QUIT
+11 IF $PIECE(INODE0,U,10)
QUIT
+12 SET DA=IFILEDA
SET DR=".07///^S X=NEWSTAT"
DO ^DIE
+13 DO DESCSTAT(IFILEDA,NEWSTAT)
End DoDot:1
DESCX QUIT
+1 ;
CANEDIT(FILEDA) ; Function returns 1 if Shared Component can be edited, else 0
+1 ; Can be edited if all parent Titles are Inactive. Ignores parents which don't exist or have no Status.
+2 NEW PFILEDA,PSTATUS,EDITANS,PNODE0,PTYPE
+3 SET EDITANS=1
SET PFILEDA=0
+4 FOR
SET PFILEDA=$ORDER(^TIU(8925.1,"AD",FILEDA,PFILEDA))
if 'PFILEDA
GOTO CANEX
Begin DoDot:1
+5 IF '$DATA(^TIU(8925.1,PFILEDA,0))
WRITE " File Entry "_PFILEDA_" from AD XREF is missing from the file: See IRM"
DO PAUSE^TIUFXHLX
QUIT
+6 SET PNODE0=^TIU(8925.1,PFILEDA,0)
SET PTYPE=$PIECE(PNODE0,U,4)
+7 IF PTYPE="DOC"
SET PSTATUS=$PIECE(PNODE0,U,7)
SET PSTATUS=$$STATWORD^TIUFLF5(PSTATUS)
IF PSTATUS="NO/BAD"
WRITE " File Entry "_PFILEDA_" has No Status/Bad Status"
DO PAUSE^TIUFXHLX
QUIT
+8 IF PTYPE="DOC"
if (PSTATUS="ACTIVE"!(PSTATUS="TEST"))
SET EDITANS=0
QUIT
+9 IF PTYPE="CO"
SET EDITANS=$$CANEDIT(PFILEDA)
End DoDot:1
if 'EDITANS!$DATA(DTOUT)
GOTO CANEX
CANEX if $DATA(DTOUT)
SET EDITANS=0
+1 QUIT EDITANS
+2 ;
