- PXRMSEDT ; SLC/PJH - Edit a reminder resolution status ;05/11/2000
- ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
- ;
- ;Called from PXRMGEDT
- ;
- ;Edit/Delete resolution status
- ;-----------------------------
- EDIT(ROOT,DA) ;
- N DIC,DIE,DR,LIEN,TAX,NATIONAL,DIDEL
- S DIE=ROOT,LIEN=DA
- ;
- ;Check if this is a restricted edit status (i.e. national status)
- S NATIONAL=+$P($G(^PXRMD(801.9,DA,0)),U,6)
- ;
- ;If national status only allow entry of sub-status or inactive
- I NATIONAL S DR="10;.04"
- ;
- ;Otherwise do not allow entry of restricted edit or sub-status
- I 'NATIONAL S DR=".01;1;.02;.03;.04;.05///"_DUZ S DIDEL=801.9
- ;
- D ^DIE Q:$D(Y) I '$D(DA) S VALMBCK="Q" Q
- ;
- ;If a local status - warning if not allocated to a national status
- Q:NATIONAL Q:$D(^PXRMD(801.9,"AC",DA))
- ;Select National code
- W !!,"This resolution status must be linked to a national status",!
- N DA,DIC
- S DIC="^PXRMD(801.9,"
- S DIC(0)="AEMQ"
- S DIC("S")="I $P(^(0),U,6)=1"
- S DIC("A")="SELECT NATIONAL RESOLUTION STATUS: "
- ;Get the next name.
- D ^DIC
- S:Y=-1 DUOUT=1 Q:$D(DUOUT)!$D(DTOUT)
- ;Update sub-status field in national status
- N FDA,FDAIEN,MSG
- S FDA(801.9001,"+2,"_+Y_",",.01)=LIEN
- D UPDATE^DIE("S","FDA","FDAIEN","MSG")
- I $D(MSG) D ERR
- Q
- ;
- ;Error Messages from UPDATE^DIE
- ;------------------------------
- ERR N IC,ERROR,REF
- ;Move MSG into ERROR
- S REF="MSG",ERROR(1)="Error in UPDATE^DIE, needs further investigation"
- F IC=2:1 S REF=$Q(@REF) Q:REF="" S ERROR(IC)=REF_"="_@REF
- ;Screen message
- D BMES^XPDUTL(.ERROR)
- Q
- ;
- KILLAC ;This only applies if deleting a sub-status
- I '$D(^PXRMD(801.9,DA)) Q
- ;
- N SUB,NAT
- ;Get the national status for this sub status, quit if none
- S NAT=""
- F S NAT=$O(^PXRMD(801.9,"AC",DA,NAT)) Q:NAT="" D
- .;Get sub status position in the national code, quit if none
- .S SUB=$O(^PXRMD(801.9,"AC",DA,NAT,"")) Q:SUB=""
- .;Kill the sub-status on the national code
- .N DIC,DIK,DA S DIK="^PXRMD(801.9,NAT,10,",DA(1)=NAT,DA=SUB D ^DIK
- Q
- PXRMSEDT ; SLC/PJH - Edit a reminder resolution status ;05/11/2000
- +1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
- +2 ;
- +3 ;Called from PXRMGEDT
- +4 ;
- +5 ;Edit/Delete resolution status
- +6 ;-----------------------------
- EDIT(ROOT,DA) ;
- +1 NEW DIC,DIE,DR,LIEN,TAX,NATIONAL,DIDEL
- +2 SET DIE=ROOT
- SET LIEN=DA
- +3 ;
- +4 ;Check if this is a restricted edit status (i.e. national status)
- +5 SET NATIONAL=+$PIECE($GET(^PXRMD(801.9,DA,0)),U,6)
- +6 ;
- +7 ;If national status only allow entry of sub-status or inactive
- +8 IF NATIONAL
- SET DR="10;.04"
- +9 ;
- +10 ;Otherwise do not allow entry of restricted edit or sub-status
- +11 IF 'NATIONAL
- SET DR=".01;1;.02;.03;.04;.05///"_DUZ
- SET DIDEL=801.9
- +12 ;
- +13 DO ^DIE
- IF $DATA(Y)
- QUIT
- IF '$DATA(DA)
- SET VALMBCK="Q"
- QUIT
- +14 ;
- +15 ;If a local status - warning if not allocated to a national status
- +16 IF NATIONAL
- QUIT
- IF $DATA(^PXRMD(801.9,"AC",DA))
- QUIT
- +17 ;Select National code
- +18 WRITE !!,"This resolution status must be linked to a national status",!
- +19 NEW DA,DIC
- +20 SET DIC="^PXRMD(801.9,"
- +21 SET DIC(0)="AEMQ"
- +22 SET DIC("S")="I $P(^(0),U,6)=1"
- +23 SET DIC("A")="SELECT NATIONAL RESOLUTION STATUS: "
- +24 ;Get the next name.
- +25 DO ^DIC
- +26 IF Y=-1
- SET DUOUT=1
- IF $DATA(DUOUT)!$DATA(DTOUT)
- QUIT
- +27 ;Update sub-status field in national status
- +28 NEW FDA,FDAIEN,MSG
- +29 SET FDA(801.9001,"+2,"_+Y_",",.01)=LIEN
- +30 DO UPDATE^DIE("S","FDA","FDAIEN","MSG")
- +31 IF $DATA(MSG)
- DO ERR
- +32 QUIT
- +33 ;
- +34 ;Error Messages from UPDATE^DIE
- +35 ;------------------------------
- ERR NEW IC,ERROR,REF
- +1 ;Move MSG into ERROR
- +2 SET REF="MSG"
- SET ERROR(1)="Error in UPDATE^DIE, needs further investigation"
- +3 FOR IC=2:1
- SET REF=$QUERY(@REF)
- IF REF=""
- QUIT
- SET ERROR(IC)=REF_"="_@REF
- +4 ;Screen message
- +5 DO BMES^XPDUTL(.ERROR)
- +6 QUIT
- +7 ;
- KILLAC ;This only applies if deleting a sub-status
- +1 IF '$DATA(^PXRMD(801.9,DA))
- QUIT
- +2 ;
- +3 NEW SUB,NAT
- +4 ;Get the national status for this sub status, quit if none
- +5 SET NAT=""
- +6 FOR
- SET NAT=$ORDER(^PXRMD(801.9,"AC",DA,NAT))
- IF NAT=""
- QUIT
- Begin DoDot:1
- +7 ;Get sub status position in the national code, quit if none
- +8 SET SUB=$ORDER(^PXRMD(801.9,"AC",DA,NAT,""))
- IF SUB=""
- QUIT
- +9 ;Kill the sub-status on the national code
- +10 NEW DIC,DIK,DA
- SET DIK="^PXRMD(801.9,NAT,10,"
- SET DA(1)=NAT
- SET DA=SUB
- DO ^DIK
- End DoDot:1
- +11 QUIT