ISIJLS2 ; ISI/JHC - ISIRAD exam list functions ; 10/17/2022
;;1.1;ESL ISI IMAGING;**99,105,107,110**;Dec 21, 2022;Build 41
;; This routine is the property of ViTel Net, and should not be modified.
;; This software is a medical device and is subject to FDA regulation.
;; Modifications to this software may only be made under the terms of
;; 21CFR820 regulation. 21CFR Subpart A 820.1: "The failure to comply
;; with any applicable provision in this part renders a device
;; adulterated under section 501(h) of the act. Such a device,
;; as well as any person responsible for the failure to comply,
;; is subject to regulatory action."
; Reference to SVMAG2A^MAGJLS3 in ICR #7403
; Reference to GETEXAM2^MAGJUTL1 in ICR #7404
; Reference to File #2006.63 in ICR #7408
; Reference to File #2006.69 in ICR #7410
Q
;
ERR N ERR S ERR=$$EC^%ZOSV S ^TMP($J,"RET",0)="0^4~"_ERR
S MAGGRY=$NA(^TMP($J,"RET"))
D @^%ZOSF("ERRTN")
Q:$Q 1 Q
;
; entry point for Dynamic Query list compile; this is
; a List Type "I" list, so is called indirect from INDXBLD^ISIJLS1,
; as defined in the exams list entry for Dynamic Query, #9820
;
QRYCOMP(REPLY) ; Compile dynamic query lists
N FULLSCAN,QAGE,QDATFR,QDATTO,QIMGTYP,QRIST,QSEX,QPTNAME,QSTATUS,QUERY,QNIMG,QASSN
N QIMGLOC
N AGE1,AGE2,COMMA,ERRMSG,DATTEST,IDX,IDXFIL,MAGRET,NOGO,NIMG1,NIMG2,NIMGSPEC
N PTDATA,PTNAME,RADATA,RADFN,RADTI,RACNI,RISTCHK,SCAN,SESSION,SEX,STS,STATTEST
N SCANSTRT,EXAMDAT,ABORT,RECCOUNT,RSLLIMIT,ASSNCHK,ASSNDATA
S COMMA=",",SESSION=MAGJOB("SESSION"),ERRMSG=""
S REPLY=""
D QRYGET(.FULLSCAN,.QUERY) ; get query info
I QUERY D
. D QRSPECS^ISIJLS2C(1,.ERRMSG) ; validates specs & DEFINES (Initializes) SCAN VARIABLES
. I ERRMSG]"" S REPLY="0^1~Problem with Query List compile ("_ERRMSG_")"
. E D
. . D NOW^%DTC S SCANSTRT=% S ^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION)=SCANSTRT_U_FULLSCAN_U_QDATFR_U_QDATTO
. . S ABORT=0,RECCOUNT=0,RSLLIMIT=+$P($G(^MAG(2006.69,1,"ISI")),U,3)
. . I FULLSCAN D QRSCAN ; run the FULL scan
. . E D QRSCANP ; scan Prior results
. . I ABORT S ^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"ABORT")=" <<<<<<<< Query aborted after scanning "_RSLLIMIT_" exams. >>>>>>>> " ;
E S REPLY="0^1~No Query defined"
I REPLY="" S REPLY="0^1~No results found for Query list."
Q
;
QRSCAN ; scan the db--Full scan
N DATTEST,DFNPC,DTIPC,SSTEST,SCANIDX
S SCANIDX=1
I $D(MAGJOB("DIVSCRN")),($G(^ISINDX(70,"SIT"))=1) S SCANIDX=2
; Scan thru primary date index to process records for input date range
I SCANIDX=1 D
. S IDXFIL=$NA(^RADPT("AR")) ; radpt DATE index: NORML-DT/DFN/DTI
. S DATTEST=2 ; subscript comma-piece for testing date range
. S SSTEST=1 ; #subscripts holding scan variable root
. S DFNPC=3,DTIPC=4 ; $p locs for dfn & dti
. D QRSCAN1
E I SCANIDX=2 D
. ; radpt Site, Date index: SITE/NORML-DT/DFN/DTI
. S DATTEST=4 ; subscript comma-piece for testing date range
. S SSTEST=3 ; #subscripts holding scan variable root
. S DFNPC=5,DTIPC=6 ; $p locs for dfn & dti
. N SITE S SITE=0
. F S SITE=$O(MAGJOB("DIVSCRN",SITE)) Q:'SITE S IDXFIL=$NA(^ISINDX(70,"SIT",SITE)) D QRSCAN1 Q:ABORT
Q
;
QRSCAN1 ;
N STOP
S SCAN=$NA(@IDXFIL@(QDATFR)),STOP=0
F S SCAN=$Q(@SCAN) Q:SCAN="" D Q:STOP Q:ABORT
. I IDXFIL'[($P(SCAN,COMMA,1,SSTEST)_")") S STOP=1 Q ; end of index
. S EXAMDAT=$P(SCAN,COMMA,DATTEST) I EXAMDAT>QDATTO S STOP=1 Q ; passed to-date
. S RADFN=$P(SCAN,COMMA,DFNPC),RADTI=+$P(SCAN,COMMA,DTIPC),RACNI=0 D QREXAMS ; racni=0 important for logic below
Q
;
QRSCANP ; Scan thru prior result records
S IDXFIL=$NA(^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"RSL")),IDX=""
F S IDX=$O(@IDXFIL@(IDX)) Q:IDX="" S X=^(IDX) D
. S RADFN=$P(X,U),RADTI=$P(X,U,2),RACNI=$P(X,U,3),EXAMDAT=9999999.9999-RADTI D QREXAMS ; ditto value of racni
Q
;
QREXAMS ; process all exams this pt/dt
; "high-level" filtering performed below, for efficiency of DB scan
; any tested condition that fails sets NOGO to 1 --> skip record
; otherwise call normal list processing to check any other
; criteria and process for output
S NOGO=0
S RADATA=$G(^RADPT(RADFN,"DT",RADTI,0)) I RADATA]"" D Q:NOGO
. I $G(MAGJOB("CONSOLIDATED")) D Q:NOGO
. . S X=$P(RADATA,U,3)
. . I X]"",'$D(MAGJOB("DIVSCRN",X)) S NOGO=1 Q ; Screen for allowed Divisions for user
. I 'QIMGTYP ; any img type OK
. E I '$D(QIMGTYP($P(RADATA,U,2))) S NOGO=1 Q
. I 'QIMGLOC ; any img loc OK
. E I '$D(QIMGLOC($P(RADATA,U,4))) S NOGO=1 Q
;
S PTDATA=$G(^DPT(RADFN,0)) I PTDATA]"" D Q:NOGO
. I 'QPTNAME
. E S NOGO=1 D Q:NOGO
. . ; this loop checks possible multiple input names & sets nogo = zero if get a match
. . ; X array has name from patient file; Y array has input name query values
. . N C,I,J,L,NAMTST,X,Y,OK S C=","
. . S X=$P(PTDATA,U,1),X=$$NAMEFMT(X)
. . F I=1:1:$L(X,C) S X(I)=$P(X,C,I)
. . F J=1:1:$G(PTNAME(0)) S NAMTST=PTNAME(J) D Q:'NOGO
. . . K Y F I=1:1:$L(NAMTST,C) S Y(I)=$P(NAMTST,C,I)
. . . S OK=0 F I=1:1:$L(NAMTST,C) S:(Y(I)]"") L=$L(Y(I))+1,OK=OK+(L=$F(X(I),Y(I))) S:(Y(I)="") OK=OK+1 Q:'(OK=I)
. . . I OK=I S NOGO=0 Q ; this one matches!
. I 'QSEX
. E S NOGO='($P(PTDATA,U,2)=SEX) Q:NOGO
. I 'QAGE
. E D Q:NOGO
. . N PTAGE
. . S X1=EXAMDAT,X2=$P(PTDATA,U,3)
. . I X1<X2 S X1=X2,X2=EXAMDAT
. . S PTAGE=$$AGECALC(X2,X1)
. . I '(AGE1'>PTAGE&(AGE2'<PTAGE)) S NOGO=1 Q
;
I RACNI D QREXAMS2(RACNI) Q ; single exam from re-scan
S RACNI=0 ; Full scan loops thru all exams for this pt/date
F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI D QREXAMS2(RACNI)
Q
QREXAMS2(RACNI) ; process one exam
S RADATA=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),ASSNDATA=$G(^("ISI"))
I RADATA="" Q ; should never occur...
S NOGO=0
I 'QSTATUS ; any status OK
E D Q:NOGO
. S STS=$P(RADATA,U,3) I STS]"" D Q:NOGO
. . S X=$$STATUS^ISIJLS1(STS)
. . I X=0 S NOGO=1 Q ; ignore Cancelled
. . I X="" S NOGO=1 Q ; ignore indeterminate (should never happen)
. . E I '$D(STATTEST(X)) S NOGO=1 Q
I 'QRIST ; any rist OK
E D Q:NOGO
. S NOGO=1 N RISTISME,RISTDEF S RISTISME=0,RISTDEF=0
. F I=12,15 S X=$P(RADATA,U,I) S:'RISTDEF RISTDEF=+X I X=DUZ S RISTISME=1
. I RISTCHK=1,RISTISME S NOGO=0 Q ; rist is me desired condition
. I 'RISTCHK,'RISTISME,RISTDEF S NOGO=0 Q ; rist is NOT me desired condition
. I RISTCHK=-1,'RISTDEF S NOGO=0 Q ; rist not entered desired condition
I 'QASSN ; any assigned OK
E D Q:NOGO
. S NOGO=1 N ASSNISME,ASSNDEF S ASSNISME=0,ASSNDEF=0
. S X=$P(ASSNDATA,U,1) S ASSNDEF=+X I X=DUZ S ASSNISME=1
. I ASSNCHK=2,ASSNDEF S NOGO=0 Q ; assigned to Anyone desired condition
. I ASSNCHK=1,ASSNISME S NOGO=0 Q ; assigned to me desired condition
. I 'ASSNCHK,'ASSNISME,ASSNDEF S NOGO=0 Q ; assigned to NOT me desired condition
. I ASSNCHK=-1,'ASSNDEF S NOGO=0 Q ; assigned to not entered desired condition
;
; "high-level" filtering ends here; continue to exam list subsystem
;
D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET)
I MAGRET K RAST,STATCHK D SVMAG2A^MAGJLS3() ; --> Kill cmd impt for this call
I RSLLIMIT,FULLSCAN S RECCOUNT=RECCOUNT+1 I RECCOUNT>RSLLIMIT S ABORT=1
Q
;
SETVARS(DIS,MDCVAR,LSTHDR,MDLVAR) ; selection logic & column data modify
; *** called from magjls2b ***
; define search terms stuff for use in list selection logic (magjls2b)
N QRCOLS,SPECFLDS,QRMD
I $D(^XTMP("MAGJ2","ISIQUERY",DUZ,MAGJOB("SESSION"),"SPECQRMD")) D ; defined by qrspecs subrtn
. M QRMD=^XTMP("MAGJ2","ISIQUERY",DUZ,MAGJOB("SESSION"),"SPECQRMD")
. K DIS,MDCVAR S DIS(0)=1,I="" ; selection logic defined in the query form inserted here
. F S I=$O(QRMD(I)) Q:I="" S MDCVAR(+QRMD(I))="",DIS(1)=$G(DIS(1))_$P(QRMD(I),U,2,99)
; update column data if needed--appends to end of defined list
S I="" F S I=$O(^XTMP("MAGJ2","ISIQUERY",DUZ,MAGJOB("SESSION"),"SPECFLDS",I)) Q:I="" S SPECFLDS(I)=""
F I=1:1:$L(LSTHDR,U) S T=$P(LSTHDR,U,I),T=$P(T,"~",3) K SPECFLDS(T) ; add what remains to lsthdr
I $D(SPECFLDS) D
. N FLD,HDR,ORD,TYP
. S FLD=""
. F S FLD=$O(SPECFLDS(FLD)) Q:FLD="" D
. . S X=$G(^MAG(2006.63,FLD,0))
. . S ORD=$P(X,U,6),TYP=$P(X,U,8) S:'ORD ORD=999_"."_FLD ; assure is unique
. . S HDR=$P(X,U,3) I HDR="" S HDR=$P(X,U,2)
. . S QRCOLS(ORD,FLD)=HDR_U_TYP ; sort by relative column order
. S T="QRCOLS" F S T=$Q(@T) Q:T="" D
. . S FLD=+$P(T,",",2),X=@T,HDR=$P(X,U),TYP=$P(X,U,2)
. . S LSTHDR=LSTHDR_U_HDR_"~"_TYP_"~"_FLD,MDLVAR=MDLVAR_U_FLD
Q
;
QRYGET(FULLSCAN,QUERY) ; Dynamic query find & return query specs
; Returns:
; -- fullscan TRUE if no scan results exist in this session
; -- query TRUE if query specs are defined for this session
;
N SESSION S SESSION=MAGJOB("SESSION")
S FULLSCAN=1,QUERY=0
I $D(^XTMP("MAGJ2","ISIQUERY",DUZ)) D
. I '$D(^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION)) K ^XTMP("MAGJ2","ISIQUERY",DUZ) Q ; clean up old queries, if any
. I $D(^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"RSL")) S FULLSCAN=0 ; recycle prior processing from this session
. I $D(^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"SPECS")) S QUERY=1 ; recycle query specs from this session
. I FULLSCAN K ^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"ABORT")
Q
;
QRYLOG ; Log queries run; * * * called by magjls2 * * *
; --> possible future enh--create index(es) optimized for the types
; of queries that are often run, based on evaluating this log
;
N SCANEND,NSCANFUL,NSCANRE,SCANTERM,NSEC,NDAYSOFF,NDAYBAKS,NDAYSTOT
N FULL,NRESULTS,SCANREC,SESSTR,VARSTR,THISDATE
N FULLSCAN,ISCAN,LOGFILE,QDATFR,QDATTO,SESSION,SCANSTRT,STATREC
S NRESULTS=0,SCANREC="",SCANTERM="",SESSION=MAGJOB("SESSION"),LOGFILE=23450
S X=^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION)
S SCANSTRT=$P(X,U,1),FULLSCAN=$P(X,U,2),QDATFR=$P(X,U,3),QDATTO=$P(X,U,4)
D NOW^%DTC S SCANEND=%,THISDATE=X
D QRYLOG2(.STATREC,.ISCAN) ; get stat record iens
S SESSTR=^ISI(LOGFILE,STATREC,0)
S T=$S(FULLSCAN:3,1:4)
S X=+$P(SESSTR,U,T)+1,$P(SESSTR,U,T)=X
S ^ISI(LOGFILE,STATREC,0)=SESSTR
S FULL=$S(FULLSCAN:"Y",1:"N")
S NSEC=$$TDELTA(SCANSTRT,SCANEND,"SEC")
S X="" F S X=$O(^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"SPECFLDS",X)) Q:X="" D
. S SCANTERM=SCANTERM_$S(SCANTERM="":"",1:",")_X
S X="" F S X=$O(^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"RSLSTAT",X)) Q:X="" S N=^(X) D
. S T=$F("WEIC~",X) S:T $P(SCANREC,U,T+6)=N ; counts by exam status
. S NRESULTS=NRESULTS+N
S NDAYSOFF=$$TDELTA(QDATTO,SCANEND,"")
S NDAYBAKS=$$TDELTA(QDATFR,SCANEND,"")
S NDAYSTOT=$$TDELTA(QDATFR,QDATTO,"")
S VARSTR="SCANTERM,FULL,NSEC,NDAYSOFF,NDAYBAKS,NDAYSTOT,NRESULTS"
F I=1:1:$L(VARSTR,",") S X=$P(VARSTR,",",I),$P(SCANREC,U,I)=@X
S ^ISI(LOGFILE,STATREC,1,ISCAN,0)=SCANREC
Q
;
QRYLOG2(STATREC,ISCAN) ; init &/or return statistics record references
N IEN,T,X
S IEN=$O(^ISI(LOGFILE,"B",SESSION,""))
I 'IEN S IEN=$$NEWLOG(SESSION)
S STATREC=IEN
L +^ISI(LOGFILE,STATREC,1,0):10
S X=$G(^ISI(LOGFILE,STATREC,1,0)),T=$P(X,U,3)+1,IEN=$P(X,U,4)+1,$P(X,U,3)=T,$P(X,U,4)=IEN,$P(X,U,2)="23450.04A",^(0)=X
S ^ISI(LOGFILE,STATREC,1,IEN,0)=""
L -^ISI(LOGFILE,STATREC,1,0)
S ISCAN=IEN
Q
;;
NEWLOG(SESSION) ; Create new entry in Stats file; only called if not yet defined
N ZJ,RSL
S ZJ(LOGFILE,"+1,",.01)=SESSION
S ZJ(LOGFILE,"+1,",1)=DUZ
S ZJ(LOGFILE,"+1,",5)=THISDATE
D UPDATE^DIE("","ZJ","RSL")
Q:$Q RSL(1) Q
;
AGECALC(DT1,DT2) ; return age given 2 dates; up to 2 yrs returns decimal rsl
N AGE
S AGE=$J($$FMDIFF^XLFDT(DT2,DT1)/365.25,0,3)
I AGE<2 I AGE'>1.999 S AGE=$E(AGE,1,3)
E S AGE=AGE\1
Q:$Q AGE Q
;
NAMEFMT(X) ; normalize name text
N I
S X=$$UPCASE(X)
F I=1:1:$L(X,",") S $P(X,",",I)=$$STRIP($P(X,",",I))
Q:$Q X Q
;
STRIP(X) ; remove up-carets, extraneous spaces
N I,T
S X=$TR(X,U," ")
F I=$L(X):-1:0 I $E(X,I)'=" " Q
S X=$E(X,1,I)
F I=1:1:$L(X) I $E(X,I)'=" " Q
S X=$E(X,I,999)
F S T=$F(X," ") Q:'T S X=$E(X,1,T-2)_$E(X,T,999)
; strip spaces around hyphen:
F S T=$F(X," -") Q:'T S X=$E(X,1,T-3)_$E(X,T-1,999)
F S T=$F(X,"- ") Q:'T S X=$E(X,1,T-2)_$E(X,T,999)
Q:$Q X Q
;
UPCASE(X) ; cx to uppercase
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
;
TDELTA(T1,T2,SCALE) ; calc time delta in $s(scale="SEC": seconds, 1: days)
N RSL,NDAY,NSEC,H1,H2,TT1,TT2
S RSL=""
S X=T1 D H^%DTC S TT1=%T,H1=%H
S X=T2 D H^%DTC S TT2=%T,H2=%H
S NDAY=H2-H1
I NDAY S TT2=TT2+(NDAY*86400)
S NSEC=TT2-TT1
S RSL=$S(SCALE="SEC":NSEC,1:NDAY+1)
Q:$Q RSL Q
;
QRYRPC(MAGGRY,PARAMS,DATA) ; ISIJ DYNAMIC QUERY -- RPC ep
; 1 = Create/Edit query (populate gui form: either new in session, or edit existing query)
; 3 = Clear session query (populate gui form)
; 2 = Validate query--validate, translate & store the specs (only if OK); else error msg
N $ETRAP,$ESTACK S $ETRAP="G ERR^ISIJLS2"
S DIQUIET=1 D DT^DICRW
N ERRMSG,MAGLST,REPLY,SESSION
S ERRMSG="",SESSION=MAGJOB("SESSION")
S MAGLST="ISIJQRY"
K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY
I PARAMS=3 K ^XTMP("MAGJ2","ISIQUERY",DUZ) ; Clears prior query in this session
I S @MAGGRY@(0)="0^0~OK"
I PARAMS=1 D
. D FORMOUT^ISIJLS2B(.REPLY)
. I ($G(REPLY(0,1))["<DIALOG name=") S T=$$Q^ISINUQRY($NA(REPLY("")),-1) I @T["</DIALOG>" ; test for completed xml def
. I D
. . N IOUT S IOUT=$NA(REPLY)
. . F I=1:1 S IOUT=$Q(@IOUT) Q:IOUT="" S @MAGGRY@(I)=@(IOUT)
. . S @MAGGRY@(0)=I-1_U_"0~OK"
. E S @MAGGRY@(0)="0^3~Problem with Query dialog create function--contact support"
I PARAMS=2 D
. I $D(DATA)<10 S ERRMSG="Invalid Query specification."
. E D QRSPECS^ISIJLS2C(0,.ERRMSG,.DATA)
. I $G(ERRMSG)]"" S @MAGGRY@(0)="0^3~"_ERRMSG
. E S @MAGGRY@(0)="0^0~OK"
Q
;
SX70SIT(X,DA) ;Set Query Site index for RAD/NUC MED PATIENT file
;DA(1)=DFN, DA=EXAM DATE (inverse date)
;X(1)=SITE Ien
N DATE
S DATE=9999999.9999-DA
S ^ISINDX(70,"SIT",X(1),DATE,DA(1),DA)="" ; Site, Date-Ext, DFN, DTI
Q
;
KX70SIT(X,DA) ;Delete Query Site index for RAD/NUC MED PATIENT file
N DATE
S DATE=9999999.9999-DA
K ^ISINDX(70,"SIT",X(1),DATE,DA(1),DA)
Q
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HISIJLS2 14215 printed Apr 09, 2024@21:46:32 Page 2
ISIJLS2 ; ISI/JHC - ISIRAD exam list functions ; 10/17/2022
+1 ;;1.1;ESL ISI IMAGING;**99,105,107,110**;Dec 21, 2022;Build 41
+2 ;; This routine is the property of ViTel Net, and should not be modified.
+3 ;; This software is a medical device and is subject to FDA regulation.
+4 ;; Modifications to this software may only be made under the terms of
+5 ;; 21CFR820 regulation. 21CFR Subpart A 820.1: "The failure to comply
+6 ;; with any applicable provision in this part renders a device
+7 ;; adulterated under section 501(h) of the act. Such a device,
+8 ;; as well as any person responsible for the failure to comply,
+9 ;; is subject to regulatory action."
+10 ; Reference to SVMAG2A^MAGJLS3 in ICR #7403
+11 ; Reference to GETEXAM2^MAGJUTL1 in ICR #7404
+12 ; Reference to File #2006.63 in ICR #7408
+13 ; Reference to File #2006.69 in ICR #7410
+14 QUIT
+15 ;
ERR NEW ERR
SET ERR=$$EC^%ZOSV
SET ^TMP($JOB,"RET",0)="0^4~"_ERR
+1 SET MAGGRY=$NAME(^TMP($JOB,"RET"))
+2 DO @^%ZOSF("ERRTN")
+3 if $QUIT
QUIT 1
QUIT
+4 ;
+5 ; entry point for Dynamic Query list compile; this is
+6 ; a List Type "I" list, so is called indirect from INDXBLD^ISIJLS1,
+7 ; as defined in the exams list entry for Dynamic Query, #9820
+8 ;
QRYCOMP(REPLY) ; Compile dynamic query lists
+1 NEW FULLSCAN,QAGE,QDATFR,QDATTO,QIMGTYP,QRIST,QSEX,QPTNAME,QSTATUS,QUERY,QNIMG,QASSN
+2 NEW QIMGLOC
+3 NEW AGE1,AGE2,COMMA,ERRMSG,DATTEST,IDX,IDXFIL,MAGRET,NOGO,NIMG1,NIMG2,NIMGSPEC
+4 NEW PTDATA,PTNAME,RADATA,RADFN,RADTI,RACNI,RISTCHK,SCAN,SESSION,SEX,STS,STATTEST
+5 NEW SCANSTRT,EXAMDAT,ABORT,RECCOUNT,RSLLIMIT,ASSNCHK,ASSNDATA
+6 SET COMMA=","
SET SESSION=MAGJOB("SESSION")
SET ERRMSG=""
+7 SET REPLY=""
+8 ; get query info
DO QRYGET(.FULLSCAN,.QUERY)
+9 IF QUERY
Begin DoDot:1
+10 ; validates specs & DEFINES (Initializes) SCAN VARIABLES
DO QRSPECS^ISIJLS2C(1,.ERRMSG)
+11 IF ERRMSG]""
SET REPLY="0^1~Problem with Query List compile ("_ERRMSG_")"
+12 IF '$TEST
Begin DoDot:2
+13 DO NOW^%DTC
SET SCANSTRT=%
SET ^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION)=SCANSTRT_U_FULLSCAN_U_QDATFR_U_QDATTO
+14 SET ABORT=0
SET RECCOUNT=0
SET RSLLIMIT=+$PIECE($GET(^MAG(2006.69,1,"ISI")),U,3)
+15 ; run the FULL scan
IF FULLSCAN
DO QRSCAN
+16 ; scan Prior results
IF '$TEST
DO QRSCANP
+17 ;
IF ABORT
SET ^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"ABORT")=" <<<<<<<< Query aborted after scanning "_RSLLIMIT_" exams. >>>>>>>> "
End DoDot:2
End DoDot:1
+18 IF '$TEST
SET REPLY="0^1~No Query defined"
+19 IF REPLY=""
SET REPLY="0^1~No results found for Query list."
+20 QUIT
+21 ;
QRSCAN ; scan the db--Full scan
+1 NEW DATTEST,DFNPC,DTIPC,SSTEST,SCANIDX
+2 SET SCANIDX=1
+3 IF $DATA(MAGJOB("DIVSCRN"))
IF ($GET(^ISINDX(70,"SIT"))=1)
SET SCANIDX=2
+4 ; Scan thru primary date index to process records for input date range
+5 IF SCANIDX=1
Begin DoDot:1
+6 ; radpt DATE index: NORML-DT/DFN/DTI
SET IDXFIL=$NAME(^RADPT("AR"))
+7 ; subscript comma-piece for testing date range
SET DATTEST=2
+8 ; #subscripts holding scan variable root
SET SSTEST=1
+9 ; $p locs for dfn & dti
SET DFNPC=3
SET DTIPC=4
+10 DO QRSCAN1
End DoDot:1
+11 IF '$TEST
IF SCANIDX=2
Begin DoDot:1
+12 ; radpt Site, Date index: SITE/NORML-DT/DFN/DTI
+13 ; subscript comma-piece for testing date range
SET DATTEST=4
+14 ; #subscripts holding scan variable root
SET SSTEST=3
+15 ; $p locs for dfn & dti
SET DFNPC=5
SET DTIPC=6
+16 NEW SITE
SET SITE=0
+17 FOR
SET SITE=$ORDER(MAGJOB("DIVSCRN",SITE))
if 'SITE
QUIT
SET IDXFIL=$NAME(^ISINDX(70,"SIT",SITE))
DO QRSCAN1
if ABORT
QUIT
End DoDot:1
+18 QUIT
+19 ;
QRSCAN1 ;
+1 NEW STOP
+2 SET SCAN=$NAME(@IDXFIL@(QDATFR))
SET STOP=0
+3 FOR
SET SCAN=$QUERY(@SCAN)
if SCAN=""
QUIT
Begin DoDot:1
+4 ; end of index
IF IDXFIL'[($PIECE(SCAN,COMMA,1,SSTEST)_")")
SET STOP=1
QUIT
+5 ; passed to-date
SET EXAMDAT=$PIECE(SCAN,COMMA,DATTEST)
IF EXAMDAT>QDATTO
SET STOP=1
QUIT
+6 ; racni=0 important for logic below
SET RADFN=$PIECE(SCAN,COMMA,DFNPC)
SET RADTI=+$PIECE(SCAN,COMMA,DTIPC)
SET RACNI=0
DO QREXAMS
End DoDot:1
if STOP
QUIT
if ABORT
QUIT
+7 QUIT
+8 ;
QRSCANP ; Scan thru prior result records
+1 SET IDXFIL=$NAME(^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"RSL"))
SET IDX=""
+2 FOR
SET IDX=$ORDER(@IDXFIL@(IDX))
if IDX=""
QUIT
SET X=^(IDX)
Begin DoDot:1
+3 ; ditto value of racni
SET RADFN=$PIECE(X,U)
SET RADTI=$PIECE(X,U,2)
SET RACNI=$PIECE(X,U,3)
SET EXAMDAT=9999999.9999-RADTI
DO QREXAMS
End DoDot:1
+4 QUIT
+5 ;
QREXAMS ; process all exams this pt/dt
+1 ; "high-level" filtering performed below, for efficiency of DB scan
+2 ; any tested condition that fails sets NOGO to 1 --> skip record
+3 ; otherwise call normal list processing to check any other
+4 ; criteria and process for output
+5 SET NOGO=0
+6 SET RADATA=$GET(^RADPT(RADFN,"DT",RADTI,0))
IF RADATA]""
Begin DoDot:1
+7 IF $GET(MAGJOB("CONSOLIDATED"))
Begin DoDot:2
+8 SET X=$PIECE(RADATA,U,3)
+9 ; Screen for allowed Divisions for user
IF X]""
IF '$DATA(MAGJOB("DIVSCRN",X))
SET NOGO=1
QUIT
End DoDot:2
if NOGO
QUIT
+10 ; any img type OK
IF 'QIMGTYP
+11 IF '$TEST
IF '$DATA(QIMGTYP($PIECE(RADATA,U,2)))
SET NOGO=1
QUIT
+12 ; any img loc OK
IF 'QIMGLOC
+13 IF '$TEST
IF '$DATA(QIMGLOC($PIECE(RADATA,U,4)))
SET NOGO=1
QUIT
End DoDot:1
if NOGO
QUIT
+14 ;
+15 SET PTDATA=$GET(^DPT(RADFN,0))
IF PTDATA]""
Begin DoDot:1
+16 IF 'QPTNAME
+17 IF '$TEST
SET NOGO=1
Begin DoDot:2
+18 ; this loop checks possible multiple input names & sets nogo = zero if get a match
+19 ; X array has name from patient file; Y array has input name query values
+20 NEW C,I,J,L,NAMTST,X,Y,OK
SET C=","
+21 SET X=$PIECE(PTDATA,U,1)
SET X=$$NAMEFMT(X)
+22 FOR I=1:1:$LENGTH(X,C)
SET X(I)=$PIECE(X,C,I)
+23 FOR J=1:1:$GET(PTNAME(0))
SET NAMTST=PTNAME(J)
Begin DoDot:3
+24 KILL Y
FOR I=1:1:$LENGTH(NAMTST,C)
SET Y(I)=$PIECE(NAMTST,C,I)
+25 SET OK=0
FOR I=1:1:$LENGTH(NAMTST,C)
if (Y(I)]"")
SET L=$LENGTH(Y(I))+1
SET OK=OK+(L=$FIND(X(I),Y(I)))
if (Y(I)="")
SET OK=OK+1
if '(OK=I)
QUIT
+26 ; this one matches!
IF OK=I
SET NOGO=0
QUIT
End DoDot:3
if 'NOGO
QUIT
End DoDot:2
if NOGO
QUIT
+27 IF 'QSEX
+28 IF '$TEST
SET NOGO='($PIECE(PTDATA,U,2)=SEX)
if NOGO
QUIT
+29 IF 'QAGE
+30 IF '$TEST
Begin DoDot:2
+31 NEW PTAGE
+32 SET X1=EXAMDAT
SET X2=$PIECE(PTDATA,U,3)
+33 IF X1<X2
SET X1=X2
SET X2=EXAMDAT
+34 SET PTAGE=$$AGECALC(X2,X1)
+35 IF '(AGE1'>PTAGE&(AGE2'<PTAGE))
SET NOGO=1
QUIT
End DoDot:2
if NOGO
QUIT
End DoDot:1
if NOGO
QUIT
+36 ;
+37 ; single exam from re-scan
IF RACNI
DO QREXAMS2(RACNI)
QUIT
+38 ; Full scan loops thru all exams for this pt/date
SET RACNI=0
+39 FOR
SET RACNI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI))
if 'RACNI
QUIT
DO QREXAMS2(RACNI)
+40 QUIT
QREXAMS2(RACNI) ; process one exam
+1 SET RADATA=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
SET ASSNDATA=$GET(^("ISI"))
+2 ; should never occur...
IF RADATA=""
QUIT
+3 SET NOGO=0
+4 ; any status OK
IF 'QSTATUS
+5 IF '$TEST
Begin DoDot:1
+6 SET STS=$PIECE(RADATA,U,3)
IF STS]""
Begin DoDot:2
+7 SET X=$$STATUS^ISIJLS1(STS)
+8 ; ignore Cancelled
IF X=0
SET NOGO=1
QUIT
+9 ; ignore indeterminate (should never happen)
IF X=""
SET NOGO=1
QUIT
+10 IF '$TEST
IF '$DATA(STATTEST(X))
SET NOGO=1
QUIT
End DoDot:2
if NOGO
QUIT
End DoDot:1
if NOGO
QUIT
+11 ; any rist OK
IF 'QRIST
+12 IF '$TEST
Begin DoDot:1
+13 SET NOGO=1
NEW RISTISME,RISTDEF
SET RISTISME=0
SET RISTDEF=0
+14 FOR I=12,15
SET X=$PIECE(RADATA,U,I)
if 'RISTDEF
SET RISTDEF=+X
IF X=DUZ
SET RISTISME=1
+15 ; rist is me desired condition
IF RISTCHK=1
IF RISTISME
SET NOGO=0
QUIT
+16 ; rist is NOT me desired condition
IF 'RISTCHK
IF 'RISTISME
IF RISTDEF
SET NOGO=0
QUIT
+17 ; rist not entered desired condition
IF RISTCHK=-1
IF 'RISTDEF
SET NOGO=0
QUIT
End DoDot:1
if NOGO
QUIT
+18 ; any assigned OK
IF 'QASSN
+19 IF '$TEST
Begin DoDot:1
+20 SET NOGO=1
NEW ASSNISME,ASSNDEF
SET ASSNISME=0
SET ASSNDEF=0
+21 SET X=$PIECE(ASSNDATA,U,1)
SET ASSNDEF=+X
IF X=DUZ
SET ASSNISME=1
+22 ; assigned to Anyone desired condition
IF ASSNCHK=2
IF ASSNDEF
SET NOGO=0
QUIT
+23 ; assigned to me desired condition
IF ASSNCHK=1
IF ASSNISME
SET NOGO=0
QUIT
+24 ; assigned to NOT me desired condition
IF 'ASSNCHK
IF 'ASSNISME
IF ASSNDEF
SET NOGO=0
QUIT
+25 ; assigned to not entered desired condition
IF ASSNCHK=-1
IF 'ASSNDEF
SET NOGO=0
QUIT
End DoDot:1
if NOGO
QUIT
+26 ;
+27 ; "high-level" filtering ends here; continue to exam list subsystem
+28 ;
+29 DO GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET)
+30 ; --> Kill cmd impt for this call
IF MAGRET
KILL RAST,STATCHK
DO SVMAG2A^MAGJLS3()
+31 IF RSLLIMIT
IF FULLSCAN
SET RECCOUNT=RECCOUNT+1
IF RECCOUNT>RSLLIMIT
SET ABORT=1
+32 QUIT
+33 ;
SETVARS(DIS,MDCVAR,LSTHDR,MDLVAR) ; selection logic & column data modify
+1 ; *** called from magjls2b ***
+2 ; define search terms stuff for use in list selection logic (magjls2b)
+3 NEW QRCOLS,SPECFLDS,QRMD
+4 ; defined by qrspecs subrtn
IF $DATA(^XTMP("MAGJ2","ISIQUERY",DUZ,MAGJOB("SESSION"),"SPECQRMD"))
Begin DoDot:1
+5 MERGE QRMD=^XTMP("MAGJ2","ISIQUERY",DUZ,MAGJOB("SESSION"),"SPECQRMD")
+6 ; selection logic defined in the query form inserted here
KILL DIS,MDCVAR
SET DIS(0)=1
SET I=""
+7 FOR
SET I=$ORDER(QRMD(I))
if I=""
QUIT
SET MDCVAR(+QRMD(I))=""
SET DIS(1)=$GET(DIS(1))_$PIECE(QRMD(I),U,2,99)
End DoDot:1
+8 ; update column data if needed--appends to end of defined list
+9 SET I=""
FOR
SET I=$ORDER(^XTMP("MAGJ2","ISIQUERY",DUZ,MAGJOB("SESSION"),"SPECFLDS",I))
if I=""
QUIT
SET SPECFLDS(I)=""
+10 ; add what remains to lsthdr
FOR I=1:1:$LENGTH(LSTHDR,U)
SET T=$PIECE(LSTHDR,U,I)
SET T=$PIECE(T,"~",3)
KILL SPECFLDS(T)
+11 IF $DATA(SPECFLDS)
Begin DoDot:1
+12 NEW FLD,HDR,ORD,TYP
+13 SET FLD=""
+14 FOR
SET FLD=$ORDER(SPECFLDS(FLD))
if FLD=""
QUIT
Begin DoDot:2
+15 SET X=$GET(^MAG(2006.63,FLD,0))
+16 ; assure is unique
SET ORD=$PIECE(X,U,6)
SET TYP=$PIECE(X,U,8)
if 'ORD
SET ORD=999_"."_FLD
+17 SET HDR=$PIECE(X,U,3)
IF HDR=""
SET HDR=$PIECE(X,U,2)
+18 ; sort by relative column order
SET QRCOLS(ORD,FLD)=HDR_U_TYP
End DoDot:2
+19 SET T="QRCOLS"
FOR
SET T=$QUERY(@T)
if T=""
QUIT
Begin DoDot:2
+20 SET FLD=+$PIECE(T,",",2)
SET X=@T
SET HDR=$PIECE(X,U)
SET TYP=$PIECE(X,U,2)
+21 SET LSTHDR=LSTHDR_U_HDR_"~"_TYP_"~"_FLD
SET MDLVAR=MDLVAR_U_FLD
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
QRYGET(FULLSCAN,QUERY) ; Dynamic query find & return query specs
+1 ; Returns:
+2 ; -- fullscan TRUE if no scan results exist in this session
+3 ; -- query TRUE if query specs are defined for this session
+4 ;
+5 NEW SESSION
SET SESSION=MAGJOB("SESSION")
+6 SET FULLSCAN=1
SET QUERY=0
+7 IF $DATA(^XTMP("MAGJ2","ISIQUERY",DUZ))
Begin DoDot:1
+8 ; clean up old queries, if any
IF '$DATA(^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION))
KILL ^XTMP("MAGJ2","ISIQUERY",DUZ)
QUIT
+9 ; recycle prior processing from this session
IF $DATA(^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"RSL"))
SET FULLSCAN=0
+10 ; recycle query specs from this session
IF $DATA(^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"SPECS"))
SET QUERY=1
+11 IF FULLSCAN
KILL ^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"ABORT")
End DoDot:1
+12 QUIT
+13 ;
QRYLOG ; Log queries run; * * * called by magjls2 * * *
+1 ; --> possible future enh--create index(es) optimized for the types
+2 ; of queries that are often run, based on evaluating this log
+3 ;
+4 NEW SCANEND,NSCANFUL,NSCANRE,SCANTERM,NSEC,NDAYSOFF,NDAYBAKS,NDAYSTOT
+5 NEW FULL,NRESULTS,SCANREC,SESSTR,VARSTR,THISDATE
+6 NEW FULLSCAN,ISCAN,LOGFILE,QDATFR,QDATTO,SESSION,SCANSTRT,STATREC
+7 SET NRESULTS=0
SET SCANREC=""
SET SCANTERM=""
SET SESSION=MAGJOB("SESSION")
SET LOGFILE=23450
+8 SET X=^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION)
+9 SET SCANSTRT=$PIECE(X,U,1)
SET FULLSCAN=$PIECE(X,U,2)
SET QDATFR=$PIECE(X,U,3)
SET QDATTO=$PIECE(X,U,4)
+10 DO NOW^%DTC
SET SCANEND=%
SET THISDATE=X
+11 ; get stat record iens
DO QRYLOG2(.STATREC,.ISCAN)
+12 SET SESSTR=^ISI(LOGFILE,STATREC,0)
+13 SET T=$SELECT(FULLSCAN:3,1:4)
+14 SET X=+$PIECE(SESSTR,U,T)+1
SET $PIECE(SESSTR,U,T)=X
+15 SET ^ISI(LOGFILE,STATREC,0)=SESSTR
+16 SET FULL=$SELECT(FULLSCAN:"Y",1:"N")
+17 SET NSEC=$$TDELTA(SCANSTRT,SCANEND,"SEC")
+18 SET X=""
FOR
SET X=$ORDER(^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"SPECFLDS",X))
if X=""
QUIT
Begin DoDot:1
+19 SET SCANTERM=SCANTERM_$SELECT(SCANTERM="":"",1:",")_X
End DoDot:1
+20 SET X=""
FOR
SET X=$ORDER(^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"RSLSTAT",X))
if X=""
QUIT
SET N=^(X)
Begin DoDot:1
+21 ; counts by exam status
SET T=$FIND("WEIC~",X)
if T
SET $PIECE(SCANREC,U,T+6)=N
+22 SET NRESULTS=NRESULTS+N
End DoDot:1
+23 SET NDAYSOFF=$$TDELTA(QDATTO,SCANEND,"")
+24 SET NDAYBAKS=$$TDELTA(QDATFR,SCANEND,"")
+25 SET NDAYSTOT=$$TDELTA(QDATFR,QDATTO,"")
+26 SET VARSTR="SCANTERM,FULL,NSEC,NDAYSOFF,NDAYBAKS,NDAYSTOT,NRESULTS"
+27 FOR I=1:1:$LENGTH(VARSTR,",")
SET X=$PIECE(VARSTR,",",I)
SET $PIECE(SCANREC,U,I)=@X
+28 SET ^ISI(LOGFILE,STATREC,1,ISCAN,0)=SCANREC
+29 QUIT
+30 ;
QRYLOG2(STATREC,ISCAN) ; init &/or return statistics record references
+1 NEW IEN,T,X
+2 SET IEN=$ORDER(^ISI(LOGFILE,"B",SESSION,""))
+3 IF 'IEN
SET IEN=$$NEWLOG(SESSION)
+4 SET STATREC=IEN
+5 LOCK +^ISI(LOGFILE,STATREC,1,0):10
+6 SET X=$GET(^ISI(LOGFILE,STATREC,1,0))
SET T=$PIECE(X,U,3)+1
SET IEN=$PIECE(X,U,4)+1
SET $PIECE(X,U,3)=T
SET $PIECE(X,U,4)=IEN
SET $PIECE(X,U,2)="23450.04A"
SET ^(0)=X
+7 SET ^ISI(LOGFILE,STATREC,1,IEN,0)=""
+8 LOCK -^ISI(LOGFILE,STATREC,1,0)
+9 SET ISCAN=IEN
+10 QUIT
+11 ;;
NEWLOG(SESSION) ; Create new entry in Stats file; only called if not yet defined
+1 NEW ZJ,RSL
+2 SET ZJ(LOGFILE,"+1,",.01)=SESSION
+3 SET ZJ(LOGFILE,"+1,",1)=DUZ
+4 SET ZJ(LOGFILE,"+1,",5)=THISDATE
+5 DO UPDATE^DIE("","ZJ","RSL")
+6 if $QUIT
QUIT RSL(1)
QUIT
+7 ;
AGECALC(DT1,DT2) ; return age given 2 dates; up to 2 yrs returns decimal rsl
+1 NEW AGE
+2 SET AGE=$JUSTIFY($$FMDIFF^XLFDT(DT2,DT1)/365.25,0,3)
+3 IF AGE<2
IF AGE'>1.999
SET AGE=$EXTRACT(AGE,1,3)
+4 IF '$TEST
SET AGE=AGE\1
+5 if $QUIT
QUIT AGE
QUIT
+6 ;
NAMEFMT(X) ; normalize name text
+1 NEW I
+2 SET X=$$UPCASE(X)
+3 FOR I=1:1:$LENGTH(X,",")
SET $PIECE(X,",",I)=$$STRIP($PIECE(X,",",I))
+4 if $QUIT
QUIT X
QUIT
+5 ;
STRIP(X) ; remove up-carets, extraneous spaces
+1 NEW I,T
+2 SET X=$TRANSLATE(X,U," ")
+3 FOR I=$LENGTH(X):-1:0
IF $EXTRACT(X,I)'=" "
QUIT
+4 SET X=$EXTRACT(X,1,I)
+5 FOR I=1:1:$LENGTH(X)
IF $EXTRACT(X,I)'=" "
QUIT
+6 SET X=$EXTRACT(X,I,999)
+7 FOR
SET T=$FIND(X," ")
if 'T
QUIT
SET X=$EXTRACT(X,1,T-2)_$EXTRACT(X,T,999)
+8 ; strip spaces around hyphen:
+9 FOR
SET T=$FIND(X," -")
if 'T
QUIT
SET X=$EXTRACT(X,1,T-3)_$EXTRACT(X,T-1,999)
+10 FOR
SET T=$FIND(X,"- ")
if 'T
QUIT
SET X=$EXTRACT(X,1,T-2)_$EXTRACT(X,T,999)
+11 if $QUIT
QUIT X
QUIT
+12 ;
UPCASE(X) ; cx to uppercase
+1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+2 ;
TDELTA(T1,T2,SCALE) ; calc time delta in $s(scale="SEC": seconds, 1: days)
+1 NEW RSL,NDAY,NSEC,H1,H2,TT1,TT2
+2 SET RSL=""
+3 SET X=T1
DO H^%DTC
SET TT1=%T
SET H1=%H
+4 SET X=T2
DO H^%DTC
SET TT2=%T
SET H2=%H
+5 SET NDAY=H2-H1
+6 IF NDAY
SET TT2=TT2+(NDAY*86400)
+7 SET NSEC=TT2-TT1
+8 SET RSL=$SELECT(SCALE="SEC":NSEC,1:NDAY+1)
+9 if $QUIT
QUIT RSL
QUIT
+10 ;
QRYRPC(MAGGRY,PARAMS,DATA) ; ISIJ DYNAMIC QUERY -- RPC ep
+1 ; 1 = Create/Edit query (populate gui form: either new in session, or edit existing query)
+2 ; 3 = Clear session query (populate gui form)
+3 ; 2 = Validate query--validate, translate & store the specs (only if OK); else error msg
+4 NEW $ETRAP,$ESTACK
SET $ETRAP="G ERR^ISIJLS2"
+5 SET DIQUIET=1
DO DT^DICRW
+6 NEW ERRMSG,MAGLST,REPLY,SESSION
+7 SET ERRMSG=""
SET SESSION=MAGJOB("SESSION")
+8 SET MAGLST="ISIJQRY"
+9 KILL MAGGRY
SET MAGGRY=$NAME(^TMP($JOB,MAGLST))
KILL @MAGGRY
+10 ; Clears prior query in this session
IF PARAMS=3
KILL ^XTMP("MAGJ2","ISIQUERY",DUZ)
+11 IF $TEST
SET @MAGGRY@(0)="0^0~OK"
+12 IF PARAMS=1
Begin DoDot:1
+13 DO FORMOUT^ISIJLS2B(.REPLY)
+14 ; test for completed xml def
IF ($GET(REPLY(0,1))["<DIALOG name=")
SET T=$$Q^ISINUQRY($NAME(REPLY("")),-1)
IF @T["</DIALOG>"
+15 IF $TEST
Begin DoDot:2
+16 NEW IOUT
SET IOUT=$NAME(REPLY)
+17 FOR I=1:1
SET IOUT=$QUERY(@IOUT)
if IOUT=""
QUIT
SET @MAGGRY@(I)=@(IOUT)
+18 SET @MAGGRY@(0)=I-1_U_"0~OK"
End DoDot:2
+19 IF '$TEST
SET @MAGGRY@(0)="0^3~Problem with Query dialog create function--contact support"
End DoDot:1
+20 IF PARAMS=2
Begin DoDot:1
+21 IF $DATA(DATA)<10
SET ERRMSG="Invalid Query specification."
+22 IF '$TEST
DO QRSPECS^ISIJLS2C(0,.ERRMSG,.DATA)
+23 IF $GET(ERRMSG)]""
SET @MAGGRY@(0)="0^3~"_ERRMSG
+24 IF '$TEST
SET @MAGGRY@(0)="0^0~OK"
End DoDot:1
+25 QUIT
+26 ;
SX70SIT(X,DA) ;Set Query Site index for RAD/NUC MED PATIENT file
+1 ;DA(1)=DFN, DA=EXAM DATE (inverse date)
+2 ;X(1)=SITE Ien
+3 NEW DATE
+4 SET DATE=9999999.9999-DA
+5 ; Site, Date-Ext, DFN, DTI
SET ^ISINDX(70,"SIT",X(1),DATE,DA(1),DA)=""
+6 QUIT
+7 ;
KX70SIT(X,DA) ;Delete Query Site index for RAD/NUC MED PATIENT file
+1 NEW DATE
+2 SET DATE=9999999.9999-DA
+3 KILL ^ISINDX(70,"SIT",X(1),DATE,DA(1),DA)
+4 QUIT
+5 ;
+6 ;
