PXRMREDT ; SLC/PKR,PJH - Edit PXRM reminder definition. ;02/09/2006 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 ; ;======================================================= EEDIT ;Entry point for PXRM DEFINITION EDIT option. ;Build list of finding file definitions. N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2) ; 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 ! D ^DIC I ($D(DTOUT))!($D(DUOUT)) Q I Y=-1 G END S DA=$P(Y,U,1) D ALL(DIC,DA) G GETNAME END ; Q ; ;======================================================= ;Select section of reminder to edit, also called at ALL by PXRMEDIT. ;---------------------------------- ALL(DIC,DA) ; ;Get list of findings/terms for reminder N BLDLOGIC,CS1,CS2,LIST,NODE,OPTION,TYPE S BLDLOGIC=0 ;Save the original checksum. S CS1=$$FILE^PXRMEXCS(811.9,DA) ;Build finding list S NODE="^PXD(811.9)" D LIST(NODE,DA,.LIST) ;If this is a new reminder enter all fields I $P(Y,U,3)=1 D EDIT(DIC,DA) Q ;National reminder allows editing of term findings only I '$$VEDIT^PXRMUTIL(DIC,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(DIC,DA) F D Q:$D(DUOUT)!$D(DTOUT) .D OPTION Q:$D(DUOUT)!$D(DTOUT) .;All details .I OPTION="A" D .. S BLDLOGIC=1 .. D EDIT(DIC,DA) .;Set up local variables .N DIE,DR S DIE=DIC 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,"","") ;See if any changes have been made. S CS2=$$FILE^PXRMEXCS(811.9,DA) I CS2=0 Q ;If the file has been edited, do the edit history. I CS2'=CS1 D SEHIST^PXRMUTIL(811.9,DIC,DA) Q ; ;Reminder Edit ;------------- EDIT(ROOT,DA) ; N DIC,DIDEL,DIE,DR,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) 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 ; ;Recision 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,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 .;E S NAME=$P($G(@(U_GLOB_IEN_",0)")),U) S ARRAY(TYPE,NAME,SUB)=$G(SUB) Q ; ;Choose which part of Reminder to edit ;------------------------------------- OPTION N DIR,X,Y ;Display warning message if un-mapped terms exist K DIROUT,DIRUT,DTOUT,DUOUT 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")="Select section to edit" S DIR("?")="Select which section of the reminder you wish to edit." S DIR("??")="^D HELP^PXRMREDF(2)" D ^DIR K DIR I Y="" S DUOUT=1 Q I $D(DIROUT) S DTOUT=1 I $D(DTOUT)!$D(DUOUT) Q S OPTION=Y Q ; ;------------------------------------- TFIND(DA,LIST) ;Allow edit of term findings for national reminders. N DIR,IENLIST,IND,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 S LIST=Y F IND=1:1:$L(Y,",")-1 D . S NAME=$P(NAMELIST(IND),IND,2) . W !!,"Reminder Term:",NAME . D TMAP^PXRMREDF(DA,IENLIST(IND)) Q ;