Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMSEDT

PXRMSEDT.m

Go to the documentation of this file.
  1. PXRMSEDT ; SLC/PJH - Edit a reminder resolution status ;05/11/2000
  1. ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
  1. ;
  1. ;Called from PXRMGEDT
  1. ;
  1. ;Edit/Delete resolution status
  1. ;-----------------------------
  1. EDIT(ROOT,DA) ;
  1. N DIC,DIE,DR,LIEN,TAX,NATIONAL,DIDEL
  1. S DIE=ROOT,LIEN=DA
  1. ;
  1. ;Check if this is a restricted edit status (i.e. national status)
  1. S NATIONAL=+$P($G(^PXRMD(801.9,DA,0)),U,6)
  1. ;
  1. ;If national status only allow entry of sub-status or inactive
  1. I NATIONAL S DR="10;.04"
  1. ;
  1. ;Otherwise do not allow entry of restricted edit or sub-status
  1. I 'NATIONAL S DR=".01;1;.02;.03;.04;.05///"_DUZ S DIDEL=801.9
  1. ;
  1. D ^DIE Q:$D(Y) I '$D(DA) S VALMBCK="Q" Q
  1. ;
  1. ;If a local status - warning if not allocated to a national status
  1. Q:NATIONAL Q:$D(^PXRMD(801.9,"AC",DA))
  1. ;Select National code
  1. W !!,"This resolution status must be linked to a national status",!
  1. N DA,DIC
  1. S DIC="^PXRMD(801.9,"
  1. S DIC(0)="AEMQ"
  1. S DIC("S")="I $P(^(0),U,6)=1"
  1. S DIC("A")="SELECT NATIONAL RESOLUTION STATUS: "
  1. ;Get the next name.
  1. D ^DIC
  1. S:Y=-1 DUOUT=1 Q:$D(DUOUT)!$D(DTOUT)
  1. ;Update sub-status field in national status
  1. N FDA,FDAIEN,MSG
  1. S FDA(801.9001,"+2,"_+Y_",",.01)=LIEN
  1. D UPDATE^DIE("S","FDA","FDAIEN","MSG")
  1. I $D(MSG) D ERR
  1. Q
  1. ;
  1. ;Error Messages from UPDATE^DIE
  1. ;------------------------------
  1. ERR N IC,ERROR,REF
  1. ;Move MSG into ERROR
  1. S REF="MSG",ERROR(1)="Error in UPDATE^DIE, needs further investigation"
  1. F IC=2:1 S REF=$Q(@REF) Q:REF="" S ERROR(IC)=REF_"="_@REF
  1. ;Screen message
  1. D BMES^XPDUTL(.ERROR)
  1. Q
  1. ;
  1. KILLAC ;This only applies if deleting a sub-status
  1. I '$D(^PXRMD(801.9,DA)) Q
  1. ;
  1. N SUB,NAT
  1. ;Get the national status for this sub status, quit if none
  1. S NAT=""
  1. F S NAT=$O(^PXRMD(801.9,"AC",DA,NAT)) Q:NAT="" D
  1. .;Get sub status position in the national code, quit if none
  1. .S SUB=$O(^PXRMD(801.9,"AC",DA,NAT,"")) Q:SUB=""
  1. .;Kill the sub-status on the national code
  1. .N DIC,DIK,DA S DIK="^PXRMD(801.9,NAT,10,",DA(1)=NAT,DA=SUB D ^DIK
  1. Q