source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEGED.m@ 1450

Last change on this file since 1450 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1PXRMEGED ; 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
5START(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 ;
13BLDLIST(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 ;
24ENTRY ;Entry code
25 D BLDLIST(IEN)
26 Q
27 ;
28EXIT ;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 ;
36HDR ; Header code
37 S VALMHDR(1)=""
38 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
39 Q
40 ;
41HLP ;Help code
42 N ORU,ORUPRMT,SUB,XQORM
43 S SUB="PXRMEGEDH"
44 D EN^VALM("PXRM EXTRACT HELP")
45 Q
46 ;
47INIT ;Init
48 S VALMCNT=0
49 Q
50 ;
51PEXIT ;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 ;
56ADD ;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 ;
77EDIT(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 ;
103EGEDIT ;Edit Rule
104 D EDIT(IEN) Q:VALMBCK="Q"
105 ;
106 ;Rebuild Workfile
107 D BLDLIST(IEN)
108 Q
109 ;
110LOCK(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 ;
114SCREEN ;validate rule type
115 Q
116 ;
117UNLOCK(DA) ;Unlock the record
118 L -^PXRM(810.7,DA)
119 Q
Note: See TracBrowser for help on using the repository browser.