DVBA159P ;ALB/KCL,RLC,ECF - PATCH DVBA*2.7*159 INSTALL UTILITIES ; 10/20/2010
;;2.7;AMIE;**159**;Apr 10, 1995;Build 5
;
;No direct entry allowed
Q
;
PRE ;Main entry point for Pre-install items
;
D BMES^XPDUTL("***** PRE-INSTALL PROCESSING *****")
D DEACT ;de-activate older versions of CAPRI templates
;
Q
;
;
POST ;Main entry point for Post-install items
;
D BMES^XPDUTL("***** POST-INSTALL PROCESSING *****")
D ACTIVATE ;activate CAPRI templates that were loaded by the patch
D AMIE ;updates for the AMIE EXAM (#396.6) file
;
Q
;
;
DEACT ;De-activate older versions of CAPRI templates
;
;Used to disable older versions of a template for those templates being
;exported with the patch.
; - Make sure to call the DISABLE procedure for each template name
; being exported in the patch.
; - This must be called as a pre-init or else it will disable the
; templates that are being loaded by the patch.
;
N DVBVERSS,DVBVERSN,DVBACTR
;
;what the template version will be in the incoming patch
;(version pulled from export account)
S DVBVERSS="159F"
;
;what the final template version should be once the template is
;loaded by the patch on the target system
S DVBVERSN="159T5"
S DVBACTR=0
;
D BMES^XPDUTL(" Disabling CAPRI templates...")
D MES^XPDUTL(" ")
;
D DISABLE("DBQ ISCHEMIC HEART DISEASE")
D DISABLE("DBQ LEUKEMIA")
D DISABLE("DBQ PARKINSONS")
;
D BMES^XPDUTL(" Number of CAPRI templates disabled: "_DVBACTR)
Q
;
;
ACTIVATE ;Activate CAPRI templates that were loaded by the patch
;
;Used to activate/rename templates that were loaded by the patch.
; - Make sure to call RENAME procedure for each template name
; being loaded by the patch.
; - Must be called as a post-init in order to rename those
; templates being loaded by the patch.
;
N DVBVERSS,DVBVERSN,DVBACTR
;
;what the template version will be in the incoming patch
;(version pulled from export account)
S DVBVERSS="159F"
;
;what the final template version should be once the template is
;loaded by the patch on the target system
S DVBVERSN="159T5"
S DVBACTR=0
;
D BMES^XPDUTL(" Activating CAPRI templates...")
D MES^XPDUTL(" ")
;
D RENAME("DBQ ISCHEMIC HEART DISEASE")
D RENAME("DBQ LEUKEMIA")
D RENAME("DBQ PARKINSONS")
;
D BMES^XPDUTL(" Number of CAPRI templates activated: "_DVBACTR)
Q
;
;
DISABLE(NM) ;Disable matching CAPRI template entries
;
;This procedure will find each entry in the CAPRI TEMPLATE DEFINITIONS
;(#396.18) file that matches the name (NM) of the template being exported.
;Once a matching entry is found, it will be disabled if the version
;suffix (i.e. ~140) does not match the version suffix that will be used
;for templates loaded by the patch on the target system (i.e. ~159T5).
;
;An entry will be disabled by doing the following:
; - Turning off the SELECTABLE BY USER? field. This will keep the entry
; from showing in the CAPRI GUI template list.
; - Looking at DE-ACTIVATION DATE field. If there's no date, set it to today.
;
N DVBABIEN ;ien of CAPRI TEMPLATE DEFINITIONS file
N DVBABST ;template NAME field (i.e. DBQ PARKINSONS~154T5)
N DVBACH ;flag used to indicate template was disabled
N DVBAFDA ;FDA array for FILE^DIE
N DVBAERR ;error array for FILE^DIE
N DVBAMSG1 ;used to write msg to installer/Install file entry
;
S DVBABIEN=0
;
;walk through CAPRI TEMPLATE DEFINITIONS file entries
F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
.S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1) ;template name
.;if name matches and version is different, then disable entry
.I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)'=DVBVERSN D
..S DVBACH=0
..;turn SELECTABLE BY USER (#7) field off
..I $P($G(^DVB(396.18,DVBABIEN,6)),"^",1)'="0" S DVBAFDA(396.18,DVBABIEN_",",7)="0",DVBACH=1
..;set DE-ACTIVATION DATE (#3) field to TODAY
..I $P($G(^DVB(396.18,DVBABIEN,2)),"^",2)="" S DVBAFDA(396.18,DVBABIEN_",",3)=DT,DVBACH=1
..;output list of disabled templates
..I DVBACH=1 D
...S DVBACTR=DVBACTR+1
...D FILE^DIE("","DVBAFDA","DVBAERR")
...D MES^XPDUTL(" Disabling: "_DVBABST)
...I $D(DVBAERR) D
....D MSG^DIALOG("AE",.DVBAMSG1,"","","DVBAERR")
....D MES^XPDUTL(.DVBAMSG1)
;
K DVBABIEN,DVBABST,DVBACH
Q
;
;
RENAME(NM) ;Rename CAPRI templates loaded by the patch
;
;This procedure is used to lookup and rename a template in the
;CAPRI TEMPLATE DEFINITIONS (#396.18) file. This is done to rename
;the imported version of a template (i.e. DBQ PARKINSONS~159F) to its
;new name/version (i.e. DBQ PARKINSONS~159T5).
;
N DVBABIEN,DVBABIE2 ;ien of CAPRI TEMPLATE DEFINITIONS file
N DVBABST ;template NAME field (i.e. AUDIO~159F)
N DVBABS2 ;template NAME field (i.e. AUDIO~159T5)
N DVBACH ;flag to indicate if template version is found or not
N DVBAFDA ;FDA array for FILE^DIE
N DVBAERR ;error array for FILE^DIE
N DVBAMSG,DVBAMSG1 ;used to write msg to installer/Install file entry
N DVBAADT ;template activation date
;
S DVBABIEN=0
;
;main loop-walk through CAPRI TEMPLATE DEFINITIONS file entries
F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
.S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1) ;template name
.;look for template versions just loaded by the patch (~159F)
.I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)=DVBVERSS D
..S DVBABIE2=0,DVBACH=0
..;secondary loop-walk through CAPRI TEMPLATE DEFINITIONS file entries
..F S DVBABIE2=$O(^DVB(396.18,DVBABIE2)) Q:'DVBABIE2 D
...S DVBABS2=$P($G(^DVB(396.18,DVBABIE2,0)),"^",1) ;template name
...;if new version of template already exists in file, set flag
...I $P(DVBABS2,"~",1)=NM I $P(DVBABS2,"~",2)=DVBVERSN S DVBACH=1
..;if new version already exists, delete the imported version (abort rename)
..I DVBACH=1 D
...S DVBAMSG=" Found existing "_NM_". No modifications made."
...S DVBAFDA(396.18,DVBABIEN_",",.01)="@"
...D FILE^DIE("","DVBAFDA","DVBAERR")
..;otherwise, if new version isn't found, rename imported template
..;name to the new version name (i.e. DBQ PARKINSONS~159F --> DBQ PARKINSONS~159T5)
..I DVBACH=0 D
...S DVBAADT=$P($G(^DVB(396.18,DVBABIEN,2)),"^")
...S DVBACTR=DVBACTR+1
...S DVBAFDA(396.18,DVBABIEN_",",.01)=NM_"~"_DVBVERSN
...I DVBAADT=""!(DVBAADT<DT) S DVBAFDA(396.18,DVBABIEN_",",2)=DT
...D FILE^DIE("","DVBAFDA","DVBAERR")
...S DVBAMSG=" Activating: "_$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
..D MES^XPDUTL(DVBAMSG)
..I $D(DVBAERR) D
...D MSG^DIALOG("AE",.DVBAMSG1,"","","DVBAERR")
...D MES^XPDUTL(.DVBAMSG1)
;
K DVBABIEN,DVBABST,DVBACH
Q
;
AMIE ;Updates for the AMIE EXAM (#396.6) file
;
;Used to inactivate old entries and create new entries for designated
;worksheet updates
;
D BMES^XPDUTL(" Update to AMIE EXAM (#396.6) file...")
D MES^XPDUTL(" ")
I '$D(^DVB(396.6)) D BMES^XPDUTL("Missing AMIE EXAM (#396.6) file") Q
I $D(^DVB(396.6)) D
.D INACT
.D NEW
Q
;
;
INACT ;Inactivate old (current) exams
;
N LINE,IEN,EXM,PNM,BDY,ROU,STAT,WKS,DIE,DR,DA,X,Y,DVBAI
;
D BMES^XPDUTL(" Inactivating AMIE EXAM (#396.6) file entries...")
F DVBAI=1:1 S LINE=$P($T(TXTOLD+DVBAI),";;",2) Q:LINE="QUIT" D
.D GET K X,Y,DA
.I $P($G(^DVB(396.6,IEN,0)),"^",1)'=EXM D Q
..D BMES^XPDUTL(" *** Warning - Entry #"_IEN)
..D MES^XPDUTL(" for exam "_EXM)
..D MES^XPDUTL(" could not be inactivated.")
.S DIE="^DVB(396.6,",DA=IEN,DR=".5///I" D ^DIE
.D BMES^XPDUTL(" Entry #"_IEN_" for exam "_EXM)
.D MES^XPDUTL(" successfully inactivated.")
D MES^XPDUTL(" ")
Q
;
;
NEW ;Add new exam entries
;
N LINE,IEN,EXM,PNM,BDY,ROU,STAT,WKS,DIC,DIC,DR,DA,X,Y,DINUM,DVBAI
;
D BMES^XPDUTL(" Adding new AMIE EXAM (#396.6) file entries...")
F DVBAI=1:1 S LINE=$P($T(TXTNEW+DVBAI),";;",2) Q:LINE="QUIT" D
.D GET K X,Y,DA
.D BMES^XPDUTL(" Attempting to add Entry #"_IEN_"...")
.I $D(^DVB(396.6,IEN,0)) D Q
..D MES^XPDUTL(" You have an Entry #"_IEN_".")
..D MES^XPDUTL(" Updating "_EXM_".")
..S DIE="^DVB(396.6,",DA=IEN,DR=".01///"_EXM_";.5///"_STAT_";2///"_BDY_";6///"_PNM_";7///"_ROU
..D ^DIE
.S DIC="^DVB(396.6,",DIC(0)="LZ",X=EXM,DINUM=IEN
.S DIC("DR")=".5///"_STAT_";2///"_BDY_";6///"_PNM_";7///"_ROU
.K DD,DO D FILE^DICN
.I +Y=IEN D Q
..D MES^XPDUTL(" Successfully added Entry #"_IEN)
..D MES^XPDUTL(" for exam "_EXM_".")
.I +Y=-1 D
..D MES^XPDUTL(" *** Warning - Unable to add Entry #"_IEN)
..D MES^XPDUTL(" for exam "_EXM_".")
Q
;
;
GET ;Get exam data
;
S (IEN,EXM,PNM,BDY,ROU,STAT,WKS)=""
S IEN=$P(LINE,";",1) ;ien
S EXM=$P(LINE,";",2) ;exam name
S PNM=$P(LINE,";",3) ;print name
S BDY=$P(LINE,";",4) ;body system
S ROU=$P(LINE,";",5) ;routine name
S STAT=$P(LINE,";",6) ;status
S WKS=$P(LINE,";",8) ;worksheet number
Q
;
; Entries to be inactivated
; format: ien;exam name;;;routine;status;;wks#
TXTOLD ;
;;235;DBQ LEUKEMIA;DBQ LEUKEMIA;22;DVBCQBC1;I; ; ;
;;236;DBQ PARKINSONS;DBQ PARKINSONS DISEASE;13;DVBCQPD1;I; ; ;
;;237;DBQ ISCHEMIC HEART DISEASE;DBQ ISCHEMIC HEART DIS;6;DVBCQIH1;I; ;
;;QUIT
;
; New exam(s) to activate
; format: ien;exam name;print name;body system;routine;status;;wks#
TXTNEW ;
;;300;DBQ PARKINSONS;DBQ PARKINSONS DISEASE;13;DVBCQPD3;A; ; ;
;;301;DBQ ISCHEMIC HEART DISEASE;DBQ ISCHEMIC HEART DIS;6;DVBCQIH3;A; ;
;;302;DBQ LEUKEMIA;DBQ LEUKEMIA;22;DVBCQBC3;A; ; ;
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBA159P 9570 printed Nov 22, 2024@16:49:19 Page 2
DVBA159P ;ALB/KCL,RLC,ECF - PATCH DVBA*2.7*159 INSTALL UTILITIES ; 10/20/2010
+1 ;;2.7;AMIE;**159**;Apr 10, 1995;Build 5
+2 ;
+3 ;No direct entry allowed
+4 QUIT
+5 ;
PRE ;Main entry point for Pre-install items
+1 ;
+2 DO BMES^XPDUTL("***** PRE-INSTALL PROCESSING *****")
+3 ;de-activate older versions of CAPRI templates
DO DEACT
+4 ;
+5 QUIT
+6 ;
+7 ;
POST ;Main entry point for Post-install items
+1 ;
+2 DO BMES^XPDUTL("***** POST-INSTALL PROCESSING *****")
+3 ;activate CAPRI templates that were loaded by the patch
DO ACTIVATE
+4 ;updates for the AMIE EXAM (#396.6) file
DO AMIE
+5 ;
+6 QUIT
+7 ;
+8 ;
DEACT ;De-activate older versions of CAPRI templates
+1 ;
+2 ;Used to disable older versions of a template for those templates being
+3 ;exported with the patch.
+4 ; - Make sure to call the DISABLE procedure for each template name
+5 ; being exported in the patch.
+6 ; - This must be called as a pre-init or else it will disable the
+7 ; templates that are being loaded by the patch.
+8 ;
+9 NEW DVBVERSS,DVBVERSN,DVBACTR
+10 ;
+11 ;what the template version will be in the incoming patch
+12 ;(version pulled from export account)
+13 SET DVBVERSS="159F"
+14 ;
+15 ;what the final template version should be once the template is
+16 ;loaded by the patch on the target system
+17 SET DVBVERSN="159T5"
+18 SET DVBACTR=0
+19 ;
+20 DO BMES^XPDUTL(" Disabling CAPRI templates...")
+21 DO MES^XPDUTL(" ")
+22 ;
+23 DO DISABLE("DBQ ISCHEMIC HEART DISEASE")
+24 DO DISABLE("DBQ LEUKEMIA")
+25 DO DISABLE("DBQ PARKINSONS")
+26 ;
+27 DO BMES^XPDUTL(" Number of CAPRI templates disabled: "_DVBACTR)
+28 QUIT
+29 ;
+30 ;
ACTIVATE ;Activate CAPRI templates that were loaded by the patch
+1 ;
+2 ;Used to activate/rename templates that were loaded by the patch.
+3 ; - Make sure to call RENAME procedure for each template name
+4 ; being loaded by the patch.
+5 ; - Must be called as a post-init in order to rename those
+6 ; templates being loaded by the patch.
+7 ;
+8 NEW DVBVERSS,DVBVERSN,DVBACTR
+9 ;
+10 ;what the template version will be in the incoming patch
+11 ;(version pulled from export account)
+12 SET DVBVERSS="159F"
+13 ;
+14 ;what the final template version should be once the template is
+15 ;loaded by the patch on the target system
+16 SET DVBVERSN="159T5"
+17 SET DVBACTR=0
+18 ;
+19 DO BMES^XPDUTL(" Activating CAPRI templates...")
+20 DO MES^XPDUTL(" ")
+21 ;
+22 DO RENAME("DBQ ISCHEMIC HEART DISEASE")
+23 DO RENAME("DBQ LEUKEMIA")
+24 DO RENAME("DBQ PARKINSONS")
+25 ;
+26 DO BMES^XPDUTL(" Number of CAPRI templates activated: "_DVBACTR)
+27 QUIT
+28 ;
+29 ;
DISABLE(NM) ;Disable matching CAPRI template entries
+1 ;
+2 ;This procedure will find each entry in the CAPRI TEMPLATE DEFINITIONS
+3 ;(#396.18) file that matches the name (NM) of the template being exported.
+4 ;Once a matching entry is found, it will be disabled if the version
+5 ;suffix (i.e. ~140) does not match the version suffix that will be used
+6 ;for templates loaded by the patch on the target system (i.e. ~159T5).
+7 ;
+8 ;An entry will be disabled by doing the following:
+9 ; - Turning off the SELECTABLE BY USER? field. This will keep the entry
+10 ; from showing in the CAPRI GUI template list.
+11 ; - Looking at DE-ACTIVATION DATE field. If there's no date, set it to today.
+12 ;
+13 ;ien of CAPRI TEMPLATE DEFINITIONS file
NEW DVBABIEN
+14 ;template NAME field (i.e. DBQ PARKINSONS~154T5)
NEW DVBABST
+15 ;flag used to indicate template was disabled
NEW DVBACH
+16 ;FDA array for FILE^DIE
NEW DVBAFDA
+17 ;error array for FILE^DIE
NEW DVBAERR
+18 ;used to write msg to installer/Install file entry
NEW DVBAMSG1
+19 ;
+20 SET DVBABIEN=0
+21 ;
+22 ;walk through CAPRI TEMPLATE DEFINITIONS file entries
+23 FOR
SET DVBABIEN=$ORDER(^DVB(396.18,DVBABIEN))
if 'DVBABIEN
QUIT
Begin DoDot:1
+24 ;template name
SET DVBABST=$PIECE($GET(^DVB(396.18,DVBABIEN,0)),"^",1)
+25 ;if name matches and version is different, then disable entry
+26 IF $PIECE(DVBABST,"~",1)=NM
IF $PIECE(DVBABST,"~",2)'=DVBVERSN
Begin DoDot:2
+27 SET DVBACH=0
+28 ;turn SELECTABLE BY USER (#7) field off
+29 IF $PIECE($GET(^DVB(396.18,DVBABIEN,6)),"^",1)'="0"
SET DVBAFDA(396.18,DVBABIEN_",",7)="0"
SET DVBACH=1
+30 ;set DE-ACTIVATION DATE (#3) field to TODAY
+31 IF $PIECE($GET(^DVB(396.18,DVBABIEN,2)),"^",2)=""
SET DVBAFDA(396.18,DVBABIEN_",",3)=DT
SET DVBACH=1
+32 ;output list of disabled templates
+33 IF DVBACH=1
Begin DoDot:3
+34 SET DVBACTR=DVBACTR+1
+35 DO FILE^DIE("","DVBAFDA","DVBAERR")
+36 DO MES^XPDUTL(" Disabling: "_DVBABST)
+37 IF $DATA(DVBAERR)
Begin DoDot:4
+38 DO MSG^DIALOG("AE",.DVBAMSG1,"","","DVBAERR")
+39 DO MES^XPDUTL(.DVBAMSG1)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+40 ;
+41 KILL DVBABIEN,DVBABST,DVBACH
+42 QUIT
+43 ;
+44 ;
RENAME(NM) ;Rename CAPRI templates loaded by the patch
+1 ;
+2 ;This procedure is used to lookup and rename a template in the
+3 ;CAPRI TEMPLATE DEFINITIONS (#396.18) file. This is done to rename
+4 ;the imported version of a template (i.e. DBQ PARKINSONS~159F) to its
+5 ;new name/version (i.e. DBQ PARKINSONS~159T5).
+6 ;
+7 ;ien of CAPRI TEMPLATE DEFINITIONS file
NEW DVBABIEN,DVBABIE2
+8 ;template NAME field (i.e. AUDIO~159F)
NEW DVBABST
+9 ;template NAME field (i.e. AUDIO~159T5)
NEW DVBABS2
+10 ;flag to indicate if template version is found or not
NEW DVBACH
+11 ;FDA array for FILE^DIE
NEW DVBAFDA
+12 ;error array for FILE^DIE
NEW DVBAERR
+13 ;used to write msg to installer/Install file entry
NEW DVBAMSG,DVBAMSG1
+14 ;template activation date
NEW DVBAADT
+15 ;
+16 SET DVBABIEN=0
+17 ;
+18 ;main loop-walk through CAPRI TEMPLATE DEFINITIONS file entries
+19 FOR
SET DVBABIEN=$ORDER(^DVB(396.18,DVBABIEN))
if 'DVBABIEN
QUIT
Begin DoDot:1
+20 ;template name
SET DVBABST=$PIECE($GET(^DVB(396.18,DVBABIEN,0)),"^",1)
+21 ;look for template versions just loaded by the patch (~159F)
+22 IF $PIECE(DVBABST,"~",1)=NM
IF $PIECE(DVBABST,"~",2)=DVBVERSS
Begin DoDot:2
+23 SET DVBABIE2=0
SET DVBACH=0
+24 ;secondary loop-walk through CAPRI TEMPLATE DEFINITIONS file entries
+25 FOR
SET DVBABIE2=$ORDER(^DVB(396.18,DVBABIE2))
if 'DVBABIE2
QUIT
Begin DoDot:3
+26 ;template name
SET DVBABS2=$PIECE($GET(^DVB(396.18,DVBABIE2,0)),"^",1)
+27 ;if new version of template already exists in file, set flag
+28 IF $PIECE(DVBABS2,"~",1)=NM
IF $PIECE(DVBABS2,"~",2)=DVBVERSN
SET DVBACH=1
End DoDot:3
+29 ;if new version already exists, delete the imported version (abort rename)
+30 IF DVBACH=1
Begin DoDot:3
+31 SET DVBAMSG=" Found existing "_NM_". No modifications made."
+32 SET DVBAFDA(396.18,DVBABIEN_",",.01)="@"
+33 DO FILE^DIE("","DVBAFDA","DVBAERR")
End DoDot:3
+34 ;otherwise, if new version isn't found, rename imported template
+35 ;name to the new version name (i.e. DBQ PARKINSONS~159F --> DBQ PARKINSONS~159T5)
+36 IF DVBACH=0
Begin DoDot:3
+37 SET DVBAADT=$PIECE($GET(^DVB(396.18,DVBABIEN,2)),"^")
+38 SET DVBACTR=DVBACTR+1
+39 SET DVBAFDA(396.18,DVBABIEN_",",.01)=NM_"~"_DVBVERSN
+40 IF DVBAADT=""!(DVBAADT<DT)
SET DVBAFDA(396.18,DVBABIEN_",",2)=DT
+41 DO FILE^DIE("","DVBAFDA","DVBAERR")
+42 SET DVBAMSG=" Activating: "_$PIECE($GET(^DVB(396.18,DVBABIEN,0)),"^",1)
End DoDot:3
+43 DO MES^XPDUTL(DVBAMSG)
+44 IF $DATA(DVBAERR)
Begin DoDot:3
+45 DO MSG^DIALOG("AE",.DVBAMSG1,"","","DVBAERR")
+46 DO MES^XPDUTL(.DVBAMSG1)
End DoDot:3
End DoDot:2
End DoDot:1
+47 ;
+48 KILL DVBABIEN,DVBABST,DVBACH
+49 QUIT
+50 ;
AMIE ;Updates for the AMIE EXAM (#396.6) file
+1 ;
+2 ;Used to inactivate old entries and create new entries for designated
+3 ;worksheet updates
+4 ;
+5 DO BMES^XPDUTL(" Update to AMIE EXAM (#396.6) file...")
+6 DO MES^XPDUTL(" ")
+7 IF '$DATA(^DVB(396.6))
DO BMES^XPDUTL("Missing AMIE EXAM (#396.6) file")
QUIT
+8 IF $DATA(^DVB(396.6))
Begin DoDot:1
+9 DO INACT
+10 DO NEW
End DoDot:1
+11 QUIT
+12 ;
+13 ;
INACT ;Inactivate old (current) exams
+1 ;
+2 NEW LINE,IEN,EXM,PNM,BDY,ROU,STAT,WKS,DIE,DR,DA,X,Y,DVBAI
+3 ;
+4 DO BMES^XPDUTL(" Inactivating AMIE EXAM (#396.6) file entries...")
+5 FOR DVBAI=1:1
SET LINE=$PIECE($TEXT(TXTOLD+DVBAI),";;",2)
if LINE="QUIT"
QUIT
Begin DoDot:1
+6 DO GET
KILL X,Y,DA
+7 IF $PIECE($GET(^DVB(396.6,IEN,0)),"^",1)'=EXM
Begin DoDot:2
+8 DO BMES^XPDUTL(" *** Warning - Entry #"_IEN)
+9 DO MES^XPDUTL(" for exam "_EXM)
+10 DO MES^XPDUTL(" could not be inactivated.")
End DoDot:2
QUIT
+11 SET DIE="^DVB(396.6,"
SET DA=IEN
SET DR=".5///I"
DO ^DIE
+12 DO BMES^XPDUTL(" Entry #"_IEN_" for exam "_EXM)
+13 DO MES^XPDUTL(" successfully inactivated.")
End DoDot:1
+14 DO MES^XPDUTL(" ")
+15 QUIT
+16 ;
+17 ;
NEW ;Add new exam entries
+1 ;
+2 NEW LINE,IEN,EXM,PNM,BDY,ROU,STAT,WKS,DIC,DIC,DR,DA,X,Y,DINUM,DVBAI
+3 ;
+4 DO BMES^XPDUTL(" Adding new AMIE EXAM (#396.6) file entries...")
+5 FOR DVBAI=1:1
SET LINE=$PIECE($TEXT(TXTNEW+DVBAI),";;",2)
if LINE="QUIT"
QUIT
Begin DoDot:1
+6 DO GET
KILL X,Y,DA
+7 DO BMES^XPDUTL(" Attempting to add Entry #"_IEN_"...")
+8 IF $DATA(^DVB(396.6,IEN,0))
Begin DoDot:2
+9 DO MES^XPDUTL(" You have an Entry #"_IEN_".")
+10 DO MES^XPDUTL(" Updating "_EXM_".")
+11 SET DIE="^DVB(396.6,"
SET DA=IEN
SET DR=".01///"_EXM_";.5///"_STAT_";2///"_BDY_";6///"_PNM_";7///"_ROU
+12 DO ^DIE
End DoDot:2
QUIT
+13 SET DIC="^DVB(396.6,"
SET DIC(0)="LZ"
SET X=EXM
SET DINUM=IEN
+14 SET DIC("DR")=".5///"_STAT_";2///"_BDY_";6///"_PNM_";7///"_ROU
+15 KILL DD,DO
DO FILE^DICN
+16 IF +Y=IEN
Begin DoDot:2
+17 DO MES^XPDUTL(" Successfully added Entry #"_IEN)
+18 DO MES^XPDUTL(" for exam "_EXM_".")
End DoDot:2
QUIT
+19 IF +Y=-1
Begin DoDot:2
+20 DO MES^XPDUTL(" *** Warning - Unable to add Entry #"_IEN)
+21 DO MES^XPDUTL(" for exam "_EXM_".")
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
+24 ;
GET ;Get exam data
+1 ;
+2 SET (IEN,EXM,PNM,BDY,ROU,STAT,WKS)=""
+3 ;ien
SET IEN=$PIECE(LINE,";",1)
+4 ;exam name
SET EXM=$PIECE(LINE,";",2)
+5 ;print name
SET PNM=$PIECE(LINE,";",3)
+6 ;body system
SET BDY=$PIECE(LINE,";",4)
+7 ;routine name
SET ROU=$PIECE(LINE,";",5)
+8 ;status
SET STAT=$PIECE(LINE,";",6)
+9 ;worksheet number
SET WKS=$PIECE(LINE,";",8)
+10 QUIT
+11 ;
+12 ; Entries to be inactivated
+13 ; format: ien;exam name;;;routine;status;;wks#
TXTOLD ;
+1 ;;235;DBQ LEUKEMIA;DBQ LEUKEMIA;22;DVBCQBC1;I; ; ;
+2 ;;236;DBQ PARKINSONS;DBQ PARKINSONS DISEASE;13;DVBCQPD1;I; ; ;
+3 ;;237;DBQ ISCHEMIC HEART DISEASE;DBQ ISCHEMIC HEART DIS;6;DVBCQIH1;I; ;
+4 ;;QUIT
+5 ;
+6 ; New exam(s) to activate
+7 ; format: ien;exam name;print name;body system;routine;status;;wks#
TXTNEW ;
+1 ;;300;DBQ PARKINSONS;DBQ PARKINSONS DISEASE;13;DVBCQPD3;A; ; ;
+2 ;;301;DBQ ISCHEMIC HEART DISEASE;DBQ ISCHEMIC HEART DIS;6;DVBCQIH3;A; ;
+3 ;;302;DBQ LEUKEMIA;DBQ LEUKEMIA;22;DVBCQBC3;A; ; ;
+4 ;;QUIT
