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

PXRMLRM.m

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