Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUSRVLI

TIUSRVLI.m

Go to the documentation of this file.
  1. 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
  1. HASDAD(DA) ; Evaluate whether a document has a parent
  1. Q $S(+$P($G(^TIU(8925,+DA,0)),U,6):1,+$G(^TIU(8925,+DA,21)):1,1:0)
  1. ;
  1. SETDAD(TIUY,DA,TIUI,FLG) ; Set parent in return array
  1. N DADA,RMVFLG,TIUD0,TIUD21
  1. S FLG=+$G(FLG)
  1. ; Exclude components
  1. Q:'+$$ISDOC(DA)
  1. S TIUD0=$G(^TIU(8925,DA,0)),TIUD21=$G(^(21))
  1. S DADA=$S(+$P(TIUD0,U,6):+$P(TIUD0,U,6),+TIUD21:+TIUD21,1:0)
  1. Q:+DADA'>0
  1. Q:+$D(@TIUY@("INDX",DADA))
  1. Q:+$D(^TIU(8925,DADA,0))=0
  1. S RMVFLG=0
  1. I FLG S RMVFLG=$$DOREMOV(.TIUY,DADA)
  1. Q:RMVFLG=1
  1. S TIUI=$S(SEQUENCE="A":+$G(TIUI)-1,1:+$G(TIUI)+1)
  1. S @TIUY@(TIUI)=DADA_U_$$RESOLVE^TIUSRVLO(DADA)
  1. S @TIUY@("INDX",DADA,TIUI)=""
  1. I +$G(SHOWADD) D SETKIDS(.TIUY,DADA,.TIUI,FLG)
  1. I +$$HASDAD(DADA) D SETDAD(.TIUY,DADA,.TIUI,FLG)
  1. Q
  1. ;
  1. HASKIDS(DA) ; Evaluate whether a document has children
  1. N TIUY,KIDA S (KIDA,TIUY)=0
  1. ; Check for addenda
  1. F S KIDA=$O(^TIU(8925,"DAD",DA,KIDA)) Q:+TIUY!(+KIDA'>0) D
  1. . I '+$$ISCOMP^TIUSRVR1(KIDA) S TIUY=1
  1. I +TIUY G HASKIDX
  1. ; Next, look for ID Entries
  1. S TIUY=$S(+$O(^TIU(8925,"GDAD",DA,0)):1,1:0)
  1. HASKIDX Q TIUY
  1. ;
  1. SETKIDS(TIUY,DA,TIUI,FLG) ; Set children in return array
  1. N KIDA,RMVFLG
  1. S FLG=+$G(FLG)
  1. S RMVFLG=0
  1. S KIDA=0
  1. ; Begin with addenda
  1. F S KIDA=$O(^TIU(8925,"DAD",DA,KIDA)) Q:+KIDA'>0 D Q:RMVFLG=1
  1. . Q:'+$$ISDOC(KIDA)
  1. . Q:+$D(@TIUY@("INDX",KIDA))
  1. . I FLG S RMVFLG=$$DOREMOV(.TIUY,KIDA)
  1. . Q:RMVFLG=1
  1. . S TIUI=$S(SEQUENCE="A":+$G(TIUI)-1,1:+$G(TIUI)+1)
  1. . S @TIUY@(TIUI)=KIDA_U_$$RESOLVE^TIUSRVLO(KIDA)
  1. . S @TIUY@("INDX",KIDA,TIUI)=""
  1. ; Next do ID entries
  1. S KIDA=0
  1. F S KIDA=$O(^TIU(8925,"GDAD",DA,KIDA)) Q:+KIDA'>0 D Q:RMVFLG=1
  1. . Q:+$D(@TIUY@("INDX",KIDA))
  1. . I FLG S RMVFLG=$$DOREMOV(.TIUY,KIDA)
  1. . Q:RMVFLG=1
  1. . S TIUI=$S(SEQUENCE="A":+$G(TIUI)-1,1:+$G(TIUI)+1)
  1. . S @TIUY@(TIUI)=KIDA_U_$$RESOLVE^TIUSRVLO(KIDA)
  1. . S @TIUY@("INDX",KIDA,TIUI)=""
  1. . I +$$HASKIDS(KIDA) D SETKIDS(.TIUY,KIDA,.TIUI,FLG)
  1. Q
  1. ISDOC(DA) ; Evaluate whether a given record is a document
  1. N TIUY,TIUTYP
  1. S TIUTYP=+$G(^TIU(8925,DA,0))
  1. S TIUY=$S($P($G(^TIU(8925.1,+TIUTYP,0)),U,4)="DOC":1,1:0)
  1. Q TIUY
  1. GETUND(TIUY,CLASS,DFN,TIME1,TIME2,TIUJ,SEQUENCE) ; Get undictated docs
  1. N TIUTYP,TIUI,DATTIM
  1. D DOCTYPE^TIUSRVL(.TIUTYP,CLASS) Q:+$D(TIUTYP)'>9
  1. S TIUI=0
  1. F S TIUI=$O(TIUTYP(TIUI)) Q:+TIUI'>0 D
  1. . N STATUS
  1. . F STATUS=1:1:2 D
  1. . . S DATTIM=TIME1-.0000001
  1. . . F S DATTIM=$O(^TIU(8925,"APT",DFN,+TIUTYP(TIUI),STATUS,DATTIM)) Q:+DATTIM'>0 D
  1. . . . N TIUDA S TIUDA=0
  1. . . . F S TIUDA=$O(^TIU(8925,"APT",DFN,+TIUTYP(TIUI),STATUS,DATTIM,TIUDA)) Q:+TIUDA'>0 D
  1. . . . . Q:+$D(@TIUY@("INDX",TIUDA))
  1. . . . . S TIUJ=$S(SEQUENCE="A":+$G(TIUJ)-1,1:+$G(TIUJ)+1)
  1. . . . . S @TIUY@(TIUJ)=TIUDA_U_$$RESOLVE^TIUSRVLO(TIUDA)
  1. . . . . S @TIUY@("INDX",TIUDA,TIUJ)=""
  1. Q
  1. DOREMOV(TIUY,DA) ;Check for need to remove previously returned data
  1. ; and perform the remove
  1. N RMVFLG,TIUD0,TIUD1301
  1. S RMVFLG=0
  1. S TIUD0=$G(^TIU(8925,DA,0))
  1. S TIUD1301=$P($G(^TIU(8925,DA,13)),U,1)
  1. I +$G(PRVRTNDT)>0 D
  1. . I PRVRTNDT=TIUD1301,TIUIEN>DA Q
  1. . I PRVRTNDT>TIUD1301 Q
  1. . I (('+$P(TIUD0,U))!('+$G(TIUD1301))!('+$P(TIUD0,U,2))!(($P(TIUD0,U,5)<6))) Q
  1. . D RMV(.TIUY,DA)
  1. . S RMVFLG=1
  1. . Q
  1. Q RMVFLG
  1. RMV(TIUY,DA) ; Remove notes previously returned
  1. D RMVDAD(.TIUY,DA)
  1. D RMVKID(.TIUY,DA)
  1. I TIUJ>0 S TIUJ=TIUJ-1
  1. Q
  1. RMVDAD(TIUY,DA) ; Remove parent entries
  1. N CNT,DADA,TIUD0,TIUD21
  1. ; Exclude components
  1. Q:'+$$ISDOC(DA)
  1. S TIUD0=$G(^TIU(8925,DA,0)),TIUD21=$G(^(21))
  1. S DADA=$S(+$P(TIUD0,U,6):+$P(TIUD0,U,6),+TIUD21:+TIUD21,1:0)
  1. Q:+DADA'>0
  1. S @TIUY@("INDX",DADA)=""
  1. S CNT=+$O(@TIUY@("INDX",DADA,""))
  1. Q:CNT<1
  1. K @TIUY@(CNT)
  1. I +$G(SHOWADD) D RMVKID(.TIUY,DADA)
  1. I +$$HASDAD(DADA) D RMVDAD(.TIUY,DADA)
  1. Q
  1. RMVKID(TIUY,DA) ; Remove child notes
  1. N CNT,KIDA
  1. S KIDA=0
  1. ; Begin with addenda
  1. F S KIDA=$O(^TIU(8925,"DAD",DA,KIDA)) Q:+KIDA'>0 D
  1. . Q:'+$$ISDOC(KIDA)
  1. . S @TIUY@("INDX",KIDA)=""
  1. . S CNT=+$O(@TIUY@("INDX",KIDA,""))
  1. . Q:CNT<1
  1. . K @TIUY@(CNT)
  1. . Q
  1. ; Next do ID entries
  1. S KIDA=0
  1. F S KIDA=$O(^TIU(8925,"GDAD",DA,KIDA)) Q:+KIDA'>0 D
  1. . S @TIUY@("INDX",KIDA)=""
  1. . S CNT=+$O(@TIUY@("INDX",KIDA,""))
  1. . Q:CNT<1
  1. . K @TIUY@(CNT)
  1. . I +$$HASKIDS(KIDA) D RMVKID(.TIUY,KIDA)
  1. . Q
  1. Q
  1. RESEQ(TIUY,TIUI) ; Resequence @TIUY@(TIUI) after removal of entries and reset TIUI
  1. N ADD,ARRY,CNT,CNT1,DA,DATA
  1. S ADD=$S(SEQUENCE="D":1,1:-1)
  1. S ARRY=$NA(^TMP("TIURESEQ",$J))
  1. S (CNT,CNT1)=0
  1. F S CNT1=$O(@TIUY@(CNT1),ADD) Q:CNT1="" D
  1. . I +CNT1=0 Q
  1. . S CNT=CNT+ADD
  1. . S @ARRY@(CNT)=$G(@TIUY@(CNT1))
  1. . Q
  1. K @TIUY
  1. M @TIUY=@ARRY
  1. K @ARRY
  1. Q