| 1 | PXRMSEDT ; 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 | ;-----------------------------
|
|---|
| 8 | EDIT(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 | ;------------------------------
|
|---|
| 44 | ERR 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 | ;
|
|---|
| 52 | KILLAC ;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
|
|---|
