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

PXRMREDT.m

Go to the documentation of this file.
PXRMREDT ;SLC/PKR,PJH - Edit PXRM reminder definition. ;08/29/2018
 ;;2.0;CLINICAL REMINDERS;**4,6,12,18,26,47,45**;Feb 04, 2005;Build 566
 ;
 ;---------------
EEDIT ;Entry point for PXRM DEFINITION EDIT option.
 ;Build list of finding file definitions.
 N DA,DEF,DEF1,DEF2,DIC,NEW,Y
 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
 S DIC="^PXD(811.9,"
LOOP ;
 S Y=$$GETDEF
 I Y=-1 Q
 S DA=$P(Y,U,1)
 S NEW=$P(Y,U,3)
 D ALL(DIC,DA,.DEF1,NEW)
 G LOOP
 Q
 ;
 ;---------------
GETDEF() ;Let a user select a definition and return the IEN.
 N DA,DIC,DLAYGO,DTOUT,DUOUT,Y
 S DIC="^PXD(811.9,"
 S DIC(0)="AEMQL"
 S DIC("A")="Select Reminder Definition: "
 S DLAYGO=811.9
GETNAME ;Get the name of the reminder definition to edit.
 ;Set the starting place for additions.
 D SETSTART^PXRMCOPY(DIC)
 W !
 S DIC("W")="W $$LUDISP^PXRMREDT(Y)"
 D ^DIC
 I ($D(DTOUT))!($D(DUOUT)) Q -1
 Q Y
 ;
 ;---------------
 ;Select section of reminder to edit, also called at ALL by PXRMEDIT.
 ;----------------------------------
 ;ALL(DIC,DA,DEF1,NEW) ;
ALL(ROOT,DA,DEF1,NEW) ;
 ;Get list of findings/terms for reminder
 N BLDLOGIC,DIK,DIR,DTOUT,DUOUT,LIST,NODE,OPTION,TYPE
 ;Note that DIR is newed here because it may be defined from the
 ;definition copy and if it is defined it can cause ^DIE to not work
 ;properly.
STRTEDIT S BLDLOGIC=0
 ;Build finding list
 S NODE="^PXD(811.9)"
 D LIST(NODE,DA,.DEF1,.LIST)
 ;If this is a new reminder enter all fields
 I $G(NEW) D EDIT(ROOT,DA) Q 
 ;National reminder allows editing of term findings only 
 I '$$VEDIT^PXRMUTIL(ROOT,DA) D  Q:$D(DUOUT)!$D(DTOUT)
 .S TYPE=""
 .F  S TYPE=$O(LIST(TYPE)) Q:TYPE=""  D
 .. I TYPE="RT" Q
 .. K LIST(TYPE)
 .I '$D(LIST) S DUOUT=1 Q
 .S BLDLOGIC=1
 .D TFIND(DA,.LIST)
 .I $D(Y) S DUOUT=1
 ;Otherwise choose fields to edit
 I $$VEDIT^PXRMUTIL(ROOT,DA) F  D  Q:($G(OPTION)="^")!$D(DUOUT)!$D(DTOUT)
 .S OPTION=$$OPTION^PXRMREDT Q:(OPTION="^")!$D(DUOUT)!$D(DTOUT)
 .;All details
 .I OPTION="A" D
 .. S BLDLOGIC=1
 .. D EDIT(ROOT,DA)
 .;Set up local variables
 .N DIE,DR S DIE=ROOT N DIC
 .;Descriptions
 .I OPTION="G" D
 ..D GEN
 .;Baseline Frequency
 .I OPTION="B" D
 ..S BLDLOGIC=1
 ..D BASE
 .;Findings
 .I OPTION="F"  D
 ..S BLDLOGIC=1
 ..D FIND(.LIST)
 .;Function findings
 .I OPTION="FF"  D
 ..S BLDLOGIC=1
 ..D FFIND
 .;Logic
 .I OPTION="L" D
 ..S BLDLOGIC=1
 ..D LOGIC
 .;Custom date due
 . I OPTION="C" D
 ..S BLDLOGIC=1
 ..D CDUE
 .;Dialog
 .I OPTION="D" D
 ..D DIALOG
 .;Web addresses
 .I OPTION="W" D
 ..D WEB
 .;If necessary build the internal logic strings.
 .I BLDLOGIC D BLDALL^PXRMLOGX(DA,"","")
 . I '$D(^PXD(811.9,DA)) Q
 . I OPTION="^" G STRTEDIT
 . W !,"Checking integrity of the definition ...",#
 . N OUTPUT
 . I '$$DEF^PXRMICHK(DA,.OUTPUT,1) G STRTEDIT
 .;If it passes the integrity check save the edit history.
 . D SEHIST^PXRMUTIL(811.9,ROOT,DA)
 Q
 ;
 ;Reminder Edit
 ;---------------
EDIT(ROOT,DA) ;
 N DIC,DIDEL,DIE,DR,OUTPUT,RESULT
 S DIE=ROOT,DIDEL=811.9
 ;Edit the fields in the same order they are printed by a reminder
 ;inquiry.
 ;Reminder name
 W !!
 S DR=".01"
 D ^DIE
 ;If DA is undefined then the entry was deleted and we are done.
 I '$D(DA) S DTOUT=1 Q
 I $D(Y) S DTOUT=1 Q
 ;
 ;Other fields
 D GEN Q:$D(Y)
 D BASE Q:$D(Y)
 D FIND(.LIST) Q:$D(Y)
 D FFIND Q:$D(Y)
 D LOGIC Q:$D(Y)
 D DIALOG Q:$D(Y)
 D WEB Q:$D(Y)
 W #
 I '$D(^PXD(811.9,DA)) Q
 I '$$DEF^PXRMICHK(DA,.OUTPUT,1) G STRTEDIT
 ;If it passes the integrity check save the edit history.
 D SEHIST^PXRMUTIL(811.9,DIC,DA)
 Q
 ;
GEN ;Print name
 W !!
 S DR="1.2"
 D ^DIE
 I $D(Y) Q
 ;
CLASS ;
 ;Class
 W !!
 S DR="100"
 D ^DIE
 I $D(Y) Q
 ;Sponsor
 S DR="101"
 D ^DIE
 I $D(Y) Q
 ;Make sure Class and Sponsor Class are in synch.
 S RESULT=$$VSPONSOR^PXRMINTR(X)
 I RESULT=0 G CLASS
 ;Review date, Usage
 S DR="102;103"
 D ^DIE
 I $D(Y) Q
 ;
 ;Related VA-* reminder
 W !!
 S DR="1.4"
 D ^DIE
 I $D(Y) Q
 ;
 ;Inactive flag
 W !!
 S DR="1.6"
 D ^DIE
 I $D(Y) Q
 ;Ignore on N/A
 S DR=1.8
 D ^DIE
 I $D(Y) Q
 ;
 ;Rescission Date
 S DR="69"
 D ^DIE
 I $D(Y) Q
 ;
 ;Reminder description
 W !!
 S DR="2"
 D ^DIE
 I $D(Y) Q
 ;
 ;Technical description
 W !!
 S DR="3"
 D ^DIE
 ;
 ;Priority
 W !!
 S DR="1.91"
 D ^DIE
 Q
 ;
BASE W !!,"Baseline Frequency"
 ;Do in advance time frame
 S DR=1.3
 D ^DIE
 I $D(Y) Q
 ;
 ;Sex specific
 S DR=1.9
 D ^DIE
 I $D(Y) Q
FARS ;
 W !!,"Baseline frequency age range set"
 S DR="7"
 S DR(2,811.97)=".01;1;2;3;4"
 D ^DIE
 I $$OVLAP^PXRMAGE G FARS
 D SNMLA^PXRMFNFT(DA)
 Q
 ;
FIND(LIST) ;Edit findings (multiple)
 D FIND^PXRMREDF(.LIST)
 D SNMLF^PXRMFNFT(DA,20)
 Q
 ;
FFIND W !!,"Function Findings"
 D FFIND^PXRMREDF
 D SNMLF^PXRMFNFT(DA,25)
 Q
 ;
LOGIC W !!,"Patient Cohort and Resolution Logic"
 S DR="30T;60T;61T;70T;71T;34T;65T;66T;75T;76T"
 D ^DIE
 ;Make sure the Patient Cohort Logic at least contains the default.
 I $G(^PXD(811.9,DA,31))="" D
 . S ^PXD(811.9,DA,31)="(SEX)&(AGE)"
 . S ^PXD(811.9,DA,32)="2"_U_"SEX;AGE"
 D SNMLL^PXRMFNFT(DA)
 Q
CDUE W !!,"Custom Date Due"
 S DR=45
 D ^DIE
 Q
 ;
DIALOG W !!,"Reminder Dialog"
 S DR="51"
 D ^DIE
 Q
 ;
WEB W !!,"Web Addresses for Reminder Information"
 S DR="50"
 D ^DIE
 Q
 ;
 ;Get full list of findings
 ;---------------
LIST(GBL,DA,DEF1,ARRAY) ;
 N CNT,DATA,GLOB,IEN,NAME,NODE,SUB,TYPE
 ;Clear passed arrays
 K ARRAY
 S CNT=0
 ;Build cross reference global to file number
 ;Get each finding
 S SUB=0 F  S SUB=$O(@GBL@(DA,20,SUB)) Q:'SUB  D
 .S DATA=$G(@GBL@(DA,20,SUB,0)) I DATA="" Q
 .;Determine global and global IEN
 .S NODE=$P(DATA,U),GLOB=$P(NODE,";",2),IEN=$P(NODE,";")
 .;Ignore null entries
 .I (GLOB="")!(IEN="") Q
 .;Work out the file type
 .S TYPE=$G(DEF1(GLOB)) Q:TYPE=""
 .S CNT=CNT+1
 .I $P($G(@(U_GLOB_IEN_",0)")),U)="" D
 ..W !,"**WARNING** Finding #"_SUB_" does not exist, select finding `"_SUB_" to edit it." Q
 .E  S NAME=$P($G(@(U_GLOB_IEN_",0)")),U) S ARRAY(TYPE,NAME,SUB)=IEN
 Q
 ;
 ;---------------
 ;Choose which part of Reminder to edit
OPTION() ;
 N DIR,X,Y
 ;Display warning message if un-mapped terms exist
 K DIROUT,DIRUT
 S DIR(0)="SO"_U
 S DIR(0)=DIR(0)_"A:All reminder details;"
 S DIR(0)=DIR(0)_"G:General;"
 S DIR(0)=DIR(0)_"B:Baseline Frequency;"
 S DIR(0)=DIR(0)_"F:Findings;"
 S DIR(0)=DIR(0)_"FF:Function Findings;"
 S DIR(0)=DIR(0)_"L:Logic;"
 S DIR(0)=DIR(0)_"C:Custom date due;"
 S DIR(0)=DIR(0)_"D:Reminder Dialog;"
 S DIR(0)=DIR(0)_"W:Web Addresses;"
 S DIR("A",1)="Select a section to edit; press ENTER when you are done editing."
 S DIR("A")="To quit and exit type '^'"
 S DIR("?")="Select which section of the reminder you wish to edit."
 S DIR("??")="^D HELP^PXRMREDF(2)"
 D ^DIR K DIR
 I (Y="")!(Y="^") S DUOUT=1
 Q Y
 ;
 ;---------------
LUDISP(IEN) ;Use for DIC("W") to augment look-up display.
 N CLASS,EM,INACTIVE,TEXT
 S INACTIVE=$P(^PXD(811.9,IEN,0),U,6)
 S CLASS=$P(^PXD(811.9,IEN,100),U,1)
 I INACTIVE'="" S INACTIVE="("_$$EXTERNAL^DILFD(811.9,1.6,"",INACTIVE,.EM)_")"
 S CLASS=$$EXTERNAL^DILFD(811.9,100,"",CLASS,.EM)
 S TEXT="  "_CLASS_" "_INACTIVE
 Q TEXT
 ;
 ;---------------
PNEDIT ;Allow for editing the print name of national reminders.
 N DA,DDSFILE,DR,EDITDT,FDA,MSG,NPNAME,OPNAME,WPTMP,Y
 S DDSFILE=811.9
 S DR="[PXRM DEF PRINT NAME EDIT]"
NXT1 S Y=$$GETDEF
 I Y=-1 Q
 S DA=$P(Y,U,1)
 S OPNAME=$P(^PXD(811.9,DA,0),U,3)
 D ^DDS
 S NPNAME=$P(^PXD(811.9,DA,0),U,3)
 I NPNAME'=OPNAME D
 . S EDITDT=$$NOW^XLFDT
 . S WPTMP(1)="The Print Name was edited\\"
 . S WPTMP(2)=" by: "_$P(^VA(200,DUZ,0),U,1)_"\\"
 . S WPTMP(3)=" on: "_$$FMTE^XLFDT(EDITDT,"5Z")_"\\"
 . S WPTMP(4)=" "
 . S WPTMP(5)="Original: "_OPNAME_"\\"
 . S WPTMP(6)="New:      "_NPNAME_"\\"
 . S IENS="+1,"_DA_","
 . S FDA(811.9001,IENS,.01)=EDITDT
 . S FDA(811.9001,IENS,1)=DUZ
 . S FDA(811.9001,IENS,2)="WPTMP"
 . D UPDATE^DIE("","FDA","","MSG")
 G NXT1
 Q
 ;
 ;---------------
TFIND(DA,LIST) ;Allow edit of term findings for national reminders.
 N DIR,IENLIST,IND,JND,NAME,NAMELIST,SUB,X,Y
 S IND=0,NAME=""
 F  S NAME=$O(LIST("RT",NAME)) Q:NAME=""  D
 . S IND=IND+1
 . S NAMELIST(IND)=$$RJ^XLFSTR(IND,3)_" "_NAME
 . S SUB=$O(LIST("RT",NAME,""))
 . S IENLIST(IND)=LIST("RT",NAME,SUB)
 M DIR("A")=NAMELIST
 S DIR("A")="Enter your list"
 S DIR(0)="LO^1:"_IND
 W !!,"Select term(s) for finding edit:"
 D ^DIR
 I $D(DIROUT)!$D(DIRUT) S LIST="" Q
 I $D(DUOUT)!$D(DTOUT) S LIST="" Q
 F IND=1:1:$L(Y,",")-1 D
 . S JND=$P(Y,",",IND)
 . S NAME=$P(NAMELIST(JND),JND,2)
 . W !!,"Reminder Term:",NAME
 . D TMAP^PXRMREDF(DA,IENLIST(JND))
 Q
 ;