[613] | 1 | PXRMEFED ; SLC/PJH - Extract Counting Editor ;05/10/2006
|
---|
| 2 | ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
|
---|
| 3 | ;
|
---|
| 4 | ;Main entry point for PXRM COUNTING RULE 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 COUNT RULE EDIT")
|
---|
| 11 | Q
|
---|
| 12 | ;
|
---|
| 13 | BLDLIST(IEN) ;Build workfile
|
---|
| 14 | N FLDS,GBL,PXRMROOT
|
---|
| 15 | S FLDS="[PXRM EXTRACT COUNTING]"
|
---|
| 16 | S GBL="^TMP(""PXRMEFED"",$J)"
|
---|
| 17 | S GBL=$NA(@GBL)
|
---|
| 18 | S PXRMROOT="^PXRM(810.7,"
|
---|
| 19 | K ^TMP("PXRMEFED",$J)
|
---|
| 20 | D DIP^PXRMUTIL(GBL,IEN,PXRMROOT,FLDS)
|
---|
| 21 | S VALMCNT=$O(^TMP("PXRMEFED",$J,""),-1)
|
---|
| 22 | Q
|
---|
| 23 | ;
|
---|
| 24 | ENTRY ;Entry code
|
---|
| 25 | D BLDLIST(IEN)
|
---|
| 26 | Q
|
---|
| 27 | ;
|
---|
| 28 | EXIT ;Exit code
|
---|
| 29 | K ^TMP("PXRMEFED",$J)
|
---|
| 30 | K ^TMP("PXRMEFEDH",$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="PXRMEFEDH"
|
---|
| 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 COUNTING RULE",DONE=0
|
---|
| 59 | W IORESET,!
|
---|
| 60 | F D Q:$D(DTOUT) Q:DONE
|
---|
| 61 | .S DIC="^PXRM(810.7,"
|
---|
| 62 | .;Set the starting place for additions.
|
---|
| 63 | .D SETSTART^PXRMCOPY(DIC)
|
---|
| 64 | .S DIC(0)="AELMQ",DLAYGO=810.7
|
---|
| 65 | .S DIC("A")="Select EXTRACT COUNTING RULE 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 rule already exists" Q
|
---|
| 71 | .S DA=$P(Y,U,1)
|
---|
| 72 | .;Edit Extract Counting Rule
|
---|
| 73 | .D EDIT(DA)
|
---|
| 74 | .S:$D(DA) DONE=1
|
---|
| 75 | Q
|
---|
| 76 | ;
|
---|
| 77 | EDIT(DA) ;Edit Rule
|
---|
| 78 | I '$$VEDIT^PXRMUTIL("^PXRM(810.7,",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.7,DA)
|
---|
| 87 | ;
|
---|
| 88 | S DIE="^PXRM(810.7,",DIDEL=810.7,ODA=DA,DR="[PXRM EXTRACT COUNTING]"
|
---|
| 89 | ;
|
---|
| 90 | ;Edit extract counting rule 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.7,DA) Q:CS2=CS1 Q:+CS2=0
|
---|
| 98 | .D SEHIST^PXRMUTIL(810.7,DIC,DA)
|
---|
| 99 | ;
|
---|
| 100 | S VALMBCK="R"
|
---|
| 101 | Q
|
---|
| 102 | ;
|
---|
| 103 | EFEDIT ;Edit Rule
|
---|
| 104 | D EDIT(IEN) Q:VALMBCK="Q"
|
---|
| 105 | ;
|
---|
| 106 | ;Rebuild Workfile
|
---|
| 107 | D BLDLIST(IEN)
|
---|
| 108 | Q
|
---|
| 109 | ;
|
---|
| 110 | EFGRP ;Counting Groups
|
---|
| 111 | D START^PXRMEGM(IEN)
|
---|
| 112 | ;
|
---|
| 113 | ;Rebiuld Workfile
|
---|
| 114 | D BLDLIST(IEN)
|
---|
| 115 | ;
|
---|
| 116 | S VALMBCK="R"
|
---|
| 117 | Q
|
---|
| 118 | ;
|
---|
| 119 | LOCK(DA) ;Lock the record
|
---|
| 120 | L +^PXRM(810.7,DA):2 I Q 1
|
---|
| 121 | E W !!,?5,"Another user is editing this file, try later" H 2 Q 0
|
---|
| 122 | ;
|
---|
| 123 | SCREEN ;validate rule type
|
---|
| 124 | Q
|
---|
| 125 | ;
|
---|
| 126 | UNLOCK(DA) ;Unlock the record
|
---|
| 127 | L -^PXRM(810.7,DA)
|
---|
| 128 | Q
|
---|