source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEPED.m@ 861

PXRMEPED ; SLC/PJH - Extract Definition Editor ;05/15/2006

 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21

 ;

 ;Main entry point for PXRM EXTRACT DEFINITION EDIT/DISPLAY

START(IEN) ;

 N PXRMDONE,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD

 S X="IORESET"

 D ENDR^%ZISS

 S VALMCNT=0

 D EN^VALM("PXRM EXTRACT DEFINITION EDIT")

 Q

 ;

BLDLIST(IEN) ;Build workfile

 N FLDS,GBL,PXRMROOT

 S FLDS="[PXRM EXTRACT DEFINITION]"

 S GBL="^TMP(""PXRMEPED"",$J)"

 S GBL=$NA(@GBL)

 S PXRMROOT="^PXRM(810.2,"

 K ^TMP("PXRMLRED",$J)

 D DIP^PXRMUTIL(GBL,IEN,PXRMROOT,FLDS)

 S VALMCNT=$O(^TMP("PXRMEPED",$J,""),-1)

 Q

 ;

ENTRY ;Entry code

 D BLDLIST(IEN)

 Q

 ;

EXIT ;Exit code

 K ^TMP("PXRMEPED",$J)

 K ^TMP("PXRMEPEDH",$J)

 D CLEAN^VALM10

 D FULL^VALM1

 S VALMBCK="Q"

 Q

 ;

HDR ; Header code

 S VALMHDR(1)=""

 S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

 Q

 ;

HLP ;Help code

 N ORU,ORUPRMT,SUB,XQORM

 S SUB="PXRMEPEDH"

 D EN^VALM("PXRM EXTRACT HELP")

 Q

 ;

INIT ;Init

 S VALMCNT=0

 Q

 ;

PEXIT ;Protocol exit code

 S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

 ;Reset after page up/down etc

 Q

 ;

ADD ;Add Rule

 N DA,DIC,DONE,DTOUT,DUOUT,DLAYGO,HED,Y

 S HED="ADD EXTRACT DEFINITION",DONE=0

 W IORESET,!

 F  D  Q:$D(DTOUT)  Q:DONE

 .S DIC="^PXRM(810.2,"

 .;Set the starting place for additions.

 .D SETSTART^PXRMCOPY(DIC)

 .S DIC(0)="AELMQ",DLAYGO=810.2

 .S DIC("A")="Select EXTRACT DEFINITION to add: "

 .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 extract definition name already exists" Q

 .S DA=$P(Y,U,1)

 .;Edit Extract Definition

 .D EDIT(DA)

 .S:$D(DA) DONE=1

 Q

 ;

EDIT(DA) ;Edit Rule

 I '$$VEDIT^PXRMUTIL("^PXRM(810.2,",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.2,DA)

 ;

 S DIE="^PXRM(810.2,",DIDEL=810.2,ODA=DA,DR="[PXRM EXTRACT DEFINITION]"

 ;

 ;Edit extract definition then unlock

 D ^DIE,UNLOCK(ODA)

 ;Deleted ???

 I '$D(DA) S VALMBCK="Q" Q

 ;

 ;Update edit history

 D

 .S CS2=$$FILE^PXRMEXCS(810.2,DA) Q:CS2=CS1  Q:+CS2=0

 .D SEHIST^PXRMUTIL(810.2,DIC,DA)

 ;

 S VALMBCK="R"

 Q

 ;

EPEDIT ;Edit Rule

 D EDIT(IEN) Q:VALMBCK="Q"

 ;

 ;Rebuild Workfile

 D BLDLIST(IEN)

 Q

 ;

LOCK(DA) ;Lock the record

 L +^PXRM(810.2,DA):0 I  Q 1

 E  W !!,?5,"Another user is editing this file, try later" H 2 Q 0

 ;

SCREEN ;validate rule type

 Q

 ;

UNLOCK(DA) ;Unlock the record

 L -^PXRM(810.2,DA)

 Q