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
|
---|