DVBAP230.m

DVBAP230 ;ALB/MF - AMIE EXAM (#396.6) FILE UPDATE ; Feb 18, 2021@09:39:25

 ;;2.7;AMIE;**230**;Apr 10, 1995;Build 2

 ;

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

 ;to modify the AMIE EXAM file (#396.6)

 ;

 Q

 ;

POST ; entry point

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

 ;

 D NAMECHG ;change exam names

 ;

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

 D MES^XPDUTL(" ")

 Q

NAMECHG ;* change exam names

 ;

 ;  DVBAXX is in format:

 ;   OLD EXAM NAME^NEW EXAM NAME

 ;

 N DVBAX,DVBAXX,DVBADA,DA,DR,DIC,DIE,X,Y,DVBASTR

 D BMES^XPDUTL("Changing names in AMIE EXAM file (#396.6)...")

 D MES^XPDUTL(" ")

 F DVBAX=1:1 S DVBAXX=$P($T(CHNG+DVBAX),";;",2) Q:DVBAXX="QUIT"  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 DA=DVBADA,DR=".01///^S X=$P(DVBAXX,U,2)",DIE="^DVB(396.6," D ^DIE

 ...D MES^XPDUTL(" ")

 ...D MES^XPDUTL("   Entry #"_DVBADA_" for "_$P(DVBAXX,U,1))

 ...D BMES^XPDUTL("      ... field (#.01) updated to  "_$P(DVBAXX,U,2)_".")

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

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

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

 Q

 ;

CHNG ;name changes - old exam name^new exam name

 ;;Bones (fractures and bone diseases)^DBQ MUSC Bones and other skeletal conditions

 ;;QUIT

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVBAP230   1431     printed  Apr 09, 2024@20:44:08                                                                                                                                                                                                    Page 2

DVBAP230  ;ALB/MF - AMIE EXAM (#396.6) FILE UPDATE ; Feb 18, 2021@09:39:25

 +1       ;;2.7;AMIE;**230**;Apr 10, 1995;Build 2

 +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 

 +7       ;

POST      ; entry point

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

 +2       ;

 +3       ;change exam names

           DO NAMECHG

 +4       ;

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

 +6        DO MES^XPDUTL(" ")

 +7        QUIT 

NAMECHG   ;* change exam names

 +1       ;

 +2       ;  DVBAXX is in format:

 +3       ;   OLD EXAM NAME^NEW EXAM NAME

 +4       ;

 +5        NEW DVBAX,DVBAXX,DVBADA,DA,DR,DIC,DIE,X,Y,DVBASTR

 +6        DO BMES^XPDUTL("Changing names in AMIE EXAM file (#396.6)...")

 +7        DO MES^XPDUTL(" ")

 +8        FOR DVBAX=1:1

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

               if DVBAXX="QUIT"

                   QUIT 

               Begin DoDot:1

 +9                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

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

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

                                   Begin DoDot:3

 +11                                   SET DA=DVBADA

                                       SET DR=".01///^S X=$P(DVBAXX,U,2)"

                                       SET DIE="^DVB(396.6,"

                                       DO ^DIE

 +12                                   DO MES^XPDUTL(" ")

 +13                                   DO MES^XPDUTL("   Entry #"_DVBADA_" for "_$PIECE(DVBAXX,U,1))

 +14                                   DO BMES^XPDUTL("      ... field (#.01) updated to  "_$PIECE(DVBAXX,U,2)_".")

                                   End DoDot:3

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

                               Begin DoDot:3

 +16                               SET DVBASTR="Can't find entry for "_$PIECE(DVBAXX,U,1)

 +17                               DO BMES^XPDUTL(DVBASTR_" ...field (#.01) not updated.")

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +18       QUIT 

 +19      ;

CHNG      ;name changes - old exam name^new exam name

 +1       ;;Bones (fractures and bone diseases)^DBQ MUSC Bones and other skeletal conditions

 +2       ;;QUIT

 +3       ;