- ISIJLS2B ; ISI/JHC - ISIRAD exam list functions ; 10/17/2022
- ;;1.1;ESL ISI IMAGING;**99,105,106,107,109,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 File #2006.69 in ICR #7410
- Q
- ;
- FORMOUT(OUTPUT) ; Create form spec (XML formatting) for Dynamic Query dialog
- ; Form contents are table-driven by entries in comment lines at bottom of routine.
- ; If query exists for the session, populate defined prompts with stored values.
- N FLDID,IREGION,RGNS,RSL,INSPECS,INSPMULT,SESSION,OK,NEWQUERY
- S SESSION=MAGJOB("SESSION"),NEWQUERY=1
- I $D(^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"SPECS")) D ; get currently defined specs for session
- . S I="",NEWQUERY=0
- . F S I=$O(^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"SPECS",I)) Q:I="" S X=^(I) D
- . . S FLDID=$P(X,U)
- . . I '$D(INSPECS(FLDID)) S INSPECS(FLDID)=$P(X,U,2,99)
- . . E S T=$G(INSPMULT(FLDID))+1,INSPMULT(FLDID)=T,INSPMULT(FLDID,T)=$P(X,U,2,99) ; save multiple values
- S RGNS="PRHDR^PRLST^PRLSTOPT" ; form regions--see tables at these tags below
- F IREGION=0:1:$L(RGNS,U) D
- . I 'IREGION S OUTPUT(IREGION,1)="<DIALOG name=""Query_Dlg"" ver=""1.0"" title=""Create/Edit Query"" newquery="""_NEWQUERY_""">"
- . I Q
- . D PROMPTS($P(RGNS,U,IREGION),.RSL) M OUTPUT(IREGION)=RSL K RSL
- S OUTPUT(IREGION+1,1)="</DIALOG>"
- Q
- ;
- PROMPTS(REGION,RGSPEC) ; assemble prompts for the dialog form's region
- I "^PRHDR^PRLST^PRLSTOPT^"[U_$G(REGION)_U
- E Q
- N END,ICT,IFLD,FLDID,RGNNAME,SAVICT
- N LIST,OPLIST,SPEC,STRING,TAGS ;these are global to Prompts & Prompts2 subroutines
- N QUOTE,SP ; these are global to all Prompts & "GETxxx" subroutines
- S QUOTE="""",SP=" "
- S TAGS="ID=^LABEL=^DATA_TYPE=^AUTOFILL=^REQUIRED=^DISPLAYONLY=^LOWER_LIMIT=^UPPER_LIMIT=^HELP_TEXT=^OPERATOR=^AUTOFILL_OP=^COL_WIDTH_PCT=^ALLOW_MULTIPLE="
- S END=0
- F IFLD=1:1 S X=$T(@REGION+IFLD) D Q:END
- . I X="" S END=1 Q ; should never get here...
- . S SPEC=$P(X,";",3,999)
- . I IFLD=1 D Q
- . . S RGNNAME=$P(SPEC,";"),T=$P(SPEC,";",2,99)
- . . S RGSPEC(IFLD)="<"_RGNNAME_SP_T_">"
- . I $E(SPEC,1,4)="*END" S END=1,RGSPEC(IFLD)="</"_RGNNAME_">" Q
- . I +SPEC=201,'($P($G(^MAG(2006.69,1,"ISI")),U,1)="Y") Q ; Assign feature not enabled
- . D PROMPTS1()
- Q
- PROMPTS1() ;
- N IFLDEXT,REPEAT
- S IFLDEXT=IFLD,REPEAT=0
- F D Q:'REPEAT Q:REGION'="PRLSTOPT" ; All multiples live in the prlstopt region only
- . I REPEAT S IFLDEXT=IFLD+(REPEAT/100)
- . S STRING="<PROMPT ",LIST=0,OPLIST=0,ICT=0
- . D PROMPTS2(.FLDID,.REPEAT)
- . S STRING=STRING_$S('(LIST!OPLIST):"/>",1:">"),RGSPEC(IFLDEXT)=STRING
- . I LIST S SAVICT=ICT D GETLIST(FLDID,.RGSPEC,IFLDEXT,.ICT) I ICT=SAVICT S LIST=0 K RGSPEC(IFLDEXT)
- . I OPLIST D GETOPS(FLDID,.RGSPEC,IFLDEXT,.ICT)
- . I (LIST!OPLIST) S RGSPEC(IFLDEXT,99999)="</PROMPT>"
- Q
- PROMPTS2(FLDID,REPEAT) ;
- N AUTOFILL,AUTOFOP,ISPEC
- F ISPEC=1:1:$L(TAGS,U) S X=$P(SPEC,U,ISPEC) D
- . I ISPEC=1 D
- . . S FLDID=X,AUTOFILL="",AUTOFOP="",DATEVALU=0
- . . I $D(INSPECS(FLDID)) S AUTOFILL=$P(INSPECS(FLDID),U),AUTOFOP=$P(INSPECS(FLDID),U,2)
- . I $D(INSPECS(FLDID)) D
- . . I ISPEC=4 S X=AUTOFILL ; autofill from user's prompt entries
- . . I ISPEC=11 S X=AUTOFOP ; ditto the operator
- . E I X="" Q
- . I ISPEC=3,(X="DATE") S DATEVALU=1 ; flag date data type for special default=TODAY
- . I X="" Q:'(ISPEC=4!ISPEC=11) ; ignore spec unless is user-filled prompt/operator entry
- . I DATEVALU,(ISPEC=4),(X["TODAY") S X=$$TODAY(X)
- . I DATEVALU,(ISPEC=7),(FLDID=7.1) D ; Site setting limits # days back for "Study Date From"
- . . S T=+$P($G(^MAG(2006.69,1,"ISI")),U,6)
- . . I T S X=$$TODAY("TODAY-"_T)
- . S T=$P(TAGS,U,ISPEC)_QUOTE_X_QUOTE_SP,STRING=STRING_T
- . I T["DATA_TYPE=",(X="LIST") S LIST=1 ; this is a "list" Data Type
- . I T["OPERATOR=",(X="OPLIST") S OPLIST=1 ; this has operators
- I $D(INSPECS(FLDID)) D
- . K INSPECS(FLDID) ; already used this one; are there more?
- . I $D(INSPMULT(FLDID)) D ; copy next multi value into field, set repeat flag
- . . S T=$O(INSPMULT(FLDID,""))
- . . I T S REPEAT=REPEAT+1,X=INSPMULT(FLDID,T),INSPECS(FLDID)=X K INSPMULT(FLDID,T)
- . . E S REPEAT=0 ; no more multiples
- Q
- TODAY(ARG) ; return today's date [plus/minus N] in YYYYMMDD format
- ; Default today's date unless ARG matches TODAY+N or TODAY-N
- N X,X1,X2,DATE,N,OP
- I $E(ARG,1,5)="TODAY"&(ARG["+"!(ARG["-")) D
- . S OP=$E(ARG,6),N=+$P(ARG,OP,2)
- . S X1=DT,X2=$S(OP="-":-N,1:N)
- . D C^%DTC S DATE=X
- E S DATE=DT
- S X1=$E(DATE),X2=$E(DATE,2,7),X=$S(X1=2:19,X1=3:20,X1=4:21)_X2
- Q X
- ;
- GETLIST(ID,RGSPEC,IFLD,ICT) ; build legal values list for input field ID
- N TAG
- S ID=ID\1,TAG="GET"_ID ; strip decimal if present
- I $T(@TAG)]"" D @(TAG_"()")
- Q
- GETLIST2(IDVAL,TXT) ; add one entry to the values list; called from each GETNN subrtn
- S ICT=ICT+1
- S RGSPEC(IFLD,ICT)="<ListValue ID="_QUOTE_IDVAL_QUOTE_">"_TXT_"</ListValue>"
- Q
- ;
- GETNN ; return list of valid values for each given field ien
- ; NN = field ien inside the List subsystem;
- GET5() ; Priority
- N ID,TXT,URGORD,VALSTR
- S X=$G(^MAG(2006.69,1,1)),URGORD=$P(X,U)
- S:URGORD="" URGORD="S,U,P,R" S URGORD=$TR(URGORD,",")
- S VALSTR=""
- F I=1:1:$L(URGORD) D
- . S X=$E(URGORD,I),T=$S(X="S":"Stat",X="U":"Urg",X="P":"PreOp",1:"Rout")
- . S T=I_"-"_T,T=T_"~"_T
- . S VALSTR=VALSTR_$S(VALSTR="":"",1:U)_T
- I VALSTR]"" D
- . D GETLIST2("","- -")
- . F I=1:1:$L(VALSTR,U) D
- . . S X=$P(VALSTR,U,I),ID=$P(X,"~"),TXT=$P(X,"~",2)
- . . D GETLIST2(ID,TXT)
- Q
- GET8() ; Status
- N ID,TXT,VALSTR
- S X="READY FOR INTERP"
- I $$UJOCHECK^ISIJUTL9() S X="US WAITING" ; Different string for Jordan
- S VALSTR="9~COMPLETE^I~INTERPRETED^E~EXAMINED^1~WAITING^R~"_X ; P106 add R; P109 (X=Jordan string vs default)
- I VALSTR]"" D
- . D GETLIST2("","- -")
- . F I=1:1:$L(VALSTR,U) D
- . . S X=$P(VALSTR,U,I),ID=$P(X,"~"),TXT=$P(X,"~",2)
- . . D GETLIST2(ID,TXT)
- Q
- GET11() ; Imaging Loc
- N DATA,IDAT,SCR
- S SCR="I $P($G(^(""DIV"")),U)=DUZ(2)" ; filter for Locs at the user logon division
- D LIST^DIC(79.1,,"@;.01","P",,,,,SCR,,"DATA")
- I +$G(DATA("DILIST",0)) D
- . D GETLIST2("","- -")
- . S IDAT=0 F S IDAT=$O(DATA("DILIST",IDAT)) Q:IDAT="" S X=DATA("DILIST",IDAT,0) D GETLIST2($P(X,U),$P(X,U,2))
- Q
- GET15() ; Modality
- N DATA,IDAT,TOPMDLS,I
- S TOPMDLS="CR^CT^DX^MR^MG^NM^RF^US^XA"
- D LIST^DIC(73.1,,"@;.01","P",,,,,"I $P(^(0),U,3)=""""",,"DATA")
- D GETLIST2("","- -")
- D GETLIST2("CR,DX","CR or DX")
- F I=1:1:$L(TOPMDLS,U) S X=$P(TOPMDLS,U,I),TOPMDLS(X)="" D GETLIST2(X,X)
- S IDAT=0 F S IDAT=$O(DATA("DILIST",IDAT)) Q:IDAT="" S X=$P(DATA("DILIST",IDAT,0),U,2) I '$D(TOPMDLS(X)) D GETLIST2(X,X)
- Q
- GET17() ; Type of Imaging
- N DATA,IDAT
- D LIST^DIC(79.2,,"@;3;.01","P",,,,,,,"DATA")
- I +$G(DATA("DILIST",0)) D
- . D GETLIST2("","- -")
- . S IDAT=0 F S IDAT=$O(DATA("DILIST",IDAT)) Q:IDAT="" S X=DATA("DILIST",IDAT,0) D GETLIST2($P(X,U),$P(X,U,3))
- Q
- GET24() ; Radiologist
- N ID,TXT,VALSTR
- S VALSTR="1~Is me^0~Is NOT me^-1~Is not entered"
- D GETLIST2("","- -")
- F I=1:1:$L(VALSTR,U) S X=$P(VALSTR,U,I),ID=$P(X,"~"),TXT=$P(X,"~",2) D GETLIST2(ID,TXT)
- Q
- GET201() ; Assigned to
- N ID,TXT,VALSTR
- S VALSTR="1~Me^0~NOT me^2~Anyone^-1~NOT entered"
- D GETLIST2("","- -")
- F I=1:1:$L(VALSTR,U) S X=$P(VALSTR,U,I),ID=$P(X,"~"),TXT=$P(X,"~",2) D GETLIST2(ID,TXT)
- Q
- GET208() ; Patient Sex
- N IDVAL,TXT,VALSTR
- S VALSTR="F~FEMALE^M~MALE"
- D GETLIST2("","- -")
- F I=1:1:$L(VALSTR,U) S X=$P(VALSTR,U,I),IDVAL=$P(X,"~"),TXT=$P(X,"~",2) D GETLIST2(IDVAL,TXT)
- Q
- ;
- GETOPS(ID,RGSPEC,IFLD,ICT) ; build legal Operator values list for input field ID
- N TAG
- S ID=ID\1,TAG="OPS"_ID ; strip decimal if present
- I $T(@TAG)]"" D @(TAG_"()")
- Q
- GETOPS2(IDVAL,TXT) ; add one entry to the operator list
- S ICT=ICT+1
- S RGSPEC(IFLD,ICT)="<OpValue ID="_QUOTE_IDVAL_QUOTE_">"_TXT_"</OpValue>"
- Q
- ;
- OPSNN ; NN = field ien inside the Operator subsystem
- ; * --> make sure operator values are accounted for in
- ; subrtn qrspecs2 &/or QRSNN codelets as applies
- OPSSTR(VALSTR) ;
- I VALSTR]"",(VALSTR["~") D
- . N ID,TXT,X
- . F I=1:1:$L(VALSTR,U) S X=$P(VALSTR,U,I),ID=$P(X,"~"),TXT=$P(X,"~",2) D GETOPS2(ID,TXT)
- Q
- OPS6() ; Procedure operators
- N VALSTR
- S VALSTR="C~Contains^E~Equals"
- D OPSSTR(VALSTR)
- Q
- OPS9() ; # Images operators
- N VALSTR
- S VALSTR="G~Greater than^L~Less than^E~Equals"
- D OPSSTR(VALSTR)
- Q
- ZZOPS8() ; <*> Status operators (zz intentional--this used ONLY for TESTING of ops w/ List data type)
- N VALSTR
- S VALSTR="E~Equals^C~Contains"
- D OPSSTR(VALSTR)
- Q
- ;
- ; 3 tables below provide details for each prompt, w/in prompt regions
- ; 1st line has region tag name & optional parameters ();
- ; lines 2:n have prompt specs
- ; prompt specs as follows (MUST line up w/ "TAGS" variable in the "PROMPTS" subroutine)
- ; note that the 1st 3 values are ALWAYS REQUIRED to be filled in
- ; ID ^ LABEL ^ DATA_TYPE ^ AUTOFILL ^ REQUIRED ^ DISPLAYONLY ^ LOWER_LIMIT ^ UPPER_LIMIT
- ; ^ HELP_TEXT ^ OPERATOR ^ AUTOFILL_OP ^ COL_WIDTH_PCT ^ ALLOW_MULTIPLE
- ; Notes:
- ; - COL_WIDTH_PCT values only in prhdr region & are REQUIRED & must total 100
- ; - ALLOW_MULTIPLE values may only appear in prlstopt region
- ; - PROMPTS_LIST_COLUMNS_PCT values only appears in prlst region;
- ; values total 100; defines column-widths for the table
- ; control where these prompts are rendered
- ; - LOWER_LIMIT for Field ID 7.1 may be overridden by a
- ; Site Parameter setting; see code at tag prompts2
- ;
- PRHDR ; ^3^5^6^7^8^9^11^15^17^24^201^207^208^
- ;;PROMPTS_HEADER;
- ;;7.1^Study Date From^DATE^TODAY^1^^19981001^TODAY^^^^10
- ;;7.2^Date To^DATE^TODAY^1^^19981001^TODAY^^^^10
- ;;17^ > Type of Imaging^LIST^^^^^^^^^10
- ;;208^ > Sex^LIST^^^^^^^^^7
- ;;3^ > Patient Name matches^FREE_TEXT^^^^^^Enter Last, First (partial name OK)^^^25
- ;;24^ > Radiologist^LIST^^^^^^^^^7
- ;;201^ > Assigned to^LIST^^^^^^^^^7
- ;;8^ > Status^LIST^^^^^^^^^5^1
- ;;11^ > Imaging Loc^LIST^^^^^^^^^10
- ;;*END
- ;; <*> below lines for test DB convenience--> copy into above spaces when testing
- ;;7.1^Study Date From^DATE^20080101^1^^20080101^TODAY^^^^12
- ;;7.2^Date To^DATE^TODAY^1^^20090101^TODAY^^^^12
- PRLST ;
- ;;PROMPTS_LIST;PROMPTS_LIST_COLUMNS_PCT="24,22,54"
- ;;207.1^ > Patient Age from^NUMERIC^^^^0^130^Enter Patient 'age from'^^^
- ;;207.2^ > Patient Age to^NUMERIC^^^^0^130^Enter Patient 'age to'^^^
- ;;15^Modality^LIST
- ;;6^Procedure^FREE_TEXT^^^^^^Enter some portion of the Procedure name, e.g., CHEST^OPLIST^^^
- ;;9.1^# Images GREATER than or Equal to^NUMERIC^^^^0^99999^^
- ;;9.2^# Images LESS than or Equal to^NUMERIC^^^^0^99999^^
- ;;*END
- PRLSTOPT ; <*> Note--> when adding new fields, insert in Alphabetical Order
- ;;PROMPTS_LIST_OPTIONAL;
- ;;11^ > Imaging Loc^LIST^^^^^^^^^1
- ;;15^Modality^LIST^^^^^^^^^^1
- ;;3^ > Patient Name matches^FREE_TEXT^^^^^^^^^^1
- ;;5^Priority^LIST^^^^^^^^^^1
- ;;6^Procedure^FREE_TEXT^^^^^^Enter some portion of the Procedure name, e.g., CHEST^OPLIST^^^1
- ;;8^ > Status^LIST^^^^^^^^^^1
- ;;17^ > Type of Imaging^LIST^^^^^^^^^^1
- ;;*END
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HISIJLS2B 11594 printed Feb 19, 2025@00:10:38 Page 2
- ISIJLS2B ; ISI/JHC - ISIRAD exam list functions ; 10/17/2022
- +1 ;;1.1;ESL ISI IMAGING;**99,105,106,107,109,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 File #2006.69 in ICR #7410
- +11 QUIT
- +12 ;
- FORMOUT(OUTPUT) ; Create form spec (XML formatting) for Dynamic Query dialog
- +1 ; Form contents are table-driven by entries in comment lines at bottom of routine.
- +2 ; If query exists for the session, populate defined prompts with stored values.
- +3 NEW FLDID,IREGION,RGNS,RSL,INSPECS,INSPMULT,SESSION,OK,NEWQUERY
- +4 SET SESSION=MAGJOB("SESSION")
- SET NEWQUERY=1
- +5 ; get currently defined specs for session
- IF $DATA(^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"SPECS"))
- Begin DoDot:1
- +6 SET I=""
- SET NEWQUERY=0
- +7 FOR
- SET I=$ORDER(^XTMP("MAGJ2","ISIQUERY",DUZ,SESSION,"SPECS",I))
- if I=""
- QUIT
- SET X=^(I)
- Begin DoDot:2
- +8 SET FLDID=$PIECE(X,U)
- +9 IF '$DATA(INSPECS(FLDID))
- SET INSPECS(FLDID)=$PIECE(X,U,2,99)
- +10 ; save multiple values
- IF '$TEST
- SET T=$GET(INSPMULT(FLDID))+1
- SET INSPMULT(FLDID)=T
- SET INSPMULT(FLDID,T)=$PIECE(X,U,2,99)
- End DoDot:2
- End DoDot:1
- +11 ; form regions--see tables at these tags below
- SET RGNS="PRHDR^PRLST^PRLSTOPT"
- +12 FOR IREGION=0:1:$LENGTH(RGNS,U)
- Begin DoDot:1
- +13 IF 'IREGION
- SET OUTPUT(IREGION,1)="<DIALOG name=""Query_Dlg"" ver=""1.0"" title=""Create/Edit Query"" newquery="""_NEWQUERY_""">"
- +14 IF $TEST
- QUIT
- +15 DO PROMPTS($PIECE(RGNS,U,IREGION),.RSL)
- MERGE OUTPUT(IREGION)=RSL
- KILL RSL
- End DoDot:1
- +16 SET OUTPUT(IREGION+1,1)="</DIALOG>"
- +17 QUIT
- +18 ;
- PROMPTS(REGION,RGSPEC) ; assemble prompts for the dialog form's region
- +1 IF "^PRHDR^PRLST^PRLSTOPT^"[U_$GET(REGION)_U
- +2 IF '$TEST
- QUIT
- +3 NEW END,ICT,IFLD,FLDID,RGNNAME,SAVICT
- +4 ;these are global to Prompts & Prompts2 subroutines
- NEW LIST,OPLIST,SPEC,STRING,TAGS
- +5 ; these are global to all Prompts & "GETxxx" subroutines
- NEW QUOTE,SP
- +6 SET QUOTE=""""
- SET SP=" "
- +7 SET TAGS="ID=^LABEL=^DATA_TYPE=^AUTOFILL=^REQUIRED=^DISPLAYONLY=^LOWER_LIMIT=^UPPER_LIMIT=^HELP_TEXT=^OPERATOR=^AUTOFILL_OP=^COL_WIDTH_PCT=^ALLOW_MULTIPLE="
- +8 SET END=0
- +9 FOR IFLD=1:1
- SET X=$TEXT(@REGION+IFLD)
- Begin DoDot:1
- +10 ; should never get here...
- IF X=""
- SET END=1
- QUIT
- +11 SET SPEC=$PIECE(X,";",3,999)
- +12 IF IFLD=1
- Begin DoDot:2
- +13 SET RGNNAME=$PIECE(SPEC,";")
- SET T=$PIECE(SPEC,";",2,99)
- +14 SET RGSPEC(IFLD)="<"_RGNNAME_SP_T_">"
- End DoDot:2
- QUIT
- +15 IF $EXTRACT(SPEC,1,4)="*END"
- SET END=1
- SET RGSPEC(IFLD)="</"_RGNNAME_">"
- QUIT
- +16 ; Assign feature not enabled
- IF +SPEC=201
- IF '($PIECE($GET(^MAG(2006.69,1,"ISI")),U,1)="Y")
- QUIT
- +17 DO PROMPTS1()
- End DoDot:1
- if END
- QUIT
- +18 QUIT
- PROMPTS1() ;
- +1 NEW IFLDEXT,REPEAT
- +2 SET IFLDEXT=IFLD
- SET REPEAT=0
- +3 ; All multiples live in the prlstopt region only
- FOR
- Begin DoDot:1
- +4 IF REPEAT
- SET IFLDEXT=IFLD+(REPEAT/100)
- +5 SET STRING="<PROMPT "
- SET LIST=0
- SET OPLIST=0
- SET ICT=0
- +6 DO PROMPTS2(.FLDID,.REPEAT)
- +7 SET STRING=STRING_$SELECT('(LIST!OPLIST):"/>",1:">")
- SET RGSPEC(IFLDEXT)=STRING
- +8 IF LIST
- SET SAVICT=ICT
- DO GETLIST(FLDID,.RGSPEC,IFLDEXT,.ICT)
- IF ICT=SAVICT
- SET LIST=0
- KILL RGSPEC(IFLDEXT)
- +9 IF OPLIST
- DO GETOPS(FLDID,.RGSPEC,IFLDEXT,.ICT)
- +10 IF (LIST!OPLIST)
- SET RGSPEC(IFLDEXT,99999)="</PROMPT>"
- End DoDot:1
- if 'REPEAT
- QUIT
- if REGION'="PRLSTOPT"
- QUIT
- +11 QUIT
- PROMPTS2(FLDID,REPEAT) ;
- +1 NEW AUTOFILL,AUTOFOP,ISPEC
- +2 FOR ISPEC=1:1:$LENGTH(TAGS,U)
- SET X=$PIECE(SPEC,U,ISPEC)
- Begin DoDot:1
- +3 IF ISPEC=1
- Begin DoDot:2
- +4 SET FLDID=X
- SET AUTOFILL=""
- SET AUTOFOP=""
- SET DATEVALU=0
- +5 IF $DATA(INSPECS(FLDID))
- SET AUTOFILL=$PIECE(INSPECS(FLDID),U)
- SET AUTOFOP=$PIECE(INSPECS(FLDID),U,2)
- End DoDot:2
- +6 IF $DATA(INSPECS(FLDID))
- Begin DoDot:2
- +7 ; autofill from user's prompt entries
- IF ISPEC=4
- SET X=AUTOFILL
- +8 ; ditto the operator
- IF ISPEC=11
- SET X=AUTOFOP
- End DoDot:2
- +9 IF '$TEST
- IF X=""
- QUIT
- +10 ; flag date data type for special default=TODAY
- IF ISPEC=3
- IF (X="DATE")
- SET DATEVALU=1
- +11 ; ignore spec unless is user-filled prompt/operator entry
- IF X=""
- if '(ISPEC=4!ISPEC=11)
- QUIT
- +12 IF DATEVALU
- IF (ISPEC=4)
- IF (X["TODAY")
- SET X=$$TODAY(X)
- +13 ; Site setting limits # days back for "Study Date From"
- IF DATEVALU
- IF (ISPEC=7)
- IF (FLDID=7.1)
- Begin DoDot:2
- +14 SET T=+$PIECE($GET(^MAG(2006.69,1,"ISI")),U,6)
- +15 IF T
- SET X=$$TODAY("TODAY-"_T)
- End DoDot:2
- +16 SET T=$PIECE(TAGS,U,ISPEC)_QUOTE_X_QUOTE_SP
- SET STRING=STRING_T
- +17 ; this is a "list" Data Type
- IF T["DATA_TYPE="
- IF (X="LIST")
- SET LIST=1
- +18 ; this has operators
- IF T["OPERATOR="
- IF (X="OPLIST")
- SET OPLIST=1
- End DoDot:1
- +19 IF $DATA(INSPECS(FLDID))
- Begin DoDot:1
- +20 ; already used this one; are there more?
- KILL INSPECS(FLDID)
- +21 ; copy next multi value into field, set repeat flag
- IF $DATA(INSPMULT(FLDID))
- Begin DoDot:2
- +22 SET T=$ORDER(INSPMULT(FLDID,""))
- +23 IF T
- SET REPEAT=REPEAT+1
- SET X=INSPMULT(FLDID,T)
- SET INSPECS(FLDID)=X
- KILL INSPMULT(FLDID,T)
- +24 ; no more multiples
- IF '$TEST
- SET REPEAT=0
- End DoDot:2
- End DoDot:1
- +25 QUIT
- TODAY(ARG) ; return today's date [plus/minus N] in YYYYMMDD format
- +1 ; Default today's date unless ARG matches TODAY+N or TODAY-N
- +2 NEW X,X1,X2,DATE,N,OP
- +3 IF $EXTRACT(ARG,1,5)="TODAY"&(ARG["+"!(ARG["-"))
- Begin DoDot:1
- +4 SET OP=$EXTRACT(ARG,6)
- SET N=+$PIECE(ARG,OP,2)
- +5 SET X1=DT
- SET X2=$SELECT(OP="-":-N,1:N)
- +6 DO C^%DTC
- SET DATE=X
- End DoDot:1
- +7 IF '$TEST
- SET DATE=DT
- +8 SET X1=$EXTRACT(DATE)
- SET X2=$EXTRACT(DATE,2,7)
- SET X=$SELECT(X1=2:19,X1=3:20,X1=4:21)_X2
- +9 QUIT X
- +10 ;
- GETLIST(ID,RGSPEC,IFLD,ICT) ; build legal values list for input field ID
- +1 NEW TAG
- +2 ; strip decimal if present
- SET ID=ID\1
- SET TAG="GET"_ID
- +3 IF $TEXT(@TAG)]""
- DO @(TAG_"()")
- +4 QUIT
- GETLIST2(IDVAL,TXT) ; add one entry to the values list; called from each GETNN subrtn
- +1 SET ICT=ICT+1
- +2 SET RGSPEC(IFLD,ICT)="<ListValue ID="_QUOTE_IDVAL_QUOTE_">"_TXT_"</ListValue>"
- +3 QUIT
- +4 ;
- GETNN ; return list of valid values for each given field ien
- +1 ; NN = field ien inside the List subsystem;
- GET5() ; Priority
- +1 NEW ID,TXT,URGORD,VALSTR
- +2 SET X=$GET(^MAG(2006.69,1,1))
- SET URGORD=$PIECE(X,U)
- +3 if URGORD=""
- SET URGORD="S,U,P,R"
- SET URGORD=$TRANSLATE(URGORD,",")
- +4 SET VALSTR=""
- +5 FOR I=1:1:$LENGTH(URGORD)
- Begin DoDot:1
- +6 SET X=$EXTRACT(URGORD,I)
- SET T=$SELECT(X="S":"Stat",X="U":"Urg",X="P":"PreOp",1:"Rout")
- +7 SET T=I_"-"_T
- SET T=T_"~"_T
- +8 SET VALSTR=VALSTR_$SELECT(VALSTR="":"",1:U)_T
- End DoDot:1
- +9 IF VALSTR]""
- Begin DoDot:1
- +10 DO GETLIST2("","- -")
- +11 FOR I=1:1:$LENGTH(VALSTR,U)
- Begin DoDot:2
- +12 SET X=$PIECE(VALSTR,U,I)
- SET ID=$PIECE(X,"~")
- SET TXT=$PIECE(X,"~",2)
- +13 DO GETLIST2(ID,TXT)
- End DoDot:2
- End DoDot:1
- +14 QUIT
- GET8() ; Status
- +1 NEW ID,TXT,VALSTR
- +2 SET X="READY FOR INTERP"
- +3 ; Different string for Jordan
- IF $$UJOCHECK^ISIJUTL9()
- SET X="US WAITING"
- +4 ; P106 add R; P109 (X=Jordan string vs default)
- SET VALSTR="9~COMPLETE^I~INTERPRETED^E~EXAMINED^1~WAITING^R~"_X
- +5 IF VALSTR]""
- Begin DoDot:1
- +6 DO GETLIST2("","- -")
- +7 FOR I=1:1:$LENGTH(VALSTR,U)
- Begin DoDot:2
- +8 SET X=$PIECE(VALSTR,U,I)
- SET ID=$PIECE(X,"~")
- SET TXT=$PIECE(X,"~",2)
- +9 DO GETLIST2(ID,TXT)
- End DoDot:2
- End DoDot:1
- +10 QUIT
- GET11() ; Imaging Loc
- +1 NEW DATA,IDAT,SCR
- +2 ; filter for Locs at the user logon division
- SET SCR="I $P($G(^(""DIV"")),U)=DUZ(2)"
- +3 DO LIST^DIC(79.1,,"@;.01","P",,,,,SCR,,"DATA")
- +4 IF +$GET(DATA("DILIST",0))
- Begin DoDot:1
- +5 DO GETLIST2("","- -")
- +6 SET IDAT=0
- FOR
- SET IDAT=$ORDER(DATA("DILIST",IDAT))
- if IDAT=""
- QUIT
- SET X=DATA("DILIST",IDAT,0)
- DO GETLIST2($PIECE(X,U),$PIECE(X,U,2))
- End DoDot:1
- +7 QUIT
- GET15() ; Modality
- +1 NEW DATA,IDAT,TOPMDLS,I
- +2 SET TOPMDLS="CR^CT^DX^MR^MG^NM^RF^US^XA"
- +3 DO LIST^DIC(73.1,,"@;.01","P",,,,,"I $P(^(0),U,3)=""""",,"DATA")
- +4 DO GETLIST2("","- -")
- +5 DO GETLIST2("CR,DX","CR or DX")
- +6 FOR I=1:1:$LENGTH(TOPMDLS,U)
- SET X=$PIECE(TOPMDLS,U,I)
- SET TOPMDLS(X)=""
- DO GETLIST2(X,X)
- +7 SET IDAT=0
- FOR
- SET IDAT=$ORDER(DATA("DILIST",IDAT))
- if IDAT=""
- QUIT
- SET X=$PIECE(DATA("DILIST",IDAT,0),U,2)
- IF '$DATA(TOPMDLS(X))
- DO GETLIST2(X,X)
- +8 QUIT
- GET17() ; Type of Imaging
- +1 NEW DATA,IDAT
- +2 DO LIST^DIC(79.2,,"@;3;.01","P",,,,,,,"DATA")
- +3 IF +$GET(DATA("DILIST",0))
- Begin DoDot:1
- +4 DO GETLIST2("","- -")
- +5 SET IDAT=0
- FOR
- SET IDAT=$ORDER(DATA("DILIST",IDAT))
- if IDAT=""
- QUIT
- SET X=DATA("DILIST",IDAT,0)
- DO GETLIST2($PIECE(X,U),$PIECE(X,U,3))
- End DoDot:1
- +6 QUIT
- GET24() ; Radiologist
- +1 NEW ID,TXT,VALSTR
- +2 SET VALSTR="1~Is me^0~Is NOT me^-1~Is not entered"
- +3 DO GETLIST2("","- -")
- +4 FOR I=1:1:$LENGTH(VALSTR,U)
- SET X=$PIECE(VALSTR,U,I)
- SET ID=$PIECE(X,"~")
- SET TXT=$PIECE(X,"~",2)
- DO GETLIST2(ID,TXT)
- +5 QUIT
- GET201() ; Assigned to
- +1 NEW ID,TXT,VALSTR
- +2 SET VALSTR="1~Me^0~NOT me^2~Anyone^-1~NOT entered"
- +3 DO GETLIST2("","- -")
- +4 FOR I=1:1:$LENGTH(VALSTR,U)
- SET X=$PIECE(VALSTR,U,I)
- SET ID=$PIECE(X,"~")
- SET TXT=$PIECE(X,"~",2)
- DO GETLIST2(ID,TXT)
- +5 QUIT
- GET208() ; Patient Sex
- +1 NEW IDVAL,TXT,VALSTR
- +2 SET VALSTR="F~FEMALE^M~MALE"
- +3 DO GETLIST2("","- -")
- +4 FOR I=1:1:$LENGTH(VALSTR,U)
- SET X=$PIECE(VALSTR,U,I)
- SET IDVAL=$PIECE(X,"~")
- SET TXT=$PIECE(X,"~",2)
- DO GETLIST2(IDVAL,TXT)
- +5 QUIT
- +6 ;
- GETOPS(ID,RGSPEC,IFLD,ICT) ; build legal Operator values list for input field ID
- +1 NEW TAG
- +2 ; strip decimal if present
- SET ID=ID\1
- SET TAG="OPS"_ID
- +3 IF $TEXT(@TAG)]""
- DO @(TAG_"()")
- +4 QUIT
- GETOPS2(IDVAL,TXT) ; add one entry to the operator list
- +1 SET ICT=ICT+1
- +2 SET RGSPEC(IFLD,ICT)="<OpValue ID="_QUOTE_IDVAL_QUOTE_">"_TXT_"</OpValue>"
- +3 QUIT
- +4 ;
- OPSNN ; NN = field ien inside the Operator subsystem
- +1 ; * --> make sure operator values are accounted for in
- +2 ; subrtn qrspecs2 &/or QRSNN codelets as applies
- OPSSTR(VALSTR) ;
- +1 IF VALSTR]""
- IF (VALSTR["~")
- Begin DoDot:1
- +2 NEW ID,TXT,X
- +3 FOR I=1:1:$LENGTH(VALSTR,U)
- SET X=$PIECE(VALSTR,U,I)
- SET ID=$PIECE(X,"~")
- SET TXT=$PIECE(X,"~",2)
- DO GETOPS2(ID,TXT)
- End DoDot:1
- +4 QUIT
- OPS6() ; Procedure operators
- +1 NEW VALSTR
- +2 SET VALSTR="C~Contains^E~Equals"
- +3 DO OPSSTR(VALSTR)
- +4 QUIT
- OPS9() ; # Images operators
- +1 NEW VALSTR
- +2 SET VALSTR="G~Greater than^L~Less than^E~Equals"
- +3 DO OPSSTR(VALSTR)
- +4 QUIT
- ZZOPS8() ; <*> Status operators (zz intentional--this used ONLY for TESTING of ops w/ List data type)
- +1 NEW VALSTR
- +2 SET VALSTR="E~Equals^C~Contains"
- +3 DO OPSSTR(VALSTR)
- +4 QUIT
- +5 ;
- +6 ; 3 tables below provide details for each prompt, w/in prompt regions
- +7 ; 1st line has region tag name & optional parameters ();
- +8 ; lines 2:n have prompt specs
- +9 ; prompt specs as follows (MUST line up w/ "TAGS" variable in the "PROMPTS" subroutine)
- +10 ; note that the 1st 3 values are ALWAYS REQUIRED to be filled in
- +11 ; ID ^ LABEL ^ DATA_TYPE ^ AUTOFILL ^ REQUIRED ^ DISPLAYONLY ^ LOWER_LIMIT ^ UPPER_LIMIT
- +12 ; ^ HELP_TEXT ^ OPERATOR ^ AUTOFILL_OP ^ COL_WIDTH_PCT ^ ALLOW_MULTIPLE
- +13 ; Notes:
- +14 ; - COL_WIDTH_PCT values only in prhdr region & are REQUIRED & must total 100
- +15 ; - ALLOW_MULTIPLE values may only appear in prlstopt region
- +16 ; - PROMPTS_LIST_COLUMNS_PCT values only appears in prlst region;
- +17 ; values total 100; defines column-widths for the table
- +18 ; control where these prompts are rendered
- +19 ; - LOWER_LIMIT for Field ID 7.1 may be overridden by a
- +20 ; Site Parameter setting; see code at tag prompts2
- +21 ;
- PRHDR ; ^3^5^6^7^8^9^11^15^17^24^201^207^208^
- +1 ;;PROMPTS_HEADER;
- +2 ;;7.1^Study Date From^DATE^TODAY^1^^19981001^TODAY^^^^10
- +3 ;;7.2^Date To^DATE^TODAY^1^^19981001^TODAY^^^^10
- +4 ;;17^ > Type of Imaging^LIST^^^^^^^^^10
- +5 ;;208^ > Sex^LIST^^^^^^^^^7
- +6 ;;3^ > Patient Name matches^FREE_TEXT^^^^^^Enter Last, First (partial name OK)^^^25
- +7 ;;24^ > Radiologist^LIST^^^^^^^^^7
- +8 ;;201^ > Assigned to^LIST^^^^^^^^^7
- +9 ;;8^ > Status^LIST^^^^^^^^^5^1
- +10 ;;11^ > Imaging Loc^LIST^^^^^^^^^10
- +11 ;;*END
- +12 ;; <*> below lines for test DB convenience--> copy into above spaces when testing
- +13 ;;7.1^Study Date From^DATE^20080101^1^^20080101^TODAY^^^^12
- +14 ;;7.2^Date To^DATE^TODAY^1^^20090101^TODAY^^^^12
- PRLST ;
- +1 ;;PROMPTS_LIST;PROMPTS_LIST_COLUMNS_PCT="24,22,54"
- +2 ;;207.1^ > Patient Age from^NUMERIC^^^^0^130^Enter Patient 'age from'^^^
- +3 ;;207.2^ > Patient Age to^NUMERIC^^^^0^130^Enter Patient 'age to'^^^
- +4 ;;15^Modality^LIST
- +5 ;;6^Procedure^FREE_TEXT^^^^^^Enter some portion of the Procedure name, e.g., CHEST^OPLIST^^^
- +6 ;;9.1^# Images GREATER than or Equal to^NUMERIC^^^^0^99999^^
- +7 ;;9.2^# Images LESS than or Equal to^NUMERIC^^^^0^99999^^
- +8 ;;*END
- PRLSTOPT ; <*> Note--> when adding new fields, insert in Alphabetical Order
- +1 ;;PROMPTS_LIST_OPTIONAL;
- +2 ;;11^ > Imaging Loc^LIST^^^^^^^^^1
- +3 ;;15^Modality^LIST^^^^^^^^^^1
- +4 ;;3^ > Patient Name matches^FREE_TEXT^^^^^^^^^^1
- +5 ;;5^Priority^LIST^^^^^^^^^^1
- +6 ;;6^Procedure^FREE_TEXT^^^^^^Enter some portion of the Procedure name, e.g., CHEST^OPLIST^^^1
- +7 ;;8^ > Status^LIST^^^^^^^^^^1
- +8 ;;17^ > Type of Imaging^LIST^^^^^^^^^^1
- +9 ;;*END