source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMSEDT.m@ 975

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1PXRMSEDT ; SLC/PJH - Edit a reminder resolution status ;05/11/2000
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;Called from PXRMGEDT
5 ;
6 ;Edit/Delete resolution status
7 ;-----------------------------
8EDIT(ROOT,DA) ;
9 N DIC,DIE,DR,LIEN,TAX,NATIONAL,DIDEL
10 S DIE=ROOT,LIEN=DA
11 ;
12 ;Check if this is a restricted edit status (i.e. national status)
13 S NATIONAL=+$P($G(^PXRMD(801.9,DA,0)),U,6)
14 ;
15 ;If national status only allow entry of sub-status or inactive
16 I NATIONAL S DR="10;.04"
17 ;
18 ;Otherwise do not allow entry of restricted edit or sub-status
19 I 'NATIONAL S DR=".01;1;.02;.03;.04;.05///"_DUZ S DIDEL=801.9
20 ;
21 D ^DIE Q:$D(Y) I '$D(DA) S VALMBCK="Q" Q
22 ;
23 ;If a local status - warning if not allocated to a national status
24 Q:NATIONAL Q:$D(^PXRMD(801.9,"AC",DA))
25 ;Select National code
26 W !!,"This resolution status must be linked to a national status",!
27 N DA,DIC
28 S DIC="^PXRMD(801.9,"
29 S DIC(0)="AEMQ"
30 S DIC("S")="I $P(^(0),U,6)=1"
31 S DIC("A")="SELECT NATIONAL RESOLUTION STATUS: "
32 ;Get the next name.
33 D ^DIC
34 S:Y=-1 DUOUT=1 Q:$D(DUOUT)!$D(DTOUT)
35 ;Update sub-status field in national status
36 N FDA,FDAIEN,MSG
37 S FDA(801.9001,"+2,"_+Y_",",.01)=LIEN
38 D UPDATE^DIE("S","FDA","FDAIEN","MSG")
39 I $D(MSG) D ERR
40 Q
41 ;
42 ;Error Messages from UPDATE^DIE
43 ;------------------------------
44ERR N IC,ERROR,REF
45 ;Move MSG into ERROR
46 S REF="MSG",ERROR(1)="Error in UPDATE^DIE, needs further investigation"
47 F IC=2:1 S REF=$Q(@REF) Q:REF="" S ERROR(IC)=REF_"="_@REF
48 ;Screen message
49 D BMES^XPDUTL(.ERROR)
50 Q
51 ;
52KILLAC ;This only applies if deleting a sub-status
53 I '$D(^PXRMD(801.9,DA)) Q
54 ;
55 N SUB,NAT
56 ;Get the national status for this sub status, quit if none
57 S NAT=""
58 F S NAT=$O(^PXRMD(801.9,"AC",DA,NAT)) Q:NAT="" D
59 .;Get sub status position in the national code, quit if none
60 .S SUB=$O(^PXRMD(801.9,"AC",DA,NAT,"")) Q:SUB=""
61 .;Kill the sub-status on the national code
62 .N DIC,DIK,DA S DIK="^PXRMD(801.9,NAT,10,",DA(1)=NAT,DA=SUB D ^DIK
63 Q
Note: See TracBrowser for help on using the repository browser.