Routine: DVBA236P

DVBA236P ;ALB/FSB - AMIE EXAM (#396.6) FILE UPDATE ; 8/30/21@09:30

 ;;2.7;AMIE;**236**;Apr 10, 1995;Build 6

 ;this routine is used as a post-init in a KIDS build

 ;to modify the AMIE EXAM file (#396.6)

POST ;

 D BMES^XPDUTL("Updating the AMIE EXAM file (#396.6)...")

 D STATCHG ; status change

 D BMES^XPDUTL("Update of AMIE EXAM file (#396.6) completed.")

STATCHG ;

 N DVBAX,DVBAXX,DVBADA,DVBARC,DA,DR,DIE,DVBASTR

 F DVBAX=1:1 S DVBAXX=$P($T(CHNG+DVBAX),";;",2) Q:DVBAXX=""  D

 .F DVBADA=0:0 S DVBADA=+$O(^DVB(396.6,"B",$E($P(DVBAXX,U,1),1,30),DVBADA)) Q:DVBADA=0  D

 ..I $D(^DVB(396.6,DVBADA,0)),$P(^DVB(396.6,DVBADA,0),U,5)="A" D

 ...S DIE="^DVB(396.6,",DA=DVBADA,DR=".5///I" D ^DIE

 ...D BMES^XPDUTL("Status for "_$P(DVBAXX,U,1)_" has been updated.")

 ..I '$D(^DVB(396.6,DVBADA,0)) D

 ...S DVBASTR="Can't find the record for "_$P(DVBAXX,U,1)

 ...D BMES^XPDUTL(DVBASTR_"... field (#.5) not updated.")

CHNG ;

 ;;DBQ GU Prostate cancer

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBA236P   977     printed  Mar 13, 2025@20:44:12                                                                                                                                                                                                     Page 2

DVBA236P  ;ALB/FSB - AMIE EXAM (#396.6) FILE UPDATE ; 8/30/21@09:30

 +1       ;;2.7;AMIE;**236**;Apr 10, 1995;Build 6

 +2       ;

 +3       ;this routine is used as a post-init in a KIDS build

 +4       ;to modify the AMIE EXAM file (#396.6)

 +5       ;

 +6        QUIT

POST      ;

 +1        DO BMES^XPDUTL("Updating the AMIE EXAM file (#396.6)...")

 +2       ; status change

           DO STATCHG

 +3        DO BMES^XPDUTL("Update of AMIE EXAM file (#396.6) completed.")

 +4        QUIT

STATCHG   ;

 +1        NEW DVBAX,DVBAXX,DVBADA,DVBARC,DA,DR,DIE,DVBASTR

 +2        FOR DVBAX=1:1

               SET DVBAXX=$PIECE($TEXT(CHNG+DVBAX),";;",2)

               if DVBAXX=""

                   QUIT

               Begin DoDot:1

 +3                FOR DVBADA=0:0

                       SET DVBADA=+$ORDER(^DVB(396.6,"B",$EXTRACT($PIECE(DVBAXX,U,1),1,30),DVBADA))

                       if DVBADA=0

                           QUIT

                       Begin DoDot:2

 +4                        IF $DATA(^DVB(396.6,DVBADA,0))

                               IF $PIECE(^DVB(396.6,DVBADA,0),U,5)="A"

                                   Begin DoDot:3

 +5                                    SET DIE="^DVB(396.6,"

                                       SET DA=DVBADA

                                       SET DR=".5///I"

                                       DO ^DIE

 +6                                    DO BMES^XPDUTL("Status for "_$PIECE(DVBAXX,U,1)_" has been updated.")

                                   End DoDot:3

 +7                        IF '$DATA(^DVB(396.6,DVBADA,0))

                               Begin DoDot:3

 +8                                SET DVBASTR="Can't find the record for "_$PIECE(DVBAXX,U,1)

 +9                                DO BMES^XPDUTL(DVBASTR_"... field (#.5) not updated.")

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +10       QUIT

CHNG      ;

 +1       ;;DBQ GU Prostate cancer

DVBA236P.m