source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLLED.m@ 861

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

revised back to 6/30/08 version

File size: 2.1 KB
Line 
1PXRMLLED ; SLC/PJH - Edit a location list. ;12/23/2005
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;================================================================
5 N CS1,CS2,DA,DIC,DLAYGO,DTOUT,DUOUT,FILEA,IENA,NUM,Y
6GETNAME ;Get the name of the location list to edit.
7 K DA,DIC,DLAYGO,DTOUT,DUOUT,Y
8 S DIC="^PXRMD(810.9,"
9 S DIC(0)="AEMQL"
10 S DIC("A")="Select Location List: "
11 S DIC("S")="I $$VEDIT^PXRMUTIL(DIC,Y)"
12 S DLAYGO=810.9
13 ;Set the starting place for additions.
14 D SETSTART^PXRMCOPY(DIC)
15 W !
16 D ^DIC
17 I ($D(DTOUT))!($D(DUOUT)) Q
18 I Y=-1 G END
19 S DA=$P(Y,U,1)
20 S CS1=$$FILE^PXRMEXCS(810.9,DA)
21 D EDIT(DIC,DA)
22 ;See if any changes have been made, if so do the edit history.
23 S CS2=$$FILE^PXRMEXCS(810.9,DA)
24 I CS2'=0,CS2'=CS1 D SEHIST^PXRMUTIL(810.9,DIC,DA)
25 G GETNAME
26END ;
27 Q
28 ;
29 ;================================================================
30EDIT(ROOT,DA) ;
31 N DIE,DR,DIDEL,X,Y
32 S DIE=ROOT,DIDEL=810.9
33NAME S DR=".01"
34 D ^DIE
35 I '$D(DA) Q
36 I $D(Y) Q
37CLASS ;
38 ;Class
39RETRY W !!
40 S DR="100"
41 D ^DIE
42 I $D(Y) G NAME
43 ;Sponsor
44 S DR="101"
45 D ^DIE
46 I $D(Y) G RETRY
47 ;Make sure Class and Sponsor Class are in synch.
48 S RESULT=$$VSPONSOR^PXRMINTR(X)
49 I RESULT=0 S DIE("NO^")="Other value" G RETRY
50 I RESULT=1 K DIE("NO^")
51 ;Review date
52RD W !!
53 S DR="102"
54 D ^DIE
55 I $D(Y) G RETRY
56 ;
57 ;Description
58DES S DR="1"
59 D ^DIE
60 I $D(Y) G RD
61 ;
62 ;Clinic Stops
63CS S DR="40.7"
64 S DR(2,810.9001)=".01;1"
65 D ^DIE
66 I $D(Y) G DES
67 ;
68 ;Hospital Locations
69HL S DR="44"
70 D ^DIE
71 I $D(Y) G CS
72 Q
73 ;
74 ;================================================================
75KAMIS(X,DA) ;Kill the AMIS Reporting Stop Code.
76 ;Do not execute as part of a verify fields.
77 I $G(DIUTIL)="VERIFY FIELDS" Q
78 ;Do not execute as part of exchange.
79 I $G(PXRMEXCH) Q
80 S $P(^PXRMD(810.9,DA(1),40.7,DA,0),U,2)=""
81 Q
82 ;
83 ;================================================================
84SAMIS(X,DA) ;Set the AMIS Reporting Stop Code.
85 ;Do not execute as part of a verify fields.
86 I $G(DIUTIL)="VERIFY FIELDS" Q
87 ;Do not execute as part of exchange.
88 I $G(PXRMEXCH) Q
89 N AMIS
90 S AMIS=$P(^DIC(40.7,X,0),U,2)
91 S $P(^PXRMD(810.9,DA(1),40.7,DA,0),U,2)=AMIS
92 Q
93 ;
Note: See TracBrowser for help on using the repository browser.