source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEPED.m@ 1608

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

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1PXRMEPED ; 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
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 DEFINITION EDIT")
11 Q
12 ;
13BLDLIST(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 ;
24ENTRY ;Entry code
25 D BLDLIST(IEN)
26 Q
27 ;
28EXIT ;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 ;
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="PXRMEPEDH"
44 D EN^VALM("PXRM EXTRACT HELP")
45 Q
46 ;
47INIT ;Init
48 S VALMCNT=0
49 Q
50 ;
51PEXIT ;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 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 ;
77EDIT(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 ;
103EPEDIT ;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.2,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.2,DA)
119 Q
Note: See TracBrowser for help on using the repository browser.