| 1 | PXRMEGED ; SLC/PJH - Extract Counting Group Editor ;08/03/2006
|
|---|
| 2 | ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
|
|---|
| 3 | ;
|
|---|
| 4 | ;Main entry point for PXRM EXTRACT COUNTING GRP EDIT
|
|---|
| 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 COUNTING GRP EDIT")
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | BLDLIST(IEN) ;Build workfile
|
|---|
| 14 | N FLDS,GBL,PXRMROOT
|
|---|
| 15 | S FLDS="[PXRM EXTRACT COUNTING GROUP]"
|
|---|
| 16 | S GBL="^TMP(""PXRMEGED"",$J)"
|
|---|
| 17 | S GBL=$NA(@GBL)
|
|---|
| 18 | S PXRMROOT="^PXRM(810.8,"
|
|---|
| 19 | K ^TMP("PXRMEGED",$J)
|
|---|
| 20 | D DIP^PXRMUTIL(GBL,IEN,PXRMROOT,FLDS)
|
|---|
| 21 | S VALMCNT=$O(^TMP("PXRMEGED",$J,""),-1)
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | ENTRY ;Entry code
|
|---|
| 25 | D BLDLIST(IEN)
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | EXIT ;Exit code
|
|---|
| 29 | K ^TMP("PXRMEGED",$J)
|
|---|
| 30 | K ^TMP("PXRMEGEDH",$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="PXRMEGEDH"
|
|---|
| 44 | D EN^VALM("PXRM EXTRACT HELP")
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | INIT ;Init
|
|---|
| 48 | S VALMCNT=0
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | PEXIT ;PXRM EXCH MENU 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 COUNTING GROUP",DONE=0
|
|---|
| 59 | W IORESET,!
|
|---|
| 60 | F D Q:$D(DTOUT) Q:DONE
|
|---|
| 61 | .S DIC="^PXRM(810.8,"
|
|---|
| 62 | .;Set the starting place for additions.
|
|---|
| 63 | .D SETSTART^PXRMCOPY(DIC)
|
|---|
| 64 | .S DIC(0)="AELMQ",DLAYGO=810.8
|
|---|
| 65 | .S DIC("A")="Select EXTRACT COUNTING GROUP 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 counting group name already exists" Q
|
|---|
| 71 | .S DA=$P(Y,U,1)
|
|---|
| 72 | .;Edit Extract Counting Group
|
|---|
| 73 | .D EDIT(DA)
|
|---|
| 74 | .S:$D(DA) DONE=1,GROUP(DA)=""
|
|---|
| 75 | Q
|
|---|
| 76 | ;
|
|---|
| 77 | EDIT(DA) ;Edit Rule
|
|---|
| 78 | I '$$VEDIT^PXRMUTIL("^PXRM(810.8,",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.8,DA)
|
|---|
| 87 | ;
|
|---|
| 88 | S DIE="^PXRM(810.8,",DIDEL=810.8,ODA=DA,DR="[PXRM EXTRACT COUNTING GROUP]"
|
|---|
| 89 | ;
|
|---|
| 90 | ;Edit extract counting group 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.8,DA) Q:CS2=CS1 Q:+CS2=0
|
|---|
| 98 | .D SEHIST^PXRMUTIL(810.8,DIC,DA)
|
|---|
| 99 | ;
|
|---|
| 100 | S VALMBCK="R"
|
|---|
| 101 | Q
|
|---|
| 102 | ;
|
|---|
| 103 | EGEDIT ;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.7,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.7,DA)
|
|---|
| 119 | Q
|
|---|
