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 Sep 02, 2024@18:32 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 ;
