Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ISIJLS2B

ISIJLS2B.m

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