- ISIJLS2C ; 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."
- ;
- 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
- ;
- QRSPECS(SCAN,ERRMSG,DATA) ; * * * CALLed from isijls2 * * *
- ; this is used for the list Compile, and for the Query validate rpc
- ; SCAN -- True if this call is for the Query Compile; false for Validate Query specs
- ; ERRMSG -- return reason for error if detected
- ; DATA -- input for Validate only, contains specs values defined by user in Client
- ; for the Compile only (SCAN=1), initializes all "special" vars=0,
- ; then traverses input array & sets values per input in DATA
- ; remaining input vals are configured for List Sys search logic in QRMD...
- N ERROR,IMD,IMD2,ISPEC,OPERATOR,QRMD,QRMDCHK,VALUE,SESSION
- S SESSION=MAGJOB("SESSION")
- ; new these vars only if NOT running the scan (validate only)
- ; else the variables are set here for use in the compile code
- I 'SCAN N QAGE,QDATFR,QDATTO,QIMGTYP,QPTNAME,QRIST,QSEX,QSTATUS,QNIMG,QASSN
- I 'SCAN N AGE1,AGE2,PTNAME,RISTCHK,SEX,STATTEST,NIMG1,NIMG2,NIMGSPEC,ASSNCHK
- I 'SCAN N QIMGLOC
- ;
- S (QAGE,QDATFR,QDATTO,QIMGTYP,QPTNAME,QRIST,QSEX,QSTATUS,QNIMG,QASSN)=0
- S QIMGLOC=0
- S ISPEC="",ERRMSG=""
- I SCAN F S ISPEC=$O(^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"SPECS",ISPEC)) Q:ISPEC="" S X=^(ISPEC) D QRSPECS2(X)
- I 'SCAN D
- . F S ISPEC=$O(DATA(ISPEC)) Q:ISPEC="" S X=DATA(ISPEC) D QRSPECS2(X)
- ; Some query fields require further validation &/or data prep
- I +QDATFR,+QDATTO,(QDATFR<QDATTO)
- E S ERRMSG="Invalid FROM/TO date range"_$S(ERRMSG="":". ",1:"; ")_ERRMSG
- I QAGE D ; age from/to values
- . S:AGE1="" AGE1=0 S:AGE2="" AGE2=130
- . I ('AGE1&'AGE2)!(AGE1=0&(AGE2=130)) S QAGE=0 Q ; age not matter;
- . I '(AGE1!AGE2) S ERRMSG=ERRMSG_$S(ERRMSG="":"",1:"; ")_"Invalid AGE specification",QAGE=0
- . S:(AGE2'[".") AGE2=AGE2+0.99
- I QNIMG D ; # Images range values
- . I (NIMG1=""!(NIMG1?1.N))&(NIMG2=""!(NIMG2?1.N))
- . E S ERRMSG=ERRMSG_$S(ERRMSG="":"",1:"; ")_"Invalid # Images specification",QNIMG=0 Q
- . I NIMG1,NIMG2 D Q:'QNIMG
- . . I NIMG1>NIMG2 S ERRMSG=ERRMSG_$S(ERRMSG="":"",1:"; ")_"# Images values in wrong sequence.",QNIMG=0
- . N T1,T2,EXP S (T1,T2)=""
- . S:NIMG1]"" T1="(MD(9)'<"_NIMG1_")" S:NIMG2]"" T2="(MD(9)'>"_NIMG2_")" ; 9 = field IEN for # Images
- . I T1="",(T2="") S QNIMG=0 Q ; # images not matter;
- . I T1]"" S EXP=T1_$S(T2]"":"&"_T2_"",1:"")
- . E S EXP=T2
- . D QRMDSET(NIMGSPEC,9,EXP,"STUFF")
- ; data prep finished--if inside the Validation step, & query spec is clean, continue
- I 'SCAN,(ERRMSG="") D
- . ; init scan for session
- . F I="RSL","SPECS","SPECFLDS","SPECQRMD" K ^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,I)
- . ; save query details for use in the compile step
- . M ^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"SPECS")=DATA
- . I $D(QRMD) M ^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"SPECQRMD")=QRMD
- . S I="" F S I=$O(DATA(I)) Q:I="" S X=+DATA(I)\1,^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"SPECFLDS",X)=""
- Q
- ;
- QRSPECS2(X) ; X = Field_IEN ^ Value ^ Operator
- ; process input either indirect Tag call, or "generic" qrmdset call
- S IMD=$P(X,U),VALUE=$P(X,U,2),OPERATOR=$P(X,U,3),IMD2="",ERROR=""
- I IMD["." S IMD2=$P(IMD,".",2),IMD=$P(IMD,".")
- I $T(@("QRS"_IMD))]"" D @("QRS"_IMD) I 1
- E D ; <*> update valid imd list here when adding new fields
- . I $F("^3^5^6^7^8^9^15^17^24^201^207^208^",U_IMD_U) D QRMDSET(ISPEC,IMD,VALUE,OPERATOR) Q
- . E S ERROR="Invalid Query ID ["_IMD_"]--call support"
- I ERROR]"" S ERRMSG=ERRMSG_$S(ERRMSG="":"",1:"; ")_ERROR
- Q
- QRMDSET(ISPEC,IMD,VALUE,OPERATOR) ; Create "If" logic statements for input fields
- ; Operator "STUFF"--pass in just the argument
- ; otherwise, pass in components to build the full statement
- N ISPECPRV
- I VALUE="" Q
- S VALUE=$$STRIP^ISIJLS2(VALUE)
- I OPERATOR="STUFF"
- E S OPERATOR=$S(OPERATOR="E":"=",OPERATOR="G":">",OPERATOR="L":"<",OPERATOR="C":"[",1:"=")
- I $D(QRMDCHK(IMD)) S ISPECPRV=QRMDCHK(IMD) D ; Multiple values for this field, set up "OR" logic
- . I OPERATOR="STUFF" S QRMD(ISPECPRV)=QRMD(ISPECPRV)_"!"_VALUE
- . E S QRMD(ISPECPRV)=QRMD(ISPECPRV)_"!(MD("_IMD_")"_OPERATOR_""""_VALUE_""")"
- E D
- . I OPERATOR="STUFF" S QRMD(ISPEC)=IMD_U_" I "_VALUE,QRMDCHK(IMD)=ISPEC
- . E S QRMD(ISPEC)=IMD_U_" I (MD("_IMD_")"_OPERATOR_""""_VALUE_""")",QRMDCHK(IMD)=ISPEC
- Q
- ;
- QRSNN ; process input selection fields for data validation or scan
- ; --> variables NOT newed inside the codelets are global to qrspecs ep;
- ; --> codelets for 3, 7, 8, 17, 24, 201, 207 & 208 set the "special"
- ; variables used in the query scanning subroutines (qrscan...)
- QRS3 ; Pt Name
- I $L(VALUE) D
- . S VALUE=$$NAMEFMT^ISIJLS2(VALUE)
- . I VALUE?.E1C.E S ERROR="Invalid Name specification--control characters not allowed." Q
- I ERROR="",$L(VALUE) S PTNAME(0)=$G(PTNAME(0))+1,PTNAME(PTNAME(0))=VALUE,QPTNAME=1
- Q
- QRS5 ; Priority
- I '$L(VALUE) S ERROR="Invalid Priority specification"
- E I VALUE'="" D QRMDSET(ISPEC,IMD,VALUE,"C")
- Q
- QRS7 ; From/To Dates
- N VAR,VALUINT S VAR=$S(IMD2=1:"QDATFR",IMD2=2:"QDATTO",1:"")
- S VALUINT=VALUE
- I VALUINT]"" S X=VALUINT D ^%DT S VALUINT=$S(Y=-1:"",1:Y)
- I VALUINT?7N D
- . I IMD2=1 S VALUINT=VALUINT-1 ; From-date
- . S VALUINT=VALUINT_".2401"
- S @VAR=VALUINT
- Q
- QRS8 ; exam status * --> structure allows multiple values
- S QSTATUS=VALUE
- I $L(QSTATUS) S STATTEST(QSTATUS)="",QSTATUS=1
- E S QSTATUS=0
- Q
- QRS9 ; # Images (range)
- S NIMG1=$G(NIMG1),NIMG2=$G(NIMG2),NIMGSPEC=$G(NIMGSPEC) ; inits to nil if not yet processed the #Imgs
- N VAR S VAR=$S(IMD2=1:"NIMG1",IMD2=2:"NIMG2",1:"")
- I VAR]"",(VALUE?1.5N) S @VAR=VALUE,QNIMG=1 S:NIMGSPEC="" NIMGSPEC=ISPEC ; ispec needed beyond primary loop
- E S ERROR="Invalid # Images specification ",QNIMG=0
- Q
- QRS11 ; imaging loc * --> structure allows multiple values
- S QIMGLOC=VALUE
- I +QIMGLOC,(QIMGLOC'="") S QIMGLOC(VALUE)="",QIMGLOC=1
- E S QIMGLOC=0
- Q
- QRS15 ; Modality
- N I,VALUESTR
- I '$L(VALUE) Q
- E S VALUESTR=VALUE D
- . F I=1:1:$L(VALUESTR,",") S VALUE=$P(VALUESTR,",",I) I VALUE]"" D QRMDSET(ISPEC,IMD,VALUE,"C")
- Q
- QRS17 ; imaging type * --> structure allows multiple values
- S QIMGTYP=VALUE
- I +QIMGTYP,(QIMGTYP'="") S QIMGTYP(VALUE)="",QIMGTYP=1
- E S QIMGTYP=0
- Q
- QRS24 ; interp rist
- S QRIST=VALUE
- I $L(QRIST) S RISTCHK=QRIST,QRIST=1
- E S QRIST=0
- Q
- QRS201 ; assigned to
- S QASSN=VALUE
- I $L(QASSN) S ASSNCHK=QASSN,QASSN=1
- E S QASSN=0
- Q
- QRS207 ; Pt age (range)
- S AGE1=$G(AGE1),AGE2=$G(AGE2) ; inits to nil if not yet processed the age
- N VAR S VAR=$S(IMD2=1:"AGE1",IMD2=2:"AGE2",1:"")
- I VAR]"",(VALUE?1.3N0.1(1"."1.2N)) S @VAR=VALUE,QAGE=1
- E S ERROR="Invalid AGE specification ("_$S(IMD2=1:"From age)",1:"To age)"),QAGE=0
- Q
- QRS208 ; Pt sex
- S QSEX=VALUE
- I $L(QSEX) S SEX=QSEX,QSEX=1
- E S QSEX=0
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HISIJLS2C 7506 printed Feb 19, 2025@00:10:39 Page 2
- ISIJLS2C ; 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 ;
- +11 QUIT
- +12 ;
- 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 ;
- QRSPECS(SCAN,ERRMSG,DATA) ; * * * CALLed from isijls2 * * *
- +1 ; this is used for the list Compile, and for the Query validate rpc
- +2 ; SCAN -- True if this call is for the Query Compile; false for Validate Query specs
- +3 ; ERRMSG -- return reason for error if detected
- +4 ; DATA -- input for Validate only, contains specs values defined by user in Client
- +5 ; for the Compile only (SCAN=1), initializes all "special" vars=0,
- +6 ; then traverses input array & sets values per input in DATA
- +7 ; remaining input vals are configured for List Sys search logic in QRMD...
- +8 NEW ERROR,IMD,IMD2,ISPEC,OPERATOR,QRMD,QRMDCHK,VALUE,SESSION
- +9 SET SESSION=MAGJOB("SESSION")
- +10 ; new these vars only if NOT running the scan (validate only)
- +11 ; else the variables are set here for use in the compile code
- +12 IF 'SCAN
- NEW QAGE,QDATFR,QDATTO,QIMGTYP,QPTNAME,QRIST,QSEX,QSTATUS,QNIMG,QASSN
- +13 IF 'SCAN
- NEW AGE1,AGE2,PTNAME,RISTCHK,SEX,STATTEST,NIMG1,NIMG2,NIMGSPEC,ASSNCHK
- +14 IF 'SCAN
- NEW QIMGLOC
- +15 ;
- +16 SET (QAGE,QDATFR,QDATTO,QIMGTYP,QPTNAME,QRIST,QSEX,QSTATUS,QNIMG,QASSN)=0
- +17 SET QIMGLOC=0
- +18 SET ISPEC=""
- SET ERRMSG=""
- +19 IF SCAN
- FOR
- SET ISPEC=$ORDER(^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"SPECS",ISPEC))
- if ISPEC=""
- QUIT
- SET X=^(ISPEC)
- DO QRSPECS2(X)
- +20 IF 'SCAN
- Begin DoDot:1
- +21 FOR
- SET ISPEC=$ORDER(DATA(ISPEC))
- if ISPEC=""
- QUIT
- SET X=DATA(ISPEC)
- DO QRSPECS2(X)
- End DoDot:1
- +22 ; Some query fields require further validation &/or data prep
- +23 IF +QDATFR
- IF +QDATTO
- IF (QDATFR<QDATTO)
- +24 IF '$TEST
- SET ERRMSG="Invalid FROM/TO date range"_$SELECT(ERRMSG="":". ",1:"; ")_ERRMSG
- +25 ; age from/to values
- IF QAGE
- Begin DoDot:1
- +26 if AGE1=""
- SET AGE1=0
- if AGE2=""
- SET AGE2=130
- +27 ; age not matter;
- IF ('AGE1&'AGE2)!(AGE1=0&(AGE2=130))
- SET QAGE=0
- QUIT
- +28 IF '(AGE1!AGE2)
- SET ERRMSG=ERRMSG_$SELECT(ERRMSG="":"",1:"; ")_"Invalid AGE specification"
- SET QAGE=0
- +29 if (AGE2'[".")
- SET AGE2=AGE2+0.99
- End DoDot:1
- +30 ; # Images range values
- IF QNIMG
- Begin DoDot:1
- +31 IF (NIMG1=""!(NIMG1?1.N))&(NIMG2=""!(NIMG2?1.N))
- +32 IF '$TEST
- SET ERRMSG=ERRMSG_$SELECT(ERRMSG="":"",1:"; ")_"Invalid # Images specification"
- SET QNIMG=0
- QUIT
- +33 IF NIMG1
- IF NIMG2
- Begin DoDot:2
- +34 IF NIMG1>NIMG2
- SET ERRMSG=ERRMSG_$SELECT(ERRMSG="":"",1:"; ")_"# Images values in wrong sequence."
- SET QNIMG=0
- End DoDot:2
- if 'QNIMG
- QUIT
- +35 NEW T1,T2,EXP
- SET (T1,T2)=""
- +36 ; 9 = field IEN for # Images
- if NIMG1]""
- SET T1="(MD(9)'<"_NIMG1_")"
- if NIMG2]""
- SET T2="(MD(9)'>"_NIMG2_")"
- +37 ; # images not matter;
- IF T1=""
- IF (T2="")
- SET QNIMG=0
- QUIT
- +38 IF T1]""
- SET EXP=T1_$SELECT(T2]"":"&"_T2_"",1:"")
- +39 IF '$TEST
- SET EXP=T2
- +40 DO QRMDSET(NIMGSPEC,9,EXP,"STUFF")
- End DoDot:1
- +41 ; data prep finished--if inside the Validation step, & query spec is clean, continue
- +42 IF 'SCAN
- IF (ERRMSG="")
- Begin DoDot:1
- +43 ; init scan for session
- +44 FOR I="RSL","SPECS","SPECFLDS","SPECQRMD"
- KILL ^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,I)
- +45 ; save query details for use in the compile step
- +46 MERGE ^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"SPECS")=DATA
- +47 IF $DATA(QRMD)
- MERGE ^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"SPECQRMD")=QRMD
- +48 SET I=""
- FOR
- SET I=$ORDER(DATA(I))
- if I=""
- QUIT
- SET X=+DATA(I)\1
- SET ^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"SPECFLDS",X)=""
- End DoDot:1
- +49 QUIT
- +50 ;
- QRSPECS2(X) ; X = Field_IEN ^ Value ^ Operator
- +1 ; process input either indirect Tag call, or "generic" qrmdset call
- +2 SET IMD=$PIECE(X,U)
- SET VALUE=$PIECE(X,U,2)
- SET OPERATOR=$PIECE(X,U,3)
- SET IMD2=""
- SET ERROR=""
- +3 IF IMD["."
- SET IMD2=$PIECE(IMD,".",2)
- SET IMD=$PIECE(IMD,".")
- +4 IF $TEXT(@("QRS"_IMD))]""
- DO @("QRS"_IMD)
- IF 1
- +5 ; <*> update valid imd list here when adding new fields
- IF '$TEST
- Begin DoDot:1
- +6 IF $FIND("^3^5^6^7^8^9^15^17^24^201^207^208^",U_IMD_U)
- DO QRMDSET(ISPEC,IMD,VALUE,OPERATOR)
- QUIT
- +7 IF '$TEST
- SET ERROR="Invalid Query ID ["_IMD_"]--call support"
- End DoDot:1
- +8 IF ERROR]""
- SET ERRMSG=ERRMSG_$SELECT(ERRMSG="":"",1:"; ")_ERROR
- +9 QUIT
- QRMDSET(ISPEC,IMD,VALUE,OPERATOR) ; Create "If" logic statements for input fields
- +1 ; Operator "STUFF"--pass in just the argument
- +2 ; otherwise, pass in components to build the full statement
- +3 NEW ISPECPRV
- +4 IF VALUE=""
- QUIT
- +5 SET VALUE=$$STRIP^ISIJLS2(VALUE)
- +6 IF OPERATOR="STUFF"
- +7 IF '$TEST
- SET OPERATOR=$SELECT(OPERATOR="E":"=",OPERATOR="G":">",OPERATOR="L":"<",OPERATOR="C":"[",1:"=")
- +8 ; Multiple values for this field, set up "OR" logic
- IF $DATA(QRMDCHK(IMD))
- SET ISPECPRV=QRMDCHK(IMD)
- Begin DoDot:1
- +9 IF OPERATOR="STUFF"
- SET QRMD(ISPECPRV)=QRMD(ISPECPRV)_"!"_VALUE
- +10 IF '$TEST
- SET QRMD(ISPECPRV)=QRMD(ISPECPRV)_"!(MD("_IMD_")"_OPERATOR_""""_VALUE_""")"
- End DoDot:1
- +11 IF '$TEST
- Begin DoDot:1
- +12 IF OPERATOR="STUFF"
- SET QRMD(ISPEC)=IMD_U_" I "_VALUE
- SET QRMDCHK(IMD)=ISPEC
- +13 IF '$TEST
- SET QRMD(ISPEC)=IMD_U_" I (MD("_IMD_")"_OPERATOR_""""_VALUE_""")"
- SET QRMDCHK(IMD)=ISPEC
- End DoDot:1
- +14 QUIT
- +15 ;
- QRSNN ; process input selection fields for data validation or scan
- +1 ; --> variables NOT newed inside the codelets are global to qrspecs ep;
- +2 ; --> codelets for 3, 7, 8, 17, 24, 201, 207 & 208 set the "special"
- +3 ; variables used in the query scanning subroutines (qrscan...)
- QRS3 ; Pt Name
- +1 IF $LENGTH(VALUE)
- Begin DoDot:1
- +2 SET VALUE=$$NAMEFMT^ISIJLS2(VALUE)
- +3 IF VALUE?.E1C.E
- SET ERROR="Invalid Name specification--control characters not allowed."
- QUIT
- End DoDot:1
- +4 IF ERROR=""
- IF $LENGTH(VALUE)
- SET PTNAME(0)=$GET(PTNAME(0))+1
- SET PTNAME(PTNAME(0))=VALUE
- SET QPTNAME=1
- +5 QUIT
- QRS5 ; Priority
- +1 IF '$LENGTH(VALUE)
- SET ERROR="Invalid Priority specification"
- +2 IF '$TEST
- IF VALUE'=""
- DO QRMDSET(ISPEC,IMD,VALUE,"C")
- +3 QUIT
- QRS7 ; From/To Dates
- +1 NEW VAR,VALUINT
- SET VAR=$SELECT(IMD2=1:"QDATFR",IMD2=2:"QDATTO",1:"")
- +2 SET VALUINT=VALUE
- +3 IF VALUINT]""
- SET X=VALUINT
- DO ^%DT
- SET VALUINT=$SELECT(Y=-1:"",1:Y)
- +4 IF VALUINT?7N
- Begin DoDot:1
- +5 ; From-date
- IF IMD2=1
- SET VALUINT=VALUINT-1
- +6 SET VALUINT=VALUINT_".2401"
- End DoDot:1
- +7 SET @VAR=VALUINT
- +8 QUIT
- QRS8 ; exam status * --> structure allows multiple values
- +1 SET QSTATUS=VALUE
- +2 IF $LENGTH(QSTATUS)
- SET STATTEST(QSTATUS)=""
- SET QSTATUS=1
- +3 IF '$TEST
- SET QSTATUS=0
- +4 QUIT
- QRS9 ; # Images (range)
- +1 ; inits to nil if not yet processed the #Imgs
- SET NIMG1=$GET(NIMG1)
- SET NIMG2=$GET(NIMG2)
- SET NIMGSPEC=$GET(NIMGSPEC)
- +2 NEW VAR
- SET VAR=$SELECT(IMD2=1:"NIMG1",IMD2=2:"NIMG2",1:"")
- +3 ; ispec needed beyond primary loop
- IF VAR]""
- IF (VALUE?1.5N)
- SET @VAR=VALUE
- SET QNIMG=1
- if NIMGSPEC=""
- SET NIMGSPEC=ISPEC
- +4 IF '$TEST
- SET ERROR="Invalid # Images specification "
- SET QNIMG=0
- +5 QUIT
- QRS11 ; imaging loc * --> structure allows multiple values
- +1 SET QIMGLOC=VALUE
- +2 IF +QIMGLOC
- IF (QIMGLOC'="")
- SET QIMGLOC(VALUE)=""
- SET QIMGLOC=1
- +3 IF '$TEST
- SET QIMGLOC=0
- +4 QUIT
- QRS15 ; Modality
- +1 NEW I,VALUESTR
- +2 IF '$LENGTH(VALUE)
- QUIT
- +3 IF '$TEST
- SET VALUESTR=VALUE
- Begin DoDot:1
- +4 FOR I=1:1:$LENGTH(VALUESTR,",")
- SET VALUE=$PIECE(VALUESTR,",",I)
- IF VALUE]""
- DO QRMDSET(ISPEC,IMD,VALUE,"C")
- End DoDot:1
- +5 QUIT
- QRS17 ; imaging type * --> structure allows multiple values
- +1 SET QIMGTYP=VALUE
- +2 IF +QIMGTYP
- IF (QIMGTYP'="")
- SET QIMGTYP(VALUE)=""
- SET QIMGTYP=1
- +3 IF '$TEST
- SET QIMGTYP=0
- +4 QUIT
- QRS24 ; interp rist
- +1 SET QRIST=VALUE
- +2 IF $LENGTH(QRIST)
- SET RISTCHK=QRIST
- SET QRIST=1
- +3 IF '$TEST
- SET QRIST=0
- +4 QUIT
- QRS201 ; assigned to
- +1 SET QASSN=VALUE
- +2 IF $LENGTH(QASSN)
- SET ASSNCHK=QASSN
- SET QASSN=1
- +3 IF '$TEST
- SET QASSN=0
- +4 QUIT
- QRS207 ; Pt age (range)
- +1 ; inits to nil if not yet processed the age
- SET AGE1=$GET(AGE1)
- SET AGE2=$GET(AGE2)
- +2 NEW VAR
- SET VAR=$SELECT(IMD2=1:"AGE1",IMD2=2:"AGE2",1:"")
- +3 IF VAR]""
- IF (VALUE?1.3N0.1(1"."1.2N))
- SET @VAR=VALUE
- SET QAGE=1
- +4 IF '$TEST
- SET ERROR="Invalid AGE specification ("_$SELECT(IMD2=1:"From age)",1:"To age)")
- SET QAGE=0
- +5 QUIT
- QRS208 ; Pt sex
- +1 SET QSEX=VALUE
- +2 IF $LENGTH(QSEX)
- SET SEX=QSEX
- SET QSEX=1
- +3 IF '$TEST
- SET QSEX=0
- +4 QUIT
- +5 ;