- TIUSRVLI ;SLC/JER - Server fns - lists for CPRS;Apr 06, 2021@11:27:11
- ;;1.0;TEXT INTEGRATION UTILITIES;**108,122,339**;Jun 20, 1997;Build 39
- HASDAD(DA) ; Evaluate whether a document has a parent
- Q $S(+$P($G(^TIU(8925,+DA,0)),U,6):1,+$G(^TIU(8925,+DA,21)):1,1:0)
- ;
- SETDAD(TIUY,DA,TIUI,FLG) ; Set parent in return array
- N DADA,RMVFLG,TIUD0,TIUD21
- S FLG=+$G(FLG)
- ; Exclude components
- Q:'+$$ISDOC(DA)
- S TIUD0=$G(^TIU(8925,DA,0)),TIUD21=$G(^(21))
- S DADA=$S(+$P(TIUD0,U,6):+$P(TIUD0,U,6),+TIUD21:+TIUD21,1:0)
- Q:+DADA'>0
- Q:+$D(@TIUY@("INDX",DADA))
- Q:+$D(^TIU(8925,DADA,0))=0
- S RMVFLG=0
- I FLG S RMVFLG=$$DOREMOV(.TIUY,DADA)
- Q:RMVFLG=1
- S TIUI=$S(SEQUENCE="A":+$G(TIUI)-1,1:+$G(TIUI)+1)
- S @TIUY@(TIUI)=DADA_U_$$RESOLVE^TIUSRVLO(DADA)
- S @TIUY@("INDX",DADA,TIUI)=""
- I +$G(SHOWADD) D SETKIDS(.TIUY,DADA,.TIUI,FLG)
- I +$$HASDAD(DADA) D SETDAD(.TIUY,DADA,.TIUI,FLG)
- Q
- ;
- HASKIDS(DA) ; Evaluate whether a document has children
- N TIUY,KIDA S (KIDA,TIUY)=0
- ; Check for addenda
- F S KIDA=$O(^TIU(8925,"DAD",DA,KIDA)) Q:+TIUY!(+KIDA'>0) D
- . I '+$$ISCOMP^TIUSRVR1(KIDA) S TIUY=1
- I +TIUY G HASKIDX
- ; Next, look for ID Entries
- S TIUY=$S(+$O(^TIU(8925,"GDAD",DA,0)):1,1:0)
- HASKIDX Q TIUY
- ;
- SETKIDS(TIUY,DA,TIUI,FLG) ; Set children in return array
- N KIDA,RMVFLG
- S FLG=+$G(FLG)
- S RMVFLG=0
- S KIDA=0
- ; Begin with addenda
- F S KIDA=$O(^TIU(8925,"DAD",DA,KIDA)) Q:+KIDA'>0 D Q:RMVFLG=1
- . Q:'+$$ISDOC(KIDA)
- . Q:+$D(@TIUY@("INDX",KIDA))
- . I FLG S RMVFLG=$$DOREMOV(.TIUY,KIDA)
- . Q:RMVFLG=1
- . S TIUI=$S(SEQUENCE="A":+$G(TIUI)-1,1:+$G(TIUI)+1)
- . S @TIUY@(TIUI)=KIDA_U_$$RESOLVE^TIUSRVLO(KIDA)
- . S @TIUY@("INDX",KIDA,TIUI)=""
- ; Next do ID entries
- S KIDA=0
- F S KIDA=$O(^TIU(8925,"GDAD",DA,KIDA)) Q:+KIDA'>0 D Q:RMVFLG=1
- . Q:+$D(@TIUY@("INDX",KIDA))
- . I FLG S RMVFLG=$$DOREMOV(.TIUY,KIDA)
- . Q:RMVFLG=1
- . S TIUI=$S(SEQUENCE="A":+$G(TIUI)-1,1:+$G(TIUI)+1)
- . S @TIUY@(TIUI)=KIDA_U_$$RESOLVE^TIUSRVLO(KIDA)
- . S @TIUY@("INDX",KIDA,TIUI)=""
- . I +$$HASKIDS(KIDA) D SETKIDS(.TIUY,KIDA,.TIUI,FLG)
- Q
- ISDOC(DA) ; Evaluate whether a given record is a document
- N TIUY,TIUTYP
- S TIUTYP=+$G(^TIU(8925,DA,0))
- S TIUY=$S($P($G(^TIU(8925.1,+TIUTYP,0)),U,4)="DOC":1,1:0)
- Q TIUY
- GETUND(TIUY,CLASS,DFN,TIME1,TIME2,TIUJ,SEQUENCE) ; Get undictated docs
- N TIUTYP,TIUI,DATTIM
- D DOCTYPE^TIUSRVL(.TIUTYP,CLASS) Q:+$D(TIUTYP)'>9
- S TIUI=0
- F S TIUI=$O(TIUTYP(TIUI)) Q:+TIUI'>0 D
- . N STATUS
- . F STATUS=1:1:2 D
- . . S DATTIM=TIME1-.0000001
- . . F S DATTIM=$O(^TIU(8925,"APT",DFN,+TIUTYP(TIUI),STATUS,DATTIM)) Q:+DATTIM'>0 D
- . . . N TIUDA S TIUDA=0
- . . . F S TIUDA=$O(^TIU(8925,"APT",DFN,+TIUTYP(TIUI),STATUS,DATTIM,TIUDA)) Q:+TIUDA'>0 D
- . . . . Q:+$D(@TIUY@("INDX",TIUDA))
- . . . . S TIUJ=$S(SEQUENCE="A":+$G(TIUJ)-1,1:+$G(TIUJ)+1)
- . . . . S @TIUY@(TIUJ)=TIUDA_U_$$RESOLVE^TIUSRVLO(TIUDA)
- . . . . S @TIUY@("INDX",TIUDA,TIUJ)=""
- Q
- DOREMOV(TIUY,DA) ;Check for need to remove previously returned data
- ; and perform the remove
- N RMVFLG,TIUD0,TIUD1301
- S RMVFLG=0
- S TIUD0=$G(^TIU(8925,DA,0))
- S TIUD1301=$P($G(^TIU(8925,DA,13)),U,1)
- I +$G(PRVRTNDT)>0 D
- . I PRVRTNDT=TIUD1301,TIUIEN>DA Q
- . I PRVRTNDT>TIUD1301 Q
- . I (('+$P(TIUD0,U))!('+$G(TIUD1301))!('+$P(TIUD0,U,2))!(($P(TIUD0,U,5)<6))) Q
- . D RMV(.TIUY,DA)
- . S RMVFLG=1
- . Q
- Q RMVFLG
- RMV(TIUY,DA) ; Remove notes previously returned
- D RMVDAD(.TIUY,DA)
- D RMVKID(.TIUY,DA)
- I TIUJ>0 S TIUJ=TIUJ-1
- Q
- RMVDAD(TIUY,DA) ; Remove parent entries
- N CNT,DADA,TIUD0,TIUD21
- ; Exclude components
- Q:'+$$ISDOC(DA)
- S TIUD0=$G(^TIU(8925,DA,0)),TIUD21=$G(^(21))
- S DADA=$S(+$P(TIUD0,U,6):+$P(TIUD0,U,6),+TIUD21:+TIUD21,1:0)
- Q:+DADA'>0
- S @TIUY@("INDX",DADA)=""
- S CNT=+$O(@TIUY@("INDX",DADA,""))
- Q:CNT<1
- K @TIUY@(CNT)
- I +$G(SHOWADD) D RMVKID(.TIUY,DADA)
- I +$$HASDAD(DADA) D RMVDAD(.TIUY,DADA)
- Q
- RMVKID(TIUY,DA) ; Remove child notes
- N CNT,KIDA
- S KIDA=0
- ; Begin with addenda
- F S KIDA=$O(^TIU(8925,"DAD",DA,KIDA)) Q:+KIDA'>0 D
- . Q:'+$$ISDOC(KIDA)
- . S @TIUY@("INDX",KIDA)=""
- . S CNT=+$O(@TIUY@("INDX",KIDA,""))
- . Q:CNT<1
- . K @TIUY@(CNT)
- . Q
- ; Next do ID entries
- S KIDA=0
- F S KIDA=$O(^TIU(8925,"GDAD",DA,KIDA)) Q:+KIDA'>0 D
- . S @TIUY@("INDX",KIDA)=""
- . S CNT=+$O(@TIUY@("INDX",KIDA,""))
- . Q:CNT<1
- . K @TIUY@(CNT)
- . I +$$HASKIDS(KIDA) D RMVKID(.TIUY,KIDA)
- . Q
- Q
- RESEQ(TIUY,TIUI) ; Resequence @TIUY@(TIUI) after removal of entries and reset TIUI
- N ADD,ARRY,CNT,CNT1,DA,DATA
- S ADD=$S(SEQUENCE="D":1,1:-1)
- S ARRY=$NA(^TMP("TIURESEQ",$J))
- S (CNT,CNT1)=0
- F S CNT1=$O(@TIUY@(CNT1),ADD) Q:CNT1="" D
- . I +CNT1=0 Q
- . S CNT=CNT+ADD
- . S @ARRY@(CNT)=$G(@TIUY@(CNT1))
- . Q
- K @TIUY
- M @TIUY=@ARRY
- K @ARRY
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUSRVLI 4730 printed Feb 19, 2025@00:12:20 Page 2
- TIUSRVLI ;SLC/JER - Server fns - lists for CPRS;Apr 06, 2021@11:27:11
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**108,122,339**;Jun 20, 1997;Build 39
- HASDAD(DA) ; Evaluate whether a document has a parent
- +1 QUIT $SELECT(+$PIECE($GET(^TIU(8925,+DA,0)),U,6):1,+$GET(^TIU(8925,+DA,21)):1,1:0)
- +2 ;
- SETDAD(TIUY,DA,TIUI,FLG) ; Set parent in return array
- +1 NEW DADA,RMVFLG,TIUD0,TIUD21
- +2 SET FLG=+$GET(FLG)
- +3 ; Exclude components
- +4 if '+$$ISDOC(DA)
- QUIT
- +5 SET TIUD0=$GET(^TIU(8925,DA,0))
- SET TIUD21=$GET(^(21))
- +6 SET DADA=$SELECT(+$PIECE(TIUD0,U,6):+$PIECE(TIUD0,U,6),+TIUD21:+TIUD21,1:0)
- +7 if +DADA'>0
- QUIT
- +8 if +$DATA(@TIUY@("INDX",DADA))
- QUIT
- +9 if +$DATA(^TIU(8925,DADA,0))=0
- QUIT
- +10 SET RMVFLG=0
- +11 IF FLG
- SET RMVFLG=$$DOREMOV(.TIUY,DADA)
- +12 if RMVFLG=1
- QUIT
- +13 SET TIUI=$SELECT(SEQUENCE="A":+$GET(TIUI)-1,1:+$GET(TIUI)+1)
- +14 SET @TIUY@(TIUI)=DADA_U_$$RESOLVE^TIUSRVLO(DADA)
- +15 SET @TIUY@("INDX",DADA,TIUI)=""
- +16 IF +$GET(SHOWADD)
- DO SETKIDS(.TIUY,DADA,.TIUI,FLG)
- +17 IF +$$HASDAD(DADA)
- DO SETDAD(.TIUY,DADA,.TIUI,FLG)
- +18 QUIT
- +19 ;
- HASKIDS(DA) ; Evaluate whether a document has children
- +1 NEW TIUY,KIDA
- SET (KIDA,TIUY)=0
- +2 ; Check for addenda
- +3 FOR
- SET KIDA=$ORDER(^TIU(8925,"DAD",DA,KIDA))
- if +TIUY!(+KIDA'>0)
- QUIT
- Begin DoDot:1
- +4 IF '+$$ISCOMP^TIUSRVR1(KIDA)
- SET TIUY=1
- End DoDot:1
- +5 IF +TIUY
- GOTO HASKIDX
- +6 ; Next, look for ID Entries
- +7 SET TIUY=$SELECT(+$ORDER(^TIU(8925,"GDAD",DA,0)):1,1:0)
- HASKIDX QUIT TIUY
- +1 ;
- SETKIDS(TIUY,DA,TIUI,FLG) ; Set children in return array
- +1 NEW KIDA,RMVFLG
- +2 SET FLG=+$GET(FLG)
- +3 SET RMVFLG=0
- +4 SET KIDA=0
- +5 ; Begin with addenda
- +6 FOR
- SET KIDA=$ORDER(^TIU(8925,"DAD",DA,KIDA))
- if +KIDA'>0
- QUIT
- Begin DoDot:1
- +7 if '+$$ISDOC(KIDA)
- QUIT
- +8 if +$DATA(@TIUY@("INDX",KIDA))
- QUIT
- +9 IF FLG
- SET RMVFLG=$$DOREMOV(.TIUY,KIDA)
- +10 if RMVFLG=1
- QUIT
- +11 SET TIUI=$SELECT(SEQUENCE="A":+$GET(TIUI)-1,1:+$GET(TIUI)+1)
- +12 SET @TIUY@(TIUI)=KIDA_U_$$RESOLVE^TIUSRVLO(KIDA)
- +13 SET @TIUY@("INDX",KIDA,TIUI)=""
- End DoDot:1
- if RMVFLG=1
- QUIT
- +14 ; Next do ID entries
- +15 SET KIDA=0
- +16 FOR
- SET KIDA=$ORDER(^TIU(8925,"GDAD",DA,KIDA))
- if +KIDA'>0
- QUIT
- Begin DoDot:1
- +17 if +$DATA(@TIUY@("INDX",KIDA))
- QUIT
- +18 IF FLG
- SET RMVFLG=$$DOREMOV(.TIUY,KIDA)
- +19 if RMVFLG=1
- QUIT
- +20 SET TIUI=$SELECT(SEQUENCE="A":+$GET(TIUI)-1,1:+$GET(TIUI)+1)
- +21 SET @TIUY@(TIUI)=KIDA_U_$$RESOLVE^TIUSRVLO(KIDA)
- +22 SET @TIUY@("INDX",KIDA,TIUI)=""
- +23 IF +$$HASKIDS(KIDA)
- DO SETKIDS(.TIUY,KIDA,.TIUI,FLG)
- End DoDot:1
- if RMVFLG=1
- QUIT
- +24 QUIT
- ISDOC(DA) ; Evaluate whether a given record is a document
- +1 NEW TIUY,TIUTYP
- +2 SET TIUTYP=+$GET(^TIU(8925,DA,0))
- +3 SET TIUY=$SELECT($PIECE($GET(^TIU(8925.1,+TIUTYP,0)),U,4)="DOC":1,1:0)
- +4 QUIT TIUY
- GETUND(TIUY,CLASS,DFN,TIME1,TIME2,TIUJ,SEQUENCE) ; Get undictated docs
- +1 NEW TIUTYP,TIUI,DATTIM
- +2 DO DOCTYPE^TIUSRVL(.TIUTYP,CLASS)
- if +$DATA(TIUTYP)'>9
- QUIT
- +3 SET TIUI=0
- +4 FOR
- SET TIUI=$ORDER(TIUTYP(TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +5 NEW STATUS
- +6 FOR STATUS=1:1:2
- Begin DoDot:2
- +7 SET DATTIM=TIME1-.0000001
- +8 FOR
- SET DATTIM=$ORDER(^TIU(8925,"APT",DFN,+TIUTYP(TIUI),STATUS,DATTIM))
- if +DATTIM'>0
- QUIT
- Begin DoDot:3
- +9 NEW TIUDA
- SET TIUDA=0
- +10 FOR
- SET TIUDA=$ORDER(^TIU(8925,"APT",DFN,+TIUTYP(TIUI),STATUS,DATTIM,TIUDA))
- if +TIUDA'>0
- QUIT
- Begin DoDot:4
- +11 if +$DATA(@TIUY@("INDX",TIUDA))
- QUIT
- +12 SET TIUJ=$SELECT(SEQUENCE="A":+$GET(TIUJ)-1,1:+$GET(TIUJ)+1)
- +13 SET @TIUY@(TIUJ)=TIUDA_U_$$RESOLVE^TIUSRVLO(TIUDA)
- +14 SET @TIUY@("INDX",TIUDA,TIUJ)=""
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 QUIT
- DOREMOV(TIUY,DA) ;Check for need to remove previously returned data
- +1 ; and perform the remove
- +2 NEW RMVFLG,TIUD0,TIUD1301
- +3 SET RMVFLG=0
- +4 SET TIUD0=$GET(^TIU(8925,DA,0))
- +5 SET TIUD1301=$PIECE($GET(^TIU(8925,DA,13)),U,1)
- +6 IF +$GET(PRVRTNDT)>0
- Begin DoDot:1
- +7 IF PRVRTNDT=TIUD1301
- IF TIUIEN>DA
- QUIT
- +8 IF PRVRTNDT>TIUD1301
- QUIT
- +9 IF (('+$PIECE(TIUD0,U))!('+$GET(TIUD1301))!('+$PIECE(TIUD0,U,2))!(($PIECE(TIUD0,U,5)<6)))
- QUIT
- +10 DO RMV(.TIUY,DA)
- +11 SET RMVFLG=1
- +12 QUIT
- End DoDot:1
- +13 QUIT RMVFLG
- RMV(TIUY,DA) ; Remove notes previously returned
- +1 DO RMVDAD(.TIUY,DA)
- +2 DO RMVKID(.TIUY,DA)
- +3 IF TIUJ>0
- SET TIUJ=TIUJ-1
- +4 QUIT
- RMVDAD(TIUY,DA) ; Remove parent entries
- +1 NEW CNT,DADA,TIUD0,TIUD21
- +2 ; Exclude components
- +3 if '+$$ISDOC(DA)
- QUIT
- +4 SET TIUD0=$GET(^TIU(8925,DA,0))
- SET TIUD21=$GET(^(21))
- +5 SET DADA=$SELECT(+$PIECE(TIUD0,U,6):+$PIECE(TIUD0,U,6),+TIUD21:+TIUD21,1:0)
- +6 if +DADA'>0
- QUIT
- +7 SET @TIUY@("INDX",DADA)=""
- +8 SET CNT=+$ORDER(@TIUY@("INDX",DADA,""))
- +9 if CNT<1
- QUIT
- +10 KILL @TIUY@(CNT)
- +11 IF +$GET(SHOWADD)
- DO RMVKID(.TIUY,DADA)
- +12 IF +$$HASDAD(DADA)
- DO RMVDAD(.TIUY,DADA)
- +13 QUIT
- RMVKID(TIUY,DA) ; Remove child notes
- +1 NEW CNT,KIDA
- +2 SET KIDA=0
- +3 ; Begin with addenda
- +4 FOR
- SET KIDA=$ORDER(^TIU(8925,"DAD",DA,KIDA))
- if +KIDA'>0
- QUIT
- Begin DoDot:1
- +5 if '+$$ISDOC(KIDA)
- QUIT
- +6 SET @TIUY@("INDX",KIDA)=""
- +7 SET CNT=+$ORDER(@TIUY@("INDX",KIDA,""))
- +8 if CNT<1
- QUIT
- +9 KILL @TIUY@(CNT)
- +10 QUIT
- End DoDot:1
- +11 ; Next do ID entries
- +12 SET KIDA=0
- +13 FOR
- SET KIDA=$ORDER(^TIU(8925,"GDAD",DA,KIDA))
- if +KIDA'>0
- QUIT
- Begin DoDot:1
- +14 SET @TIUY@("INDX",KIDA)=""
- +15 SET CNT=+$ORDER(@TIUY@("INDX",KIDA,""))
- +16 if CNT<1
- QUIT
- +17 KILL @TIUY@(CNT)
- +18 IF +$$HASKIDS(KIDA)
- DO RMVKID(.TIUY,KIDA)
- +19 QUIT
- End DoDot:1
- +20 QUIT
- RESEQ(TIUY,TIUI) ; Resequence @TIUY@(TIUI) after removal of entries and reset TIUI
- +1 NEW ADD,ARRY,CNT,CNT1,DA,DATA
- +2 SET ADD=$SELECT(SEQUENCE="D":1,1:-1)
- +3 SET ARRY=$NAME(^TMP("TIURESEQ",$JOB))
- +4 SET (CNT,CNT1)=0
- +5 FOR
- SET CNT1=$ORDER(@TIUY@(CNT1),ADD)
- if CNT1=""
- QUIT
- Begin DoDot:1
- +6 IF +CNT1=0
- QUIT
- +7 SET CNT=CNT+ADD
- +8 SET @ARRY@(CNT)=$GET(@TIUY@(CNT1))
- +9 QUIT
- End DoDot:1
- +10 KILL @TIUY
- +11 MERGE @TIUY=@ARRY
- +12 KILL @ARRY
- +13 QUIT