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

PXRMEPED.m

Go to the documentation of this file.
  1. PXRMEPED ; SLC/PJH - Extract Definition Editor ;01/28/2013
  1. ;;2.0;CLINICAL REMINDERS;**4,26**;Feb 04, 2005;Build 404
  1. ;
  1. ;Main entry point for PXRM EXTRACT DEFINITION EDIT/DISPLAY
  1. START(IEN) ;
  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 EXTRACT DEFINITION EDIT")
  1. Q
  1. ;
  1. BLDLIST(IEN) ;Build workfile
  1. N FLDS,GBL,PXRMROOT
  1. S FLDS="[PXRM EXTRACT DEFINITION]"
  1. S GBL="^TMP(""PXRMEPED"",$J)"
  1. S GBL=$NA(@GBL)
  1. S PXRMROOT="^PXRM(810.2,"
  1. K ^TMP("PXRMLRED",$J)
  1. D DIP^PXRMUTIL(GBL,IEN,PXRMROOT,FLDS)
  1. S VALMCNT=$O(^TMP("PXRMEPED",$J,""),-1)
  1. Q
  1. ;
  1. ENTRY ;Entry code
  1. D BLDLIST(IEN)
  1. Q
  1. ;
  1. EXIT ;Exit code
  1. K ^TMP("PXRMEPED",$J)
  1. K ^TMP("PXRMEPEDH",$J)
  1. D CLEAN^VALM10
  1. D FULL^VALM1
  1. S VALMBCK="Q"
  1. Q
  1. ;
  1. HDR ; Header code
  1. S VALMHDR(1)=""
  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="PXRMEPEDH"
  1. D EN^VALM("PXRM EXTRACT HELP")
  1. Q
  1. ;
  1. INIT ;Init
  1. S VALMCNT=0
  1. Q
  1. ;
  1. PEXIT ;Protocol exit code
  1. S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
  1. ;Reset after page up/down etc
  1. Q
  1. ;
  1. ADD ;Add Rule
  1. N DA,DIC,DONE,DTOUT,DUOUT,DLAYGO,HED,Y
  1. S HED="ADD EXTRACT DEFINITION",DONE=0
  1. W IORESET,!
  1. F D Q:$D(DTOUT) Q:DONE
  1. .S DIC="^PXRM(810.2,"
  1. .;Set the starting place for additions.
  1. .D SETSTART^PXRMCOPY(DIC)
  1. .S DIC(0)="AELMQ",DLAYGO=810.2
  1. .S DIC("A")="Select EXTRACT DEFINITION to add: "
  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 extract definition name already exists" Q
  1. .S DA=$P(Y,U,1)
  1. .;Edit Extract Definition
  1. .D EDIT(DA)
  1. .S:$D(DA) DONE=1
  1. Q
  1. ;
  1. EDIT(DA) ;Edit Rule
  1. I '$$VEDIT^PXRMUTIL("^PXRM(810.2,",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.2,DA)
  1. ;
  1. S DIE="^PXRM(810.2,",DIDEL=810.2,ODA=DA,DR="[PXRM EXTRACT DEFINITION]"
  1. ;
  1. ;Edit extract definition then unlock
  1. D ^DIE,UNLOCK(ODA)
  1. ;Deleted ???
  1. I '$D(DA) S VALMBCK="Q" Q
  1. ;
  1. ;Update edit history
  1. D
  1. .S CS2=$$FILE^PXRMEXCS(810.2,DA) Q:CS2=CS1 Q:+CS2=0
  1. .D SEHIST^PXRMUTIL(810.2,DIC,DA)
  1. ;
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. EPEDIT ;Edit Rule
  1. D EDIT(IEN) Q:VALMBCK="Q"
  1. ;
  1. ;Rebuild Workfile
  1. D BLDLIST(IEN)
  1. Q
  1. ;
  1. LOCK(DA) ;Lock the record
  1. L +^PXRM(810.2,DA):DILOCKTM I Q 1
  1. E W !!,?5,"Another user is editing this file, try later" H 2 Q 0
  1. ;
  1. SCREEN ;validate rule type
  1. Q
  1. ;
  1. UNLOCK(DA) ;Unlock the record
  1. L -^PXRM(810.2,DA)
  1. Q