- PXRMLRM ; SLC/PJH/PKR - List Rule Management ; 03/06/2009
- ;;2.0;CLINICAL REMINDERS;**4,6,12**;Feb 04, 2005;Build 73
- ;
- ;Main entry point for PXRM LIST RULE MANAGEMENT
- START N IND,PXRMDONE,PXRMTYP,VALMBCK,VALMBGS,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
- S X="IORESET"
- D ENDR^%ZISS
- S VALMCNT=0
- ;Default view is Rule Sets
- S PXRMTYP=3
- ;Initialize list positions.
- F IND=1:1:5 S VALMBGS(IND)=1
- D EN^VALM("PXRM LIST RULE MANAGEMENT")
- Q
- ;
- BLDLIST ;Build workfile
- K ^TMP("PXRMLRM",$J)
- N IEN,IND,PLIST
- D LIST(.PLIST,.IEN,PXRMTYP)
- M ^TMP("PXRMLRM",$J)=PLIST
- S VALMCNT=PLIST("VALMCNT")
- F IND=1:1:VALMCNT S ^TMP("PXRMLRM",$J,"IDX",IND,IND)=IEN(IND)
- I PXRMTYP=1 D CHGCAP^VALM("HEADER2","Finding Rule Name")
- I PXRMTYP=2 D CHGCAP^VALM("HEADER2","Reminder Rule Name")
- I PXRMTYP=3 D CHGCAP^VALM("HEADER2","Rule Set Name")
- I PXRMTYP=4 D CHGCAP^VALM("HEADER2","Report Output Rule Name")
- I PXRMTYP=5 D CHGCAP^VALM("HEADER2","Patient List Rule Name")
- S VALMBG=VALMBGS(PXRMTYP)
- Q
- ;
- ENTRY ;Entry code
- D BLDLIST,XQORM
- Q
- ;
- EXIT ;Exit code
- K ^TMP("PXRMLRM",$J)
- K ^TMP("PXRMLRMH",$J)
- D CLEAN^VALM10
- D FULL^VALM1
- S VALMBCK="Q"
- Q
- ;
- FRE(NUMBER,NAME,CLASS) ;Format entry number, name
- ;and date packed.
- N TCLASS,TEMP,TNAME,TSOURCE
- S TEMP=$$RJ^XLFSTR(NUMBER,5," ")
- S TNAME=$E(NAME,1,60)
- S TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,60," ")
- S TCLASS=$S(CLASS="N":"NATIONAL",CLASS="V":"VISN",1:"LOCAL")
- S TEMP=TEMP_" "_TCLASS
- Q TEMP
- ;
- HDR ; Header code
- S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
- Q
- ;
- HELP(CALL) ;General help text routine
- N HTEXT
- I CALL=1 D
- .S HTEXT(1)="Select DE to display or edit a rule.\\"
- .S HTEXT(2)="Select ED to edit a rule.\\"
- ;
- I CALL=2 D
- .S HTEXT(1)="Select F to edit term based finding rules.\\"
- .S HTEXT(2)="Select P to edit patient list based finding rules.\\"
- .S HTEXT(3)="Select R to edit reminder rules.\\"
- .S HTEXT(4)="Select S to edit rule sets. A rule set may contain"
- .S HTEXT(5)="any of the following:\\"
- .S HTEXT(6)=" finding list rules, patient list rules, reminder rules\\"
- .S HTEXT(7)="These component list rules must be created before the rule set"
- .S HTEXT(8)="can be constructed."
- ;
- D HELP^PXRMEUT(.HTEXT)
- Q
- ;
- HLP ;Help code
- N ORU,ORUPRMT,SUB,XQORM
- S SUB="PXRMLRMH"
- D EN^VALM("PXRM LIST RULE HELP")
- Q
- ;
- INIT ;Init
- S VALMCNT=0
- Q
- ;
- LIST(RLIST,IEN,LRTYP) ;Build a list of list rule entries.
- N DATA,IND,LRCLASS,LRNAME,NAME
- ;Build the list in alphabetical order.
- S VALMCNT=0
- S NAME=""
- F S NAME=$O(^PXRM(810.4,"B",NAME)) Q:NAME="" D
- .S IND=$O(^PXRM(810.4,"B",NAME,"")) Q:'IND
- .S DATA=$G(^PXRM(810.4,IND,0))
- .I $P(DATA,U,3)'=LRTYP Q
- .S LRNAME=$P(DATA,U)
- .S LRCLASS=$P($G(^PXRM(810.4,IND,100)),U)
- .S VALMCNT=VALMCNT+1
- .S RLIST(VALMCNT,0)=$$FRE(VALMCNT,LRNAME,LRCLASS)
- .S IEN(VALMCNT)=IND
- S RLIST("VALMCNT")=VALMCNT
- Q
- ;
- LRADD ;Add Rule Option
- ;
- ;Reset Screen Mode
- W IORESET
- ;
- ;Add Rule
- D ADD^PXRMLRED
- ;
- ;Rebuild Workfile
- D BLDLIST
- S VALMBCK="R"
- Q
- ;
- LRINQ ;Rule Inquiry - PXRM LIST RULE DISPLAY/EDIT entry
- N IND,LRIEN,VALMY
- D EN^VALM2(XQORNOD(0))
- ;If there is no list quit.
- I '$D(VALMY) Q
- S PXRMDONE=0
- S IND=""
- F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
- .;Get the ien.
- .S LRIEN=^TMP("PXRMLRM",$J,"IDX",IND,IND)
- .D START^PXRMLRED(LRIEN,PXRMTYP)
- D BLDLIST
- S VALMBCK="R"
- Q
- ;
- PEXIT ;Protocol exit code
- S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
- ;Reset after page up/down etc
- D XQORM
- Q
- ;
- VIEW ;Select view
- W IORESET
- S VALMBCK="R"
- N X,Y,CODE,DIR
- ;Save current position in list before changing the view
- S VALMBGS(PXRMTYP)=VALMBG
- K DIROUT,DIRUT,DTOUT,DUOUT
- S DIR(0)="S"_U_"F:Finding Rule;"
- S DIR(0)=DIR(0)_"P:Patient List Rule;"
- S DIR(0)=DIR(0)_"R:Reminder Rule;"
- S DIR(0)=DIR(0)_"S:Rule Set;"
- S DIR("A")="TYPE OF VIEW"
- S DIR("B")="F"
- S DIR("?")="Select from the codes displayed. For detailed help type ??"
- S DIR("??")=U_"D HELP^PXRMLRM(2)"
- D ^DIR K DIR
- I $D(DIROUT) S DTOUT=1
- I $D(DTOUT)!($D(DUOUT)) Q
- ;Change display type
- S PXRMTYP=$S(Y="F":1,Y="P":5,Y="S":3,1:4)
- S PXRMTYP=$S(Y="F":1,Y="P":5,Y="S":3,Y="R":2,1:4)
- ;Rebuild Workfile
- D BLDLIST,HDR
- Q
- ;
- XSEL ;PXRM LIST RULE MANAGEMENT SELECT ENTRY validation
- N SEL,IEN
- S SEL=$P(XQORNOD(0),"=",2)
- ;Remove trailing ,
- I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
- ;Invalid selection
- I SEL["," D Q
- .W $C(7),!,"Only one item number allowed." H 2
- .S VALMBCK="R"
- I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D Q
- .W $C(7),!,SEL_" is not a valid item number." H 2
- .S VALMBCK="R"
- ;
- ;Get the list ien.
- S IEN=^TMP("PXRMLRM",$J,"IDX",SEL,SEL)
- ;
- ;Option to Display/Edit or Test Rule Set.
- N DIR,OPTION,RIEN,X,Y
- K DIROUT,DIRUT,DTOUT,DUOUT
- S DIR(0)="SBM"_U_"DR:Display/Edit Rule;"
- I $G(PXRMTYP)=3 S DIR(0)=DIR(0)_"TEST:Test Rule Set"
- S DIR("A")="Select Action: "
- S DIR("B")="DR"
- S DIR("?")="Select from the codes displayed."
- D ^DIR K DIR
- I $D(DIROUT) S DTOUT=1
- I $D(DTOUT)!($D(DUOUT)) S VALMBCK="R" Q
- S OPTION=Y
- I $G(OPTION)="" G XSELE
- ;
- ;Display/Edit
- I OPTION="DR" D START^PXRMLRED(IEN,PXRMTYP)
- Q:$D(DUOUT)!$D(DTOUT)
- ;
- ;Rule set test
- I OPTION="TEST" D RSTEST^PXRMRST(IEN)
- Q:$D(DUOUT)!$D(DTOUT)
- ;
- XSELE ;
- D CLEAN^VALM10
- D BLDLIST,XQORM
- S VALMBCK="R"
- Q
- ;
- XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM LIST RULE MANAGEMENT SELECT ENTRY",0))_U_"1:"_VALMCNT
- S XQORM("A")="Select Item: "
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMLRM 5542 printed Feb 18, 2025@23:13:02 Page 2
- PXRMLRM ; SLC/PJH/PKR - List Rule Management ; 03/06/2009
- +1 ;;2.0;CLINICAL REMINDERS;**4,6,12**;Feb 04, 2005;Build 73
- +2 ;
- +3 ;Main entry point for PXRM LIST RULE MANAGEMENT
- START NEW IND,PXRMDONE,PXRMTYP,VALMBCK,VALMBGS,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
- +1 SET X="IORESET"
- +2 DO ENDR^%ZISS
- +3 SET VALMCNT=0
- +4 ;Default view is Rule Sets
- +5 SET PXRMTYP=3
- +6 ;Initialize list positions.
- +7 FOR IND=1:1:5
- SET VALMBGS(IND)=1
- +8 DO EN^VALM("PXRM LIST RULE MANAGEMENT")
- +9 QUIT
- +10 ;
- BLDLIST ;Build workfile
- +1 KILL ^TMP("PXRMLRM",$JOB)
- +2 NEW IEN,IND,PLIST
- +3 DO LIST(.PLIST,.IEN,PXRMTYP)
- +4 MERGE ^TMP("PXRMLRM",$JOB)=PLIST
- +5 SET VALMCNT=PLIST("VALMCNT")
- +6 FOR IND=1:1:VALMCNT
- SET ^TMP("PXRMLRM",$JOB,"IDX",IND,IND)=IEN(IND)
- +7 IF PXRMTYP=1
- DO CHGCAP^VALM("HEADER2","Finding Rule Name")
- +8 IF PXRMTYP=2
- DO CHGCAP^VALM("HEADER2","Reminder Rule Name")
- +9 IF PXRMTYP=3
- DO CHGCAP^VALM("HEADER2","Rule Set Name")
- +10 IF PXRMTYP=4
- DO CHGCAP^VALM("HEADER2","Report Output Rule Name")
- +11 IF PXRMTYP=5
- DO CHGCAP^VALM("HEADER2","Patient List Rule Name")
- +12 SET VALMBG=VALMBGS(PXRMTYP)
- +13 QUIT
- +14 ;
- ENTRY ;Entry code
- +1 DO BLDLIST
- DO XQORM
- +2 QUIT
- +3 ;
- EXIT ;Exit code
- +1 KILL ^TMP("PXRMLRM",$JOB)
- +2 KILL ^TMP("PXRMLRMH",$JOB)
- +3 DO CLEAN^VALM10
- +4 DO FULL^VALM1
- +5 SET VALMBCK="Q"
- +6 QUIT
- +7 ;
- FRE(NUMBER,NAME,CLASS) ;Format entry number, name
- +1 ;and date packed.
- +2 NEW TCLASS,TEMP,TNAME,TSOURCE
- +3 SET TEMP=$$RJ^XLFSTR(NUMBER,5," ")
- +4 SET TNAME=$EXTRACT(NAME,1,60)
- +5 SET TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,60," ")
- +6 SET TCLASS=$SELECT(CLASS="N":"NATIONAL",CLASS="V":"VISN",1:"LOCAL")
- +7 SET TEMP=TEMP_" "_TCLASS
- +8 QUIT TEMP
- +9 ;
- HDR ; Header code
- +1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
- +2 QUIT
- +3 ;
- HELP(CALL) ;General help text routine
- +1 NEW HTEXT
- +2 IF CALL=1
- Begin DoDot:1
- +3 SET HTEXT(1)="Select DE to display or edit a rule.\\"
- +4 SET HTEXT(2)="Select ED to edit a rule.\\"
- End DoDot:1
- +5 ;
- +6 IF CALL=2
- Begin DoDot:1
- +7 SET HTEXT(1)="Select F to edit term based finding rules.\\"
- +8 SET HTEXT(2)="Select P to edit patient list based finding rules.\\"
- +9 SET HTEXT(3)="Select R to edit reminder rules.\\"
- +10 SET HTEXT(4)="Select S to edit rule sets. A rule set may contain"
- +11 SET HTEXT(5)="any of the following:\\"
- +12 SET HTEXT(6)=" finding list rules, patient list rules, reminder rules\\"
- +13 SET HTEXT(7)="These component list rules must be created before the rule set"
- +14 SET HTEXT(8)="can be constructed."
- End DoDot:1
- +15 ;
- +16 DO HELP^PXRMEUT(.HTEXT)
- +17 QUIT
- +18 ;
- HLP ;Help code
- +1 NEW ORU,ORUPRMT,SUB,XQORM
- +2 SET SUB="PXRMLRMH"
- +3 DO EN^VALM("PXRM LIST RULE HELP")
- +4 QUIT
- +5 ;
- INIT ;Init
- +1 SET VALMCNT=0
- +2 QUIT
- +3 ;
- LIST(RLIST,IEN,LRTYP) ;Build a list of list rule entries.
- +1 NEW DATA,IND,LRCLASS,LRNAME,NAME
- +2 ;Build the list in alphabetical order.
- +3 SET VALMCNT=0
- +4 SET NAME=""
- +5 FOR
- SET NAME=$ORDER(^PXRM(810.4,"B",NAME))
- if NAME=""
- QUIT
- Begin DoDot:1
- +6 SET IND=$ORDER(^PXRM(810.4,"B",NAME,""))
- if 'IND
- QUIT
- +7 SET DATA=$GET(^PXRM(810.4,IND,0))
- +8 IF $PIECE(DATA,U,3)'=LRTYP
- QUIT
- +9 SET LRNAME=$PIECE(DATA,U)
- +10 SET LRCLASS=$PIECE($GET(^PXRM(810.4,IND,100)),U)
- +11 SET VALMCNT=VALMCNT+1
- +12 SET RLIST(VALMCNT,0)=$$FRE(VALMCNT,LRNAME,LRCLASS)
- +13 SET IEN(VALMCNT)=IND
- End DoDot:1
- +14 SET RLIST("VALMCNT")=VALMCNT
- +15 QUIT
- +16 ;
- LRADD ;Add Rule Option
- +1 ;
- +2 ;Reset Screen Mode
- +3 WRITE IORESET
- +4 ;
- +5 ;Add Rule
- +6 DO ADD^PXRMLRED
- +7 ;
- +8 ;Rebuild Workfile
- +9 DO BLDLIST
- +10 SET VALMBCK="R"
- +11 QUIT
- +12 ;
- LRINQ ;Rule Inquiry - PXRM LIST RULE DISPLAY/EDIT entry
- +1 NEW IND,LRIEN,VALMY
- +2 DO EN^VALM2(XQORNOD(0))
- +3 ;If there is no list quit.
- +4 IF '$DATA(VALMY)
- QUIT
- +5 SET PXRMDONE=0
- +6 SET IND=""
- +7 FOR
- SET IND=$ORDER(VALMY(IND))
- if (+IND=0)!(PXRMDONE)
- QUIT
- Begin DoDot:1
- +8 ;Get the ien.
- +9 SET LRIEN=^TMP("PXRMLRM",$JOB,"IDX",IND,IND)
- +10 DO START^PXRMLRED(LRIEN,PXRMTYP)
- End DoDot:1
- +11 DO BLDLIST
- +12 SET VALMBCK="R"
- +13 QUIT
- +14 ;
- PEXIT ;Protocol exit code
- +1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
- +2 ;Reset after page up/down etc
- +3 DO XQORM
- +4 QUIT
- +5 ;
- VIEW ;Select view
- +1 WRITE IORESET
- +2 SET VALMBCK="R"
- +3 NEW X,Y,CODE,DIR
- +4 ;Save current position in list before changing the view
- +5 SET VALMBGS(PXRMTYP)=VALMBG
- +6 KILL DIROUT,DIRUT,DTOUT,DUOUT
- +7 SET DIR(0)="S"_U_"F:Finding Rule;"
- +8 SET DIR(0)=DIR(0)_"P:Patient List Rule;"
- +9 SET DIR(0)=DIR(0)_"R:Reminder Rule;"
- +10 SET DIR(0)=DIR(0)_"S:Rule Set;"
- +11 SET DIR("A")="TYPE OF VIEW"
- +12 SET DIR("B")="F"
- +13 SET DIR("?")="Select from the codes displayed. For detailed help type ??"
- +14 SET DIR("??")=U_"D HELP^PXRMLRM(2)"
- +15 DO ^DIR
- KILL DIR
- +16 IF $DATA(DIROUT)
- SET DTOUT=1
- +17 IF $DATA(DTOUT)!($DATA(DUOUT))
- QUIT
- +18 ;Change display type
- +19 SET PXRMTYP=$SELECT(Y="F":1,Y="P":5,Y="S":3,1:4)
- +20 SET PXRMTYP=$SELECT(Y="F":1,Y="P":5,Y="S":3,Y="R":2,1:4)
- +21 ;Rebuild Workfile
- +22 DO BLDLIST
- DO HDR
- +23 QUIT
- +24 ;
- XSEL ;PXRM LIST RULE MANAGEMENT SELECT ENTRY validation
- +1 NEW SEL,IEN
- +2 SET SEL=$PIECE(XQORNOD(0),"=",2)
- +3 ;Remove trailing ,
- +4 IF $EXTRACT(SEL,$LENGTH(SEL))=","
- SET SEL=$EXTRACT(SEL,1,$LENGTH(SEL)-1)
- +5 ;Invalid selection
- +6 IF SEL[","
- Begin DoDot:1
- +7 WRITE $CHAR(7),!,"Only one item number allowed."
- HANG 2
- +8 SET VALMBCK="R"
- End DoDot:1
- QUIT
- +9 IF ('SEL)!(SEL>VALMCNT)!('$DATA(@VALMAR@("IDX",SEL)))
- Begin DoDot:1
- +10 WRITE $CHAR(7),!,SEL_" is not a valid item number."
- HANG 2
- +11 SET VALMBCK="R"
- End DoDot:1
- QUIT
- +12 ;
- +13 ;Get the list ien.
- +14 SET IEN=^TMP("PXRMLRM",$JOB,"IDX",SEL,SEL)
- +15 ;
- +16 ;Option to Display/Edit or Test Rule Set.
- +17 NEW DIR,OPTION,RIEN,X,Y
- +18 KILL DIROUT,DIRUT,DTOUT,DUOUT
- +19 SET DIR(0)="SBM"_U_"DR:Display/Edit Rule;"
- +20 IF $GET(PXRMTYP)=3
- SET DIR(0)=DIR(0)_"TEST:Test Rule Set"
- +21 SET DIR("A")="Select Action: "
- +22 SET DIR("B")="DR"
- +23 SET DIR("?")="Select from the codes displayed."
- +24 DO ^DIR
- KILL DIR
- +25 IF $DATA(DIROUT)
- SET DTOUT=1
- +26 IF $DATA(DTOUT)!($DATA(DUOUT))
- SET VALMBCK="R"
- QUIT
- +27 SET OPTION=Y
- +28 IF $GET(OPTION)=""
- GOTO XSELE
- +29 ;
- +30 ;Display/Edit
- +31 IF OPTION="DR"
- DO START^PXRMLRED(IEN,PXRMTYP)
- +32 if $DATA(DUOUT)!$DATA(DTOUT)
- QUIT
- +33 ;
- +34 ;Rule set test
- +35 IF OPTION="TEST"
- DO RSTEST^PXRMRST(IEN)
- +36 if $DATA(DUOUT)!$DATA(DTOUT)
- QUIT
- +37 ;
- XSELE ;
- +1 DO CLEAN^VALM10
- +2 DO BLDLIST
- DO XQORM
- +3 SET VALMBCK="R"
- +4 QUIT
- +5 ;
- XQORM SET XQORM("#")=$ORDER(^ORD(101,"B","PXRM LIST RULE MANAGEMENT SELECT ENTRY",0))_U_"1:"_VALMCNT
- +1 SET XQORM("A")="Select Item: "
- +2 QUIT
- +3 ;