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 ---[H[J[2J[HDVBAP230 1431 printed Dec 13, 2024@01:41:30 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 ;
