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