TIUSRVLP ;BAY PINES/ELR - Server fns - Cont of TIUSRVLO ;20-NOV-2001 08:51:07
;;1.0;TEXT INTEGRATION UTILITIES;**194,268**;Jun 20, 1997;Build 60
;
;
;
;VMP OIFO BAY PINES;ELR;TIU*1.0*194 FORCED TO BREAK UP TIUSRVLO DUE TO SIZE
APTCL(TIUY,CLASS,TIUAUTH,DFN,TIME1,TIME2,SEQUENCE) ; Signed, by author
N DATTIM,DA,ROOT,TIUI,TIUS12,TIUS15
S ROOT=$NA(^TIU(8925,"APTCL",DFN,CLASS))
S DATTIM=TIME1-.0000001
F S DATTIM=$O(@ROOT@(DATTIM)) Q:DATTIM'>0!(DATTIM>TIME2) D
. S DA=0 F S DA=$O(@ROOT@(DATTIM,DA)) Q:DA'>0 D
. . I +$G(^TIU(8925,+DA,0))'>0 K @ROOT@(DA) Q
. . S TIUI=$S(SEQUENCE="D":+$G(TIUI)+1,1:+$G(TIUI)-1)
. . Q:+$D(@TIUY@("INDX",DA))
. . ; Selectively filter DELETED or RETRACTED records
. . I +$P($G(^TIU(8925,DA,0)),U,5)>13,'+$$CANDO^TIULP(DA,"VIEW",DUZ) Q
. . S TIUS12=$G(^TIU(8925,DA,12))
. . Q:+$P(TIUS12,U,2)'=TIUAUTH ;See if this is the authors note
. . S TIUS15=$G(^TIU(8925,DA,15))
. . Q:+$P(TIUS15,U,2)'>0 ;See if signed
. . S @TIUY@(TIUI)=DA_U_$$RESOLVE^TIUSRVLO(DA)
. . S @TIUY@("INDX",DA,TIUI)=""
. . Q:+$G(SHOWADD)=0
. . S TIUP=+$$HASDAD^TIUSRVLI(DA) I TIUP D D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
. . . N TIUPT
. . . S TIUPT=$P($G(^TIU(8925,+DA,0)),"^",6)
. . . I TIUPT]"",'$D(^TIU(8925,"DAD",TIUPT,DA)) S ^TIU(8925,"DAD",TIUPT,DA)=""
. . . I TIUPT="" S TIUPT=$G(^TIU(8925,+DA,21))
. . . I '$D(^TIU(8925,TIUPT,0)) S $P(@TIUY@(TIUI),"^",16)=1,$P(@TIUY@(TIUI),"^",14)=4 Q
. . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUSRVLP 1541 printed Dec 13, 2024@02:45:54 Page 2
TIUSRVLP ;BAY PINES/ELR - Server fns - Cont of TIUSRVLO ;20-NOV-2001 08:51:07
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**194,268**;Jun 20, 1997;Build 60
+2 ;
+3 ;
+4 ;
+5 ;VMP OIFO BAY PINES;ELR;TIU*1.0*194 FORCED TO BREAK UP TIUSRVLO DUE TO SIZE
APTCL(TIUY,CLASS,TIUAUTH,DFN,TIME1,TIME2,SEQUENCE) ; Signed, by author
+1 NEW DATTIM,DA,ROOT,TIUI,TIUS12,TIUS15
+2 SET ROOT=$NAME(^TIU(8925,"APTCL",DFN,CLASS))
+3 SET DATTIM=TIME1-.0000001
+4 FOR
SET DATTIM=$ORDER(@ROOT@(DATTIM))
if DATTIM'>0!(DATTIM>TIME2)
QUIT
Begin DoDot:1
+5 SET DA=0
FOR
SET DA=$ORDER(@ROOT@(DATTIM,DA))
if DA'>0
QUIT
Begin DoDot:2
+6 IF +$GET(^TIU(8925,+DA,0))'>0
KILL @ROOT@(DA)
QUIT
+7 SET TIUI=$SELECT(SEQUENCE="D":+$GET(TIUI)+1,1:+$GET(TIUI)-1)
+8 if +$DATA(@TIUY@("INDX",DA))
QUIT
+9 ; Selectively filter DELETED or RETRACTED records
+10 IF +$PIECE($GET(^TIU(8925,DA,0)),U,5)>13
IF '+$$CANDO^TIULP(DA,"VIEW",DUZ)
QUIT
+11 SET TIUS12=$GET(^TIU(8925,DA,12))
+12 ;See if this is the authors note
if +$PIECE(TIUS12,U,2)'=TIUAUTH
QUIT
+13 SET TIUS15=$GET(^TIU(8925,DA,15))
+14 ;See if signed
if +$PIECE(TIUS15,U,2)'>0
QUIT
+15 SET @TIUY@(TIUI)=DA_U_$$RESOLVE^TIUSRVLO(DA)
+16 SET @TIUY@("INDX",DA,TIUI)=""
+17 if +$GET(SHOWADD)=0
QUIT
+18 SET TIUP=+$$HASDAD^TIUSRVLI(DA)
IF TIUP
Begin DoDot:3
+19 NEW TIUPT
+20 SET TIUPT=$PIECE($GET(^TIU(8925,+DA,0)),"^",6)
+21 IF TIUPT]""
IF '$DATA(^TIU(8925,"DAD",TIUPT,DA))
SET ^TIU(8925,"DAD",TIUPT,DA)=""
+22 IF TIUPT=""
SET TIUPT=$GET(^TIU(8925,+DA,21))
+23 IF '$DATA(^TIU(8925,TIUPT,0))
SET $PIECE(@TIUY@(TIUI),"^",16)=1
SET $PIECE(@TIUY@(TIUI),"^",14)=4
QUIT
End DoDot:3
DO SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
+24 IF +$$HASKIDS^TIUSRVLI(DA)
DO SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
End DoDot:2
End DoDot:1
+25 QUIT
