PXRMSEDT.m

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