- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUQRY 5940 printed Jan 18, 2025@03:46 Page 2
- 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