TIUQRY ; SLC/JER/CAM - Queries for Documents Across Patients ;3/27/03 16:15
;;1.0;TEXT INTEGRATION UTILITIES;**150**;Jun 20, 1997
QUERY(TIUY,QRY,PATIENT) ; Execute Query
N TIUPRM0,TIUPRM1,TIUPRM3,FLAGA,FLAGV S FLAGA=0,FLAGV=0
D SETPARM^TIULE
I '+$G(PATIENT("Patient.DFN")) S @TIUY@(0,"Documents")="0^ Patient not specified" Q
I '$O(QRY("Status",0)) D STATUS(.QRY)
I '$O(QRY("Title",0)),'$O(QRY("Class",0)) S @TIUY@(0,"Documents")="0^ Title or Class not specified" Q
I $O(QRY("Author",0)) S FLAGA=1
I $O(QRY("Location",0)) S FLAGV=1
D CHECKADD(.QRY)
D GATHER(TIUY,.QRY,.PATIENT,FLAGA,FLAGV)
K @TIUY@("INDX")
Q
;
GATHER(TIUY,QRY,PATIENT,FLAGA,FLAGV) ; Find/sort records for the list
N DFN,EARLY,LATE,RANGE,TIUC
S TIUC=0
S RANGE=$O(QRY("Reference",""))
S DFN=+$G(PATIENT("Patient.DFN"))
S EARLY=9999999-$P(RANGE,":")
S LATE=9999999-$P(RANGE,":",2)
I $O(QRY("Title",0)) D
.N GVN S GVN=$NA(^TIU(8925,"APT",DFN))
.N TIUT S TIUT=0
.F S TIUT=$O(QRY("Title",TIUT)) Q:+TIUT'>0 D
..N TIUS S TIUS=0
..F S TIUS=$O(QRY("Status",TIUS)) Q:+TIUS'>0 D
...N TIUJ S TIUJ=LATE
...F S TIUJ=$O(@GVN@(TIUT,TIUS,TIUJ)) Q:+TIUJ'>0!(+TIUJ>EARLY) D
....N TIUDA
....S TIUDA=0 F S TIUDA=$O(@GVN@(TIUT,TIUS,TIUJ,TIUDA)) Q:+TIUDA'>0 D
.....I FLAGA=0,FLAGV=0 D FOUNDTL(TIUY,TIUDA,.QRY,.PATIENT,.TIUC)
.....I FLAGA=1,FLAGV=0,$$AUTHOR(TIUDA,.QRY) D FOUNDTL(TIUY,TIUDA,.QRY,.PATIENT,.TIUC)
.....I FLAGA=0,FLAGV=1,$$VISIT(TIUDA,.QRY) D FOUNDTL(TIUY,TIUDA,.QRY,.PATIENT,.TIUC)
.....I FLAGA=1,FLAGV=1,$$AUTHOR(TIUDA,.QRY),$$VISIT(TIUDA,.QRY) D FOUNDTL(TIUY,TIUDA,.QRY,.PATIENT,.TIUC)
I $O(QRY("Class",0)) D
.N TIUCC S TIUCC=0
.F S TIUCC=$O(QRY("Class",TIUCC)) Q:TIUCC'>0 D STATCHK(TIUCC,.QRY,.TIUC,.DFN,.EARLY,.LATE,.FLAGA)
S @TIUY@(0,"Documents")=TIUC
Q
;
ACLSB(TIUCC,QRY,TIUC,DFN,EARLY,LATE,FLAGA) ; Using the ACLSB cross reference for a status of > 5
N TIUAUTH S TIUAUTH=0
F S TIUAUTH=$O(^TIU(8925,"ACLSB",TIUCC,TIUAUTH)) Q:(TIUAUTH'>0) D
.Q:(FLAGA=1)&'$$AUTHDOC(TIUAUTH,.QRY)
.N GVN S GVN=$NA(^TIU(8925,"ACLSB",TIUCC,TIUAUTH,DFN))
.N TIUD S TIUD=LATE
.F S TIUD=$O(@GVN@(TIUD)) Q:TIUD'>0!(TIUD>EARLY) D
..N TIUDA S TIUDA=0
..F S TIUDA=$O(@GVN@(TIUD,TIUDA)) Q:TIUDA'>0 D
...I FLAGV=0,$$STAT(TIUDA,.QRY) D FOUNDDC(TIUY,TIUDA,.QRY,.PATIENT,.TIUC)
...I FLAGV=1,$$VISIT(TIUDA,.QRY),$$STAT(TIUDA,.QRY) D FOUNDDC(TIUY,TIUDA,.QRY,.PATIENT,.TIUC)
Q
;
ACLAU(TIUCC,QRY,TIUC,DFN,EARLY,LATE,FLAGA) ; Using the ACLAU cross reference for a status of < 6
N TIUAUTH S TIUAUTH=0
F S TIUAUTH=$O(^TIU(8925,"ACLAU",TIUCC,TIUAUTH)) Q:(TIUAUTH'>0) D
.Q:(FLAGA=1)&'$$AUTHDOC(TIUAUTH,.QRY)
.N GVN S GVN=$NA(^TIU(8925,"ACLAU",TIUCC,TIUAUTH,DFN))
.N TIUD S TIUD=LATE
.F S TIUD=$O(@GVN@(TIUD)) Q:TIUD'>0!(TIUD>EARLY) D
..N TIUDA S TIUDA=0
..F S TIUDA=$O(@GVN@(TIUD,TIUDA)) Q:TIUDA'>0 D
...I FLAGV=0,$$STAT(TIUDA,.QRY) D FOUNDDC(TIUY,TIUDA,.QRY,.PATIENT,.TIUC)
...I FLAGV=1,$$VISIT(TIUDA,.QRY),$$STAT(TIUDA,.QRY) D FOUNDDC(TIUY,TIUDA,.QRY,.PATIENT,.TIUC)
Q
;
STATCHK(TIUCC,QRY,TIUC,DFN,EARLY,LATE,FLAGA) ; Check status(es) entered by user. Cross ref used depends on status of doc.
N TIUS S TIUS=0
F S TIUS=$O(QRY("Status",TIUS)) Q:TIUS'>0 D
.I TIUS>5 D ACLSB(TIUCC,.QRY,.TIUC,.DFN,.EARLY,.LATE,.FLAGA)
.I TIUS<6 D ACLAU(TIUCC,.QRY,.TIUC,.DFN,.EARLY,.LATE,.FLAGA)
Q
;
FOUNDTL(TIUY,TIUDA,QRY,PATIENT,TIUC) ;Sort by title, resolves document found
I TIUT=81,'$$DADINTYP(TIUDA,.QRY) Q
D RESOLVE^TIUQRYL(TIUY,TIUDA,.QRY,.PATIENT)
S @TIUY@("INDX",TIUDA)="",TIUC=TIUC+1
Q
;
FOUNDDC(TIUY,TIUDA,QRY,PATIENT,TIUC) ;Sort by document, resolves document found
I $D(@TIUY@("INDX",TIUDA)) Q ; Don't set up if already exists
D RESOLVE^TIUQRYL(TIUY,TIUDA,.QRY,.PATIENT)
S @TIUY@("INDX",TIUDA)="",TIUC=TIUC+1
Q
;
STAT(TIUDA1,QRY) ; Determines status of document then checks to see if
; status is included in the status list selected for query.
; TIUS=Status of document
N TIUS1,CHECK,TIUS S TIUS1=0,CHECK="",TIUS=0
; CHECK returned as 1 if the status was selected in query.
S TIUS1=$P($G(^TIU(8925,TIUDA1,0)),U,5)
F S TIUS=$O(QRY("Status",TIUS)) Q:TIUS'>0 I TIUS=TIUS1 S CHECK=1
Q CHECK
;
AUTHDOC(TIUAUTH1,QRY) ; Checks to see if the author of the note being evaluated is
; included in the author list selected for query.
N CHECK,TIUAUTH2
; CHECK returned as 1 if the author was selected in query.
S CHECK="",TIUAUTH2=0
F S TIUAUTH2=$O(QRY("Author",TIUAUTH2)) Q:TIUAUTH2'>0!+CHECK I TIUAUTH2=TIUAUTH1 S CHECK=1
Q CHECK
;
AUTHOR(TIUDA1,QRY) ; Determines author of document then checks to see if author
; is included in the author list selected for query.
N TIUAUTH,TIUAUTH1,CHECK S TIUAUTH=0,TIUAUTH1=0,CHECK=""
S TIUAUTH1=$P($G(^TIU(8925,TIUDA1,12)),U,2)
F S TIUAUTH=$O(QRY("Author",TIUAUTH)) Q:TIUAUTH'>0!+CHECK I TIUAUTH=TIUAUTH1 S CHECK=1
Q CHECK
;
VISIT(TIUDA1,QRY) ; Checks location of visit then checks to see if location is included
; in the location list selected for query.
N TIUVST,TIUVST1,CHECK S TIUVST=0,TIUVST1=0,CHECK=0
S TIUVST1=$P($G(^TIU(8925,TIUDA1,12)),U,5)
F S TIUVST=$O(QRY("Location",TIUVST)) Q:TIUVST'>0!+CHECK I TIUVST=TIUVST1 S CHECK=1
Q CHECK
;
DADINTYP(TIUDA,QRY) ; Evaluates whether addendum's parent belongs is among
; the selected types
N TIUI,TIUDTYP,TIUY S (TIUI,TIUY)=0
S TIUDTYP=+$G(^TIU(8925,+$P($G(^TIU(8925,+TIUDA,0)),U,6),0))
F S TIUI=$O(QRY("Title",TIUI)) Q:+TIUI'>0!+TIUY D
. S:TIUI=TIUDTYP TIUY=1
Q TIUY
;
CHECKADD(QRY) ; Assures that Addendum is included in the list of types
S QRY("Title",81)=""
Q
;
STATUS(QRY) ; Gets status(es)
N TIUI,TIUS,STATUS S (TIUI,TIUS)=0
S STATUS=""
F S STATUS=$O(^TIU(8925.6,"B",STATUS)) Q:STATUS="" D
.S TIUS=0
.F S TIUS=$O(^TIU(8925.6,"B",STATUS,TIUS)) Q:+TIUS'>0 D
..S:($P(^TIU(8925.6,+TIUS,0),U,4)'="DEF") QRY("Status",TIUS)=""
Q
TIUQRY ; SLC/JER/CAM - Queries for Documents Across Patients ;3/27/03 16:15
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**150**;Jun 20, 1997
QUERY(TIUY,QRY,PATIENT) ; Execute Query
+1 NEW TIUPRM0,TIUPRM1,TIUPRM3,FLAGA,FLAGV
SET FLAGA=0
SET FLAGV=0
+2 DO SETPARM^TIULE
+3 IF '+$GET(PATIENT("Patient.DFN"))
SET @TIUY@(0,"Documents")="0^ Patient not specified"
QUIT
+4 IF '$ORDER(QRY("Status",0))
DO STATUS(.QRY)
+5 IF '$ORDER(QRY("Title",0))
IF '$ORDER(QRY("Class",0))
SET @TIUY@(0,"Documents")="0^ Title or Class not specified"
QUIT
+6 IF $ORDER(QRY("Author",0))
SET FLAGA=1
+7 IF $ORDER(QRY("Location",0))
SET FLAGV=1
+8 DO CHECKADD(.QRY)
+9 DO GATHER(TIUY,.QRY,.PATIENT,FLAGA,FLAGV)
+10 KILL @TIUY@("INDX")
+11 QUIT
+12 ;
GATHER(TIUY,QRY,PATIENT,FLAGA,FLAGV) ; Find/sort records for the list
+1 NEW DFN,EARLY,LATE,RANGE,TIUC
+2 SET TIUC=0
+3 SET RANGE=$ORDER(QRY("Reference",""))
+4 SET DFN=+$GET(PATIENT("Patient.DFN"))
+5 SET EARLY=9999999-$PIECE(RANGE,":")
+6 SET LATE=9999999-$PIECE(RANGE,":",2)
+7 IF $ORDER(QRY("Title",0))
Begin DoDot:1
+8 NEW GVN
SET GVN=$NAME(^TIU(8925,"APT",DFN))
+9 NEW TIUT
SET TIUT=0
+10 FOR
SET TIUT=$ORDER(QRY("Title",TIUT))
IF +TIUT'>0
QUIT
Begin DoDot:2
+11 NEW TIUS
SET TIUS=0
+12 FOR
SET TIUS=$ORDER(QRY("Status",TIUS))
IF +TIUS'>0
QUIT
Begin DoDot:3
+13 NEW TIUJ
SET TIUJ=LATE
+14 FOR
SET TIUJ=$ORDER(@GVN@(TIUT,TIUS,TIUJ))
IF +TIUJ'>0!(+TIUJ>EARLY)
QUIT
Begin DoDot:4
+15 NEW TIUDA
+16 SET TIUDA=0
FOR
SET TIUDA=$ORDER(@GVN@(TIUT,TIUS,TIUJ,TIUDA))
IF +TIUDA'>0
QUIT
Begin DoDot:5
+17 IF FLAGA=0
IF FLAGV=0
DO FOUNDTL(TIUY,TIUDA,.QRY,.PATIENT,.TIUC)
+18 IF FLAGA=1
IF FLAGV=0
IF $$AUTHOR(TIUDA,.QRY)
DO FOUNDTL(TIUY,TIUDA,.QRY,.PATIENT,.TIUC)
+19 IF FLAGA=0
IF FLAGV=1
IF $$VISIT(TIUDA,.QRY)
DO FOUNDTL(TIUY,TIUDA,.QRY,.PATIENT,.TIUC)
+20 IF FLAGA=1
IF FLAGV=1
IF $$AUTHOR(TIUDA,.QRY)
IF $$VISIT(TIUDA,.QRY)
DO FOUNDTL(TIUY,TIUDA,.QRY,.PATIENT,.TIUC)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 IF $ORDER(QRY("Class",0))
Begin DoDot:1
+22 NEW TIUCC
SET TIUCC=0
+23 FOR
SET TIUCC=$ORDER(QRY("Class",TIUCC))
IF TIUCC'>0
QUIT
DO STATCHK(TIUCC,.QRY,.TIUC,.DFN,.EARLY,.LATE,.FLAGA)
End DoDot:1
+24 SET @TIUY@(0,"Documents")=TIUC
+25 QUIT
+26 ;
ACLSB(TIUCC,QRY,TIUC,DFN,EARLY,LATE,FLAGA) ; Using the ACLSB cross reference for a status of > 5
+1 NEW TIUAUTH
SET TIUAUTH=0
+2 FOR
SET TIUAUTH=$ORDER(^TIU(8925,"ACLSB",TIUCC,TIUAUTH))
IF (TIUAUTH'>0)
QUIT
Begin DoDot:1
+3 IF (FLAGA=1)&'$$AUTHDOC(TIUAUTH,.QRY)
QUIT
+4 NEW GVN
SET GVN=$NAME(^TIU(8925,"ACLSB",TIUCC,TIUAUTH,DFN))
+5 NEW TIUD
SET TIUD=LATE
+6 FOR
SET TIUD=$ORDER(@GVN@(TIUD))
IF TIUD'>0!(TIUD>EARLY)
QUIT
Begin DoDot:2
+7 NEW TIUDA
SET TIUDA=0
+8 FOR
SET TIUDA=$ORDER(@GVN@(TIUD,TIUDA))
IF TIUDA'>0
QUIT
Begin DoDot:3
+9 IF FLAGV=0
IF $$STAT(TIUDA,.QRY)
DO FOUNDDC(TIUY,TIUDA,.QRY,.PATIENT,.TIUC)
+10 IF FLAGV=1
IF $$VISIT(TIUDA,.QRY)
IF $$STAT(TIUDA,.QRY)
DO FOUNDDC(TIUY,TIUDA,.QRY,.PATIENT,.TIUC)
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
ACLAU(TIUCC,QRY,TIUC,DFN,EARLY,LATE,FLAGA) ; Using the ACLAU cross reference for a status of < 6
+1 NEW TIUAUTH
SET TIUAUTH=0
+2 FOR
SET TIUAUTH=$ORDER(^TIU(8925,"ACLAU",TIUCC,TIUAUTH))
IF (TIUAUTH'>0)
QUIT
Begin DoDot:1
+3 IF (FLAGA=1)&'$$AUTHDOC(TIUAUTH,.QRY)
QUIT
+4 NEW GVN
SET GVN=$NAME(^TIU(8925,"ACLAU",TIUCC,TIUAUTH,DFN))
+5 NEW TIUD
SET TIUD=LATE
+6 FOR
SET TIUD=$ORDER(@GVN@(TIUD))
IF TIUD'>0!(TIUD>EARLY)
QUIT
Begin DoDot:2
+7 NEW TIUDA
SET TIUDA=0
+8 FOR
SET TIUDA=$ORDER(@GVN@(TIUD,TIUDA))
IF TIUDA'>0
QUIT
Begin DoDot:3
+9 IF FLAGV=0
IF $$STAT(TIUDA,.QRY)
DO FOUNDDC(TIUY,TIUDA,.QRY,.PATIENT,.TIUC)
+10 IF FLAGV=1
IF $$VISIT(TIUDA,.QRY)
IF $$STAT(TIUDA,.QRY)
DO FOUNDDC(TIUY,TIUDA,.QRY,.PATIENT,.TIUC)
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
STATCHK(TIUCC,QRY,TIUC,DFN,EARLY,LATE,FLAGA) ; Check status(es) entered by user. Cross ref used depends on status of doc.
+1 NEW TIUS
SET TIUS=0
+2 FOR
SET TIUS=$ORDER(QRY("Status",TIUS))
IF TIUS'>0
QUIT
Begin DoDot:1
+3 IF TIUS>5
DO ACLSB(TIUCC,.QRY,.TIUC,.DFN,.EARLY,.LATE,.FLAGA)
+4 IF TIUS<6
DO ACLAU(TIUCC,.QRY,.TIUC,.DFN,.EARLY,.LATE,.FLAGA)
End DoDot:1
+5 QUIT
+6 ;
FOUNDTL(TIUY,TIUDA,QRY,PATIENT,TIUC) ;Sort by title, resolves document found
+1 IF TIUT=81
IF '$$DADINTYP(TIUDA,.QRY)
QUIT
+2 DO RESOLVE^TIUQRYL(TIUY,TIUDA,.QRY,.PATIENT)
+3 SET @TIUY@("INDX",TIUDA)=""
SET TIUC=TIUC+1
+4 QUIT
+5 ;
FOUNDDC(TIUY,TIUDA,QRY,PATIENT,TIUC) ;Sort by document, resolves document found
+1 ; Don't set up if already exists
IF $DATA(@TIUY@("INDX",TIUDA))
QUIT
+2 DO RESOLVE^TIUQRYL(TIUY,TIUDA,.QRY,.PATIENT)
+3 SET @TIUY@("INDX",TIUDA)=""
SET TIUC=TIUC+1
+4 QUIT
+5 ;
STAT(TIUDA1,QRY) ; Determines status of document then checks to see if
+1 ; status is included in the status list selected for query.
+2 ; TIUS=Status of document
+3 NEW TIUS1,CHECK,TIUS
SET TIUS1=0
SET CHECK=""
SET TIUS=0
+4 ; CHECK returned as 1 if the status was selected in query.
+5 SET TIUS1=$PIECE($GET(^TIU(8925,TIUDA1,0)),U,5)
+6 FOR
SET TIUS=$ORDER(QRY("Status",TIUS))
IF TIUS'>0
QUIT
IF TIUS=TIUS1
SET CHECK=1
+7 QUIT CHECK
+8 ;
AUTHDOC(TIUAUTH1,QRY) ; Checks to see if the author of the note being evaluated is
+1 ; included in the author list selected for query.
+2 NEW CHECK,TIUAUTH2
+3 ; CHECK returned as 1 if the author was selected in query.
+4 SET CHECK=""
SET TIUAUTH2=0
+5 FOR
SET TIUAUTH2=$ORDER(QRY("Author",TIUAUTH2))
IF TIUAUTH2'>0!+CHECK
QUIT
IF TIUAUTH2=TIUAUTH1
SET CHECK=1
+6 QUIT CHECK
+7 ;
AUTHOR(TIUDA1,QRY) ; Determines author of document then checks to see if author
+1 ; is included in the author list selected for query.
+2 NEW TIUAUTH,TIUAUTH1,CHECK
SET TIUAUTH=0
SET TIUAUTH1=0
SET CHECK=""
+3 SET TIUAUTH1=$PIECE($GET(^TIU(8925,TIUDA1,12)),U,2)
+4 FOR
SET TIUAUTH=$ORDER(QRY("Author",TIUAUTH))
IF TIUAUTH'>0!+CHECK
QUIT
IF TIUAUTH=TIUAUTH1
SET CHECK=1
+5 QUIT CHECK
+6 ;
VISIT(TIUDA1,QRY) ; Checks location of visit then checks to see if location is included
+1 ; in the location list selected for query.
+2 NEW TIUVST,TIUVST1,CHECK
SET TIUVST=0
SET TIUVST1=0
SET CHECK=0
+3 SET TIUVST1=$PIECE($GET(^TIU(8925,TIUDA1,12)),U,5)
+4 FOR
SET TIUVST=$ORDER(QRY("Location",TIUVST))
IF TIUVST'>0!+CHECK
QUIT
IF TIUVST=TIUVST1
SET CHECK=1
+5 QUIT CHECK
+6 ;
DADINTYP(TIUDA,QRY) ; Evaluates whether addendum's parent belongs is among
+1 ; the selected types
+2 NEW TIUI,TIUDTYP,TIUY
SET (TIUI,TIUY)=0
+3 SET TIUDTYP=+$GET(^TIU(8925,+$PIECE($GET(^TIU(8925,+TIUDA,0)),U,6),0))
+4 FOR
SET TIUI=$ORDER(QRY("Title",TIUI))
IF +TIUI'>0!+TIUY
QUIT
Begin DoDot:1
+5 IF TIUI=TIUDTYP
SET TIUY=1
End DoDot:1
+6 QUIT TIUY
+7 ;
CHECKADD(QRY) ; Assures that Addendum is included in the list of types
+1 SET QRY("Title",81)=""
+2 QUIT
+3 ;
STATUS(QRY) ; Gets status(es)
+1 NEW TIUI,TIUS,STATUS
SET (TIUI,TIUS)=0
+2 SET STATUS=""
+3 FOR
SET STATUS=$ORDER(^TIU(8925.6,"B",STATUS))
IF STATUS=""
QUIT
Begin DoDot:1
+4 SET TIUS=0
+5 FOR
SET TIUS=$ORDER(^TIU(8925.6,"B",STATUS,TIUS))
IF +TIUS'>0
QUIT
Begin DoDot:2
+6 IF ($PIECE(^TIU(8925.6,+TIUS,0),U,4)'="DEF")
SET QRY("Status",TIUS)=""
End DoDot:2
End DoDot:1
+7 QUIT
