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

PXRMLRED.m

Go to the documentation of this file. 
  1. PXRMLRED ; SLC/PJH - List Rule Editor ;05/30/2006
  1.  ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
  1.  ;
  1.  ;Main entry point for PXRM LIST RULE EDIT/DISPLAY
  1. START(IEN,PXRMTYP) ;
  1.  N PXRMDONE,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
  1.  S X="IORESET"
  1.  D ENDR^%ZISS
  1.  S VALMCNT=0
  1.  D EN^VALM("PXRM LIST RULE DISPLAY/EDIT")
  1.  Q
  1.  ;
  1. ADD ;Add Rule
  1.  N DA,DIC,DONE,DTOUT,DUOUT,DLAYGO,HED,TYP,Y
  1.  S HED="ADD "_$$TXT,TYP=PXRMTYP,DONE=0
  1.  W IORESET,!
  1.  F  D  Q:$D(DTOUT)  Q:DONE
  1.  .S DIC="^PXRM(810.4,"
  1.  .;Set the starting place for additions.
  1.  .D SETSTART^PXRMCOPY(DIC)
  1.  .S DIC(0)="AELMQ",DLAYGO=810.4
  1.  .S DIC("A")="Select "_$$TXT_" to add: "
  1.  .S DIC("DR")=".03///"_TYP
  1.  .D ^DIC
  1.  .I $D(DUOUT) S DTOUT=1
  1.  .I ($D(DTOUT))!($D(DUOUT)) Q
  1.  .I Y=-1 K DIC S DTOUT=1 Q
  1.  .I $P(Y,U,3)'=1 W !,"This rule name already exists" Q
  1.  .S DA=$P(Y,U,1)
  1.  .;Edit Rule
  1.  .D EDIT(DA,TYP)
  1.  .S:$D(DA) DONE=1
  1.  Q
  1.  ;
  1. BLDLIST(IEN,TYP) ;Build workfile
  1.  N FLDS,GBL,PXRMROOT
  1.  I TYP=1 S FLDS="[PXRM FINDING RULE]"
  1.  I TYP=2 S FLDS="[PXRM REMINDER RULE]"
  1.  I TYP=3 S FLDS="[PXRM RULE SET]"
  1.  I TYP=5 S FLDS="[PXRM PATIENT LIST RULE]"
  1.  S GBL="^TMP(""PXRMLRED"",$J)"
  1.  S GBL=$NA(@GBL)
  1.  S PXRMROOT="^PXRM(810.4,"
  1.  K ^TMP("PXRMLRED",$J)
  1.  D DIP^PXRMUTIL(GBL,IEN,PXRMROOT,FLDS)
  1.  S VALMCNT=$O(^TMP("PXRMLRED",$J,""),-1)
  1.  Q
  1.  ;
  1. EDIT(DA,TYP) ;Edit Rule
  1.  I '$$VEDIT^PXRMUTIL("^PXRM(810.4,",DA) D  Q
  1.  .W !!,?5,"VA- and national class rules may not be edited" H 2
  1.  .S VALMBCK="R"
  1.  ;
  1.  Q:'$$LOCK(DA)
  1.  W IORESET
  1.  N CS1,CS2,DIC,DIDEL,DIE,DR,DTOUT,DUOUT,ODA,Y
  1.  ;Save checksum
  1.  S CS1=$$FILE^PXRMEXCS(810.4,DA)
  1.  ;Check rule type
  1.  S DIE="^PXRM(810.4,",DIDEL=810.4,ODA=DA
  1.  ;List Rule
  1.  I TYP=1 S DR="[PXRM EDIT FINDING RULE]"
  1.  ;Reminder Rule
  1.  I TYP=2 S DR="[PXRM EDIT REMINDER RULE]"
  1.  ;Rule Set
  1.  I TYP=3 S DR="[PXRM EDIT RULE SET]"
  1.  ;Report Output Rule
  1.  I TYP=4 S DR="[PXRM EDIT REPORT OUTPUT RULE]"
  1.  ;Patient List Rule
  1.  I TYP=5 S DR="[PXRM EDIT PATIENT LIST RULE]"
  1.  ;Display any sets using the rule
  1.  I (TYP'=3) D USE(DA,1)
  1.  ;
  1.  ;Save list of components for rule set
  1.  I TYP=3 N COMP D COMP^PXRMLREX(DA,.COMP)
  1.  ;
  1.  ;Edit rule then unlock
  1.  D ^DIE,UNLOCK(ODA)
  1.  ;Deleted ???
  1.  I '$D(DA) D  Q
  1.  .;Option to delete components
  1.  .I TYP=3,$D(COMP) D DELETE^PXRMLREX(.COMP)
  1.  .S VALMBCK="Q"
  1.  ;
  1.  ;Update edit history
  1.  D
  1.  .S CS2=$$FILE^PXRMEXCS(810.4,DA) Q:CS2=CS1  Q:+CS2=0
  1.  .D SEHIST^PXRMUTIL(810.4,DIC,DA)
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. ENTRY ;Entry code
  1.  D BLDLIST(IEN,PXRMTYP)
  1.  Q
  1.  ;
  1. EXIT ;Exit code
  1.  K ^TMP("PXRMLRED",$J)
  1.  K ^TMP("PXRMLREDH",$J)
  1.  D CLEAN^VALM10
  1.  D FULL^VALM1
  1.  S VALMBCK="Q"
  1.  Q
  1.  ;
  1. HDR ; Header code
  1.  S VALMHDR(1)="Available "_$$LIT(PXRMTYP)_":"
  1.  S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
  1.  Q
  1.  ;
  1. HLP ;Help code
  1.  N ORU,ORUPRMT,SUB,XQORM
  1.  S SUB="PXRMLREDH"
  1.  D EN^VALM("PXRM LIST RULE HELP")
  1.  Q
  1.  ;
  1. INIT ;Init
  1.  S VALMCNT=0
  1.  Q
  1.  ;
  1. LIT(VIEW) ;Header text depnds on view
  1.  Q $S(PXRMTYP=3:"Rule Sets",PXRMTYP=1:"List Rules",PXRMTYP=2:"Reminder List Rules",1:"Unknown")
  1.  ;
  1. LOCK(DA) ;Lock the record
  1.  L +^PXRM(810.4,DA):0 I  Q 1
  1.  E  W !!,?5,"Another user is editing this file, try later" H 2 Q 0
  1.  ;
  1. LRDESC ;Display list rule fields - called by [PXRM RULE SET]
  1.  N IEN
  1.  S IEN=$P(X,U,2) Q:'IEN
  1.  D LROUT(IEN,23)
  1.  Q
  1.  ;
  1. LREDIT ;Edit Rule
  1.  D EDIT^PXRMLRED(IEN,PXRMTYP)
  1.  ;Rebuild Workfile
  1.  D BLDLIST(IEN,PXRMTYP)
  1.  Q
  1.  ;
  1. LREND(END,RJC) ;Display end date
  1.  I END]"" W !,$$RJ^XLFSTR("LR Ending Date: ",RJC)_END
  1.  Q
  1.  ;
  1. LROUT(IEN,RJC) ;Output list rule display
  1.  ;also called for parameter display from PXRMEPM
  1.  N BEG,DATA,END,LRN,PLIST,PLIEN,TERM,TIEN,TYPE
  1.  S DATA=$G(^PXRM(810.4,IEN,0))
  1.  S LRN=$P(DATA,U,1)
  1.  ;Type of list rule, start and end dates
  1.  S TYPE=$P(DATA,U,3),BEG=$P(DATA,U,4),END=$P(DATA,U,5)
  1.  W !,$$RJ^XLFSTR("List Rule: ",RJC),LRN
  1.  ;Display description
  1.  W !,$$RJ^XLFSTR("Description: ",RJC),$P(DATA,U,2)
  1.  ;Display Rule Type
  1.  W !,$$RJ^XLFSTR("Rule Type: ",RJC)
  1.  ;Finding Rule
  1.  I TYPE=1 D
  1.  .W "FINDING RULE"
  1.  .W !,$$RJ^XLFSTR("Reminder Term: ",RJC+2)
  1.  .S TIEN=$P(DATA,U,7) Q:'TIEN
  1.  .;Display Term name
  1.  .W $P($G(^PXRMD(811.5,TIEN,0)),U)
  1.  I TYPE=2 D
  1.  .W "REMINDER RULE"
  1.  .W !,$$RJ^XLFSTR("Reminder Definition: ",RJC+2)
  1.  .S RIEN=$P(DATA,U,10) Q:'RIEN
  1.  .;Display Reminder Defintion name
  1.  .W $P($G(^PXD(811.9,RIEN,0)),U,1)
  1.  ;Patient List Rule
  1.  I TYPE=5 D
  1.  .W "PATIENT LIST RULE"
  1.  .N EXISTPL,EXTRPL
  1.  .S EXISTPL=$P(DATA,U,8)
  1.  .I EXISTPL]"" D
  1.  .. S EXISTPL=$P(^PXRMXP(810.5,EXISTPL,0),U,1)
  1.  .. W !,$$RJ^XLFSTR("Use Existing PT List: ",RJC+2),EXISTPL
  1.  .S EXTRPL=$G(^PXRM(810.4,IEN,1))
  1.  .I EXTRPL]"" W !,$$RJ^XLFSTR("Use Extract PT List Named: ",RJC+5)
  1.  .I (RJC+5+$L(EXTRPL))>80 W !,"  "
  1.  .W EXTRPL
  1.  ;Format Start and Stop Dates
  1.  D LRSTRT(BEG,RJC+2),LREND(END,RJC+2)
  1.  Q
  1.  ;
  1. LRSTRT(BEG,RJC) ;Display start date
  1.  I BEG]"" W !,$$RJ^XLFSTR("LR Beginning Date: ",RJC)_BEG
  1.  Q
  1.  ;
  1. PEXIT ;PXRM EXCH MENU protocol exit code
  1.  S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
  1.  ;Reset after page up/down etc
  1.  Q
  1.  ;
  1. SCREEN ;validate rule type
  1.  Q:'$G(DA(1))
  1.  ;rule sets may not be a component of a rule set
  1.  I $P($G(^PXRM(810.4,DA(1),0)),U,3) S DIC("S")="I $P(^(0),U,3)'=3"
  1.  Q
  1.  ;
  1. SEQPRT ;Display list rule sequence fields - called by [PXRM RULE SET]
  1.  N EXTRPL,IND,LR,LRN,OPER,RJC,RR
  1.  N SEQ,SEQBDT,SEQEDT,TEMP,TEXT
  1.  S RJC=22
  1.  S SEQ=""
  1.  F  S SEQ=$O(^PXRM(810.4,D0,30,"B",SEQ)) Q:SEQ=""  D
  1.  . S IND=$O(^PXRM(810.4,D0,30,"B",SEQ,""))
  1.  . S TEMP=^PXRM(810.4,D0,30,IND,0)
  1.  . S LR=+$P(TEMP,U,2),OPER=$P(TEMP,U,3)
  1.  . S OPER=$$EXTERNAL^DILFD(810.41,.03,"",OPER)
  1.  . S TEMP=$G(^PXRM(810.4,D0,30,IND,1))
  1.  . S SEQBDT=$P(TEMP,U,1),SEQEDT=$P(TEMP,U,2)
  1.  . S EXTRPL=$G(^PXRM(810.4,D0,1))
  1.  . ;Output the sequence fields
  1.  . W !!,$$RJ^XLFSTR("Sequence: ",RJC),SEQ
  1.  . I SEQBDT]"" W !,$$RJ^XLFSTR("Seq Beginning Date: ",RJC),SEQBDT
  1.  . I SEQEDT]"" W !,$$RJ^XLFSTR("Seq Ending Date: ",RJC),SEQEDT
  1.  . W !,$$RJ^XLFSTR("Operation: ",RJC),OPER
  1.  .;Output the List Rule information
  1.  . D LROUT^PXRMLRED(LR,RJC)
  1.  Q
  1.  ;
  1. TXT() ;Return Rule Type text
  1.  N TEXT
  1.  S TEXT="OTHER"
  1.  I PXRMTYP=1 S TEXT="FINDING RULE"
  1.  I PXRMTYP=2 S TEXT="REMINDER DEFINITION RULE"
  1.  I PXRMTYP=3 S TEXT="RULE SET"
  1.  I PXRMTYP=5 S TEXT="PATIENT LIST RULE"
  1.  Q TEXT
  1.  ;
  1. UNLOCK(DA) ;Unlock the record
  1.  L -^PXRM(810.4,DA)
  1.  Q
  1.  ;
  1. USE(DA,EDIT) ;Display usage of list rule
  1.  N TTAB
  1.  S TAB=$S(EDIT:0,1:7)
  1.  W !!,?TAB,"Used by:"
  1.  ;If the AD cross ref is missing this is not used
  1.  I '$D(^PXRM(810.4,"AD",DA)) W " Not used by any rule set",! Q
  1.  ;
  1.  N LRNAM,LRTYP,PXRMTYP
  1.  S TAB=TAB+10
  1.  ;Check if used by any rule sets
  1.  S SUB=0
  1.  F  S SUB=$O(^PXRM(810.4,"AD",DA,SUB)) Q:'SUB  D
  1.  .S DATA=$G(^PXRM(810.4,SUB,0)) Q:DATA=""
  1.  .S LRNAM=$P(DATA,U) Q:LRNAM=""
  1.  .S PXRMTYP=$P(DATA,U,3),LRTYP=$$TXT^PXRMLRED
  1.  .W ?TAB,LRNAM_" ("_LRTYP_")",!
  1.  Q
  1.  ;
  1. USET ;Usage display called from PXRM LIST RULE print template
  1.  D USE(IEN,0)
  1.  Q
  1.  ;