| 1 | PXRMEPED ; SLC/PJH - Extract Definition Editor ;05/15/2006
 | 
|---|
| 2 |  ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ;Main entry point for PXRM EXTRACT DEFINITION EDIT/DISPLAY
 | 
|---|
| 5 | START(IEN) ;
 | 
|---|
| 6 |  N PXRMDONE,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
 | 
|---|
| 7 |  S X="IORESET"
 | 
|---|
| 8 |  D ENDR^%ZISS
 | 
|---|
| 9 |  S VALMCNT=0
 | 
|---|
| 10 |  D EN^VALM("PXRM EXTRACT DEFINITION EDIT")
 | 
|---|
| 11 |  Q
 | 
|---|
| 12 |  ;
 | 
|---|
| 13 | BLDLIST(IEN) ;Build workfile
 | 
|---|
| 14 |  N FLDS,GBL,PXRMROOT
 | 
|---|
| 15 |  S FLDS="[PXRM EXTRACT DEFINITION]"
 | 
|---|
| 16 |  S GBL="^TMP(""PXRMEPED"",$J)"
 | 
|---|
| 17 |  S GBL=$NA(@GBL)
 | 
|---|
| 18 |  S PXRMROOT="^PXRM(810.2,"
 | 
|---|
| 19 |  K ^TMP("PXRMLRED",$J)
 | 
|---|
| 20 |  D DIP^PXRMUTIL(GBL,IEN,PXRMROOT,FLDS)
 | 
|---|
| 21 |  S VALMCNT=$O(^TMP("PXRMEPED",$J,""),-1)
 | 
|---|
| 22 |  Q
 | 
|---|
| 23 |  ;
 | 
|---|
| 24 | ENTRY ;Entry code
 | 
|---|
| 25 |  D BLDLIST(IEN)
 | 
|---|
| 26 |  Q
 | 
|---|
| 27 |  ;
 | 
|---|
| 28 | EXIT ;Exit code
 | 
|---|
| 29 |  K ^TMP("PXRMEPED",$J)
 | 
|---|
| 30 |  K ^TMP("PXRMEPEDH",$J)
 | 
|---|
| 31 |  D CLEAN^VALM10
 | 
|---|
| 32 |  D FULL^VALM1
 | 
|---|
| 33 |  S VALMBCK="Q"
 | 
|---|
| 34 |  Q
 | 
|---|
| 35 |  ;
 | 
|---|
| 36 | HDR ; Header code
 | 
|---|
| 37 |  S VALMHDR(1)=""
 | 
|---|
| 38 |  S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
 | 
|---|
| 39 |  Q
 | 
|---|
| 40 |  ;
 | 
|---|
| 41 | HLP ;Help code
 | 
|---|
| 42 |  N ORU,ORUPRMT,SUB,XQORM
 | 
|---|
| 43 |  S SUB="PXRMEPEDH"
 | 
|---|
| 44 |  D EN^VALM("PXRM EXTRACT HELP")
 | 
|---|
| 45 |  Q
 | 
|---|
| 46 |  ;
 | 
|---|
| 47 | INIT ;Init
 | 
|---|
| 48 |  S VALMCNT=0
 | 
|---|
| 49 |  Q
 | 
|---|
| 50 |  ;
 | 
|---|
| 51 | PEXIT ;Protocol exit code
 | 
|---|
| 52 |  S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
 | 
|---|
| 53 |  ;Reset after page up/down etc
 | 
|---|
| 54 |  Q
 | 
|---|
| 55 |  ;
 | 
|---|
| 56 | ADD ;Add Rule
 | 
|---|
| 57 |  N DA,DIC,DONE,DTOUT,DUOUT,DLAYGO,HED,Y
 | 
|---|
| 58 |  S HED="ADD EXTRACT DEFINITION",DONE=0
 | 
|---|
| 59 |  W IORESET,!
 | 
|---|
| 60 |  F  D  Q:$D(DTOUT)  Q:DONE
 | 
|---|
| 61 |  .S DIC="^PXRM(810.2,"
 | 
|---|
| 62 |  .;Set the starting place for additions.
 | 
|---|
| 63 |  .D SETSTART^PXRMCOPY(DIC)
 | 
|---|
| 64 |  .S DIC(0)="AELMQ",DLAYGO=810.2
 | 
|---|
| 65 |  .S DIC("A")="Select EXTRACT DEFINITION to add: "
 | 
|---|
| 66 |  .D ^DIC
 | 
|---|
| 67 |  .I $D(DUOUT) S DTOUT=1
 | 
|---|
| 68 |  .I ($D(DTOUT))!($D(DUOUT)) Q
 | 
|---|
| 69 |  .I Y=-1 K DIC S DTOUT=1 Q
 | 
|---|
| 70 |  .I $P(Y,U,3)'=1 W !,"This extract definition name already exists" Q
 | 
|---|
| 71 |  .S DA=$P(Y,U,1)
 | 
|---|
| 72 |  .;Edit Extract Definition
 | 
|---|
| 73 |  .D EDIT(DA)
 | 
|---|
| 74 |  .S:$D(DA) DONE=1
 | 
|---|
| 75 |  Q
 | 
|---|
| 76 |  ;
 | 
|---|
| 77 | EDIT(DA) ;Edit Rule
 | 
|---|
| 78 |  I '$$VEDIT^PXRMUTIL("^PXRM(810.2,",DA) D  Q
 | 
|---|
| 79 |  .W !!,?5,"VA- and national class rules may not be edited" H 2
 | 
|---|
| 80 |  .S VALMBCK="R"
 | 
|---|
| 81 |  ;
 | 
|---|
| 82 |  Q:'$$LOCK(DA)
 | 
|---|
| 83 |  W IORESET
 | 
|---|
| 84 |  N CS1,CS2,DIC,DIDEL,DIE,DR,DTOUT,DUOUT,ODA,Y
 | 
|---|
| 85 |  ;Save checksum
 | 
|---|
| 86 |  S CS1=$$FILE^PXRMEXCS(810.2,DA)
 | 
|---|
| 87 |  ;
 | 
|---|
| 88 |  S DIE="^PXRM(810.2,",DIDEL=810.2,ODA=DA,DR="[PXRM EXTRACT DEFINITION]"
 | 
|---|
| 89 |  ;
 | 
|---|
| 90 |  ;Edit extract definition then unlock
 | 
|---|
| 91 |  D ^DIE,UNLOCK(ODA)
 | 
|---|
| 92 |  ;Deleted ???
 | 
|---|
| 93 |  I '$D(DA) S VALMBCK="Q" Q
 | 
|---|
| 94 |  ;
 | 
|---|
| 95 |  ;Update edit history
 | 
|---|
| 96 |  D
 | 
|---|
| 97 |  .S CS2=$$FILE^PXRMEXCS(810.2,DA) Q:CS2=CS1  Q:+CS2=0
 | 
|---|
| 98 |  .D SEHIST^PXRMUTIL(810.2,DIC,DA)
 | 
|---|
| 99 |  ;
 | 
|---|
| 100 |  S VALMBCK="R"
 | 
|---|
| 101 |  Q
 | 
|---|
| 102 |  ;
 | 
|---|
| 103 | EPEDIT ;Edit Rule
 | 
|---|
| 104 |  D EDIT(IEN) Q:VALMBCK="Q"
 | 
|---|
| 105 |  ;
 | 
|---|
| 106 |  ;Rebuild Workfile
 | 
|---|
| 107 |  D BLDLIST(IEN)
 | 
|---|
| 108 |  Q
 | 
|---|
| 109 |  ;
 | 
|---|
| 110 | LOCK(DA) ;Lock the record
 | 
|---|
| 111 |  L +^PXRM(810.2,DA):0 I  Q 1
 | 
|---|
| 112 |  E  W !!,?5,"Another user is editing this file, try later" H 2 Q 0
 | 
|---|
| 113 |  ;
 | 
|---|
| 114 | SCREEN ;validate rule type
 | 
|---|
| 115 |  Q
 | 
|---|
| 116 |  ;
 | 
|---|
| 117 | UNLOCK(DA) ;Unlock the record
 | 
|---|
| 118 |  L -^PXRM(810.2,DA)
 | 
|---|
| 119 |  Q
 | 
|---|