DVBAUTLP ;ALB/SBW - Pre/Post Install APIs For CAPRI Templates & AMIE Exams ; 8/MAR/2011
;;2.7;AMIE;**166**;Apr 10, 1995;Build 6
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; No direct entry allowed
Q
;
; This Pre/Post Install Utility has APIs for Disabling and Activating/
; Renaming CAPRI Templates Definition (File #396.18) entries.
; It also has APIs for Inactivating old and Creating new AMIE or
; Updating existing Exams (File # 396.6) entries.
;
; Note that for Development Test Environments and VAMC Test Sites there
; will be a CAPRI Template Definition entry for each Test Patch Version
; and the Released Patch installed. At all VAMC Sites who did not test
; the patch there will be just one released version per patch for which
; the original or updated template was distributed differentiated
; by Patch Number Version Suffix.
;
;
DISABLE(DVBNM,DVBVERSN,DVBACTR,DVBAMSG) ;Disable matching CAPRI template entries
;
; This procedure will find each entry in the CAPRI TEMPLATE
; DEFINITIONS (#396.18) file where the first delimited (~) piece
; matches the passed name (DVBNM) of the template being exported. Once
; a matching entry is found, it will be disabled if the 396.18 entry
; Version Suffix does not match the Passed (DVBERSN) Version Suffix
; to be used for new templates to be added by the patch.
; Format for Template Name is:
; Name~Version Suffix (e.g. DBQ TEST EXAMPLE~999T1)
;
; 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.
;
;INPUT:
; DVBNM - Name of CAPRI template entry to be disabled
; DVBVERSN - Patch Version Suffix (e.g. 999 or 999T1)
; Format for version suffix are:
; Released patch will be just Patch Number (e.g 999)
; Test Patch will be Patch Number with a "T" and Test Patch
; Version Number (e.g. 999T1)
;INPUT/OUTPUT:
; DVBACTR - Passed variable which contains the number of
; CAPRI templates disabled (Incremented by one for
; each CAPRI template successfully disabled.
; DVBAMSG - Array variable passed back to calling API with
; API result messages
;
;Quit if Template name or Version is not passed
Q:$G(DVBNM)=""!($G(DVBVERSN)="")
;
N DVBABIEN ;ien of CAPRI TEMPLATE DEFINITIONS file
N DVBABST ;template NAME field (i.e. DBQ PARKINSONS~999T1)
N DVBACH ;flag used to indicate template was disabled
N DVBAFDA ;FDA array for FILE^DIE
N DVBMCTR ;status message counter
;
S DVBABIEN=0,DVBMCTR=0
;
;walk through CAPRI TEMPLATE DEFINITIONS (#396.18) file entries
F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
. S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),U,1) ;template name
. ;if name matches and version is different, then disable entry
. I $P(DVBABST,"~",1)=DVBNM I $P(DVBABST,"~",2)'=DVBVERSN D
. . S DVBACH=0
. . ;turn SELECTABLE BY USER (#7) field off
. . I $P($G(^DVB(396.18,DVBABIEN,6)),U,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)),U,2)="" S DVBAFDA(396.18,DVBABIEN_",",3)=DT,DVBACH=1
. . N DVBAERR ;Array where error can be stored for Fileman calls
. . ;output list of disabled templates
. . I DVBACH=1 D
. . . D FILE^DIE("K","DVBAFDA","DVBAERR")
. . . S:$D(DVBAERR("DIERR"))'>0 DVBACTR=+$G(DVBACTR)+1
. . . S DVBMCTR=DVBMCTR+1
. . . S DVBAMSG(DVBMCTR)=" Disabling: "_DVBABST
. . . ; Include Fileman Error message returned if any
. . . I $D(DVBAERR("DIERR"))>0 D
. . . . S DVBMCTR=DVBMCTR+1
. . . . S DVBAMSG(DVBMCTR)=" *** Warning - Unable to disable."
. . . . D ADDERR(.DVBAMSG,.DVBAERR,.DVBMCTR)
Q
;
RENAME(DVBNM,DVBVERSS,DVBVERSN,DVBACTR,DVBAMSG) ; 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~999F) to its new name/version (i.e. TEST - DBQ
; PARKINSONS~999T1 or RELEASED - DBQ PARKINSONS~999).
;
;INPUT:
; DVBNM - Name of CAPRI template entry to be disabled
; DVBVERSS - Incoming Patch Version Suffix (e.g. 999F)
; DVBVERSN - Rename Patch Version Suffix (e.g. 999 or 999T1)
; Format for version suffix are (delimiter is "~"):
; New entry to be renamed is Patch Number with a "F" (e.g 999F)
; Released patch will be just Patch Number (e.g 999)
; Test Patch will be Patch Number with a "T" and Test Patch
; Version Number (e.g. 999T1)
;INPUT/OUTPUT:
; DVBACTR - Passed variable which contains the number of
; CAPRI templates renamed (Incremented by one for
; each CAPRI template disabled.
; DVBAMSG - Array variable passed back to calling API with
; API result messages
;
;Quit if Template Name, or Incoming Patch Version, or New Patch
;Version is not passed
Q:$G(DVBNM)=""!($G(DVBVERSS)="")!($G(DVBVERSN)="")
;
N DVBABIEN,DVBABIE2 ;ien of CAPRI TEMPLATE DEFINITIONS file
N DVBABST ;incoming template NAME field (e.g. AUDIO~999F)
N DVBABS2 ;renamed template NAME field (e.g. AUDIO~999T1 or AUDIO~999)
N DVBACH ;flag to indicate if template version is found or not
N DVBAFDA ;FDA array for FILE^DIE
N DVBAADT ;template activation date
N DVBMCTR ;status message counter
;
S DVBABIEN=0,DVBMCTR=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)),U,1) ;template name
. ;look for template versions just loaded by the patch by
. ; Checking Version Suffix
. I $P(DVBABST,"~",1)=DVBNM 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
. . . ;Template Name
. . . S DVBABS2=$P($G(^DVB(396.18,DVBABIE2,0)),U,1)
. . . ; if new version of template exists in file, set flag
. . . I $P(DVBABS2,"~",1)=DVBNM,$P(DVBABS2,"~",2)=DVBVERSN S DVBACH=1
. . ; if new version already exists, delete the imported version
. . ; (abort rename)
. . N DVBAERR ;Array where error can be stored for Fileman calls
. . I DVBACH=1 D
. . . S DVBMCTR=DVBMCTR+1
. . . S DVBAMSG(DVBMCTR)=" Found existing "_DVBNM_DVBVERSN_". 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 (e.g.
. . ; DBQ PARKINSONS~999F --> DBQ PARKINSONS~999T1)
. . I DVBACH=0 D
. . . S DVBAADT=$P($G(^DVB(396.18,DVBABIEN,2)),U)
. . . S DVBAFDA(396.18,DVBABIEN_",",.01)=DVBNM_"~"_DVBVERSN
. . . I DVBAADT=""!(DVBAADT<DT) S DVBAFDA(396.18,DVBABIEN_",",2)=DT
. . . D FILE^DIE("K","DVBAFDA","DVBAERR")
. . . S:$D(DVBAERR("DIERR"))'>0 DVBACTR=+$G(DVBACTR)+1
. . . ;Include status message
. . . S DVBMCTR=DVBMCTR+1
. . . S DVBAMSG(DVBMCTR)=" Activating: "_$P($G(^DVB(396.18,DVBABIEN,0)),U,1)
. . . I $D(DVBAERR("DIERR"))>0 D
. . . . S DVBMCTR=DVBMCTR+1
. . . . S DVBAMSG(DVBMCTR)=" *** Warning - Unable to activate."
. . ;
. . ; Include Fileman Error message returned if any
. . I $D(DVBAERR("DIERR"))>0 D ADDERR(.DVBAMSG,.DVBAERR,.DVBMCTR)
;
Q
;
INACTEXM(DVBIEN,DVBEXM,DVBAMSG) ;Inactivate old (current) AMIE Exam
; (#396.6) Entries
;
;INPUT:
; DVBIEN - Internal Entry Number of AMIE Exam to be inactivated
; DVBEXM - Exam Name of entry to to be inactivated
;INPUT/OUTPUT:
; DVBAMSG - Array variable passed back to calling API with
; action result message
;
N DVBAFDA,DVBMCTR,DVBAERR
S DVBMCTR=0
; Quit if valid IEN and Exam (.01 field) not passed
Q:$G(DVBIEN)'>0!($G(DVBEXM)']"")
;If passed Exam Name different from .01 field, send warning msg
I $P($G(^DVB(396.6,+DVBIEN,0)),U,1)'=DVBEXM D
. ; Create error message if Exam Name in Entry is different
. S DVBMCTR=DVBMCTR+1
. S DVBAMSG(DVBMCTR)=" *** Warning - Entry #"_DVBIEN_" for exam"
. S DVBMCTR=DVBMCTR+1
. S DVBAMSG(DVBMCTR)=" "_DVBEXM
. S DVBMCTR=DVBMCTR+1
. S DVBAMSG(DVBMCTR)=" could not be inactivated. Check Exam Name!"
;If passed Exam Name is same as .01 fld update Status to Inactive
I $P($G(^DVB(396.6,+DVBIEN,0)),U,1)=DVBEXM D
. S DVBAFDA(396.6,+DVBIEN_",",.5)="I"
. D FILE^DIE("K","DVBAFDA","DVBAERR")
. ; Create status message if update successful
. I $D(DVBAERR("DIERR"))'>0 D
. . S DVBMCTR=DVBMCTR+1
. . S DVBAMSG(DVBMCTR)=" Entry #"_DVBIEN_" for exam "_DVBEXM
. . S DVBMCTR=DVBMCTR+1
. . S DVBAMSG(DVBMCTR)=" successfully inactivated."
. ; Create status message if error with update
. I $D(DVBAERR("DIERR"))>0 D
. . S DVBMCTR=DVBMCTR+1
. . S DVBAMSG(DVBMCTR)=" *** Warning - Unable to inactivate Entry #"_DVBIEN_" for exam"
. . S DVBMCTR=DVBMCTR+1
. . S DVBAMSG(DVBMCTR)=" "_DVBEXM_"."
. . ; Include Fileman Error message returned if any
. . D ADDERR(.DVBAMSG,.DVBAERR,.DVBMCTR)
Q
;
NEWEXAM(DVBIEN,DVBEXM,DVBPNM,DVBBDY,DVBROU,DVBSTAT,DVBWKS,DVBAMSG) ;
; Add new exam entries to AMIE EXAM (#396.6) File
;INPUT:
; DVBIEN - Internal Entry Number of AMIE Exam entry to be added
; DVBEXM - Name of AMIE Exam entry to be added
; DVBPNM - Print Name of AMIE Exam entry to be added
; DVBBDY - Body System of AMIE Exam entry to be added
; DVBROU - Reporting Program Name of AMIE Exam entry to be added
; DVBSTAT - Status of AMIE Exam entry to be added
; DVBWKS - AMIE Worksheet # of AMIE Exam entry to be added
;INPUT/OUTPUT:
; DVBAMSG - Array variable passed back to calling API with
; API result messages
;
N DVBAFDA,DVBAIEN,DVBMCTR,DVBAERR
S DVBMCTR=0
;
; Quit if valid IEN and Exam (.01 field) not passed
Q:$G(DVBIEN)'>0!($G(DVBEXM)']"")
; Update existing entry
I $D(^DVB(396.6,DVBIEN,0))>0 D
. S DVBMCTR=DVBMCTR+1
. S DVBAMSG(DVBMCTR)=" You have an Entry #"_DVBIEN_"."
. S DVBMCTR=DVBMCTR+1
. S DVBAMSG(DVBMCTR)=" Updating "_DVBEXM_"."
. S DVBAFDA(396.6,+DVBIEN_",",.01)=$G(DVBEXM)
. S DVBAFDA(396.6,+DVBIEN_",",.07)=$G(DVBWKS)
. S DVBAFDA(396.6,+DVBIEN_",",.5)=$G(DVBSTAT)
. S DVBAFDA(396.6,+DVBIEN_",",2)=$G(DVBBDY)
. S DVBAFDA(396.6,+DVBIEN_",",6)=$G(DVBPNM)
. S DVBAFDA(396.6,+DVBIEN_",",7)=$G(DVBROU)
. D FILE^DIE("K","DVBAFDA","DVBAERR")
. I $D(DVBAERR("DIERR"))'>0 D
. . S DVBMCTR=DVBMCTR+1
. . S DVBAMSG(DVBMCTR)=" Successfully updated Entry #"_DVBIEN_" for exam"
. . S DVBMCTR=DVBMCTR+1
. . S DVBAMSG(DVBMCTR)=" "_DVBEXM_"."
. I $D(DVBAERR("DIERR"))>0 D
. . S DVBMCTR=DVBMCTR+1
. . S DVBAMSG(DVBMCTR)=" *** Warning - Unable to update Entry."
;
; Add new entry
I $D(^DVB(396.6,DVBIEN,0))'>0 D
. S DVBAIEN(1)=DVBIEN
. S DVBAFDA(396.6,"+1,",.01)=$G(DVBEXM)
. S DVBAFDA(396.6,"+1,",.07)=$G(DVBWKS)
. S DVBAFDA(396.6,"+1,",.5)=$G(DVBSTAT)
. S DVBAFDA(396.6,"+1,",2)=$G(DVBBDY)
. S DVBAFDA(396.6,"+1,",6)=$G(DVBPNM)
. S DVBAFDA(396.6,"+1,",7)=$G(DVBROU)
. D UPDATE^DIE("","DVBAFDA","DVBAIEN","DVBAERR")
. I $D(DVBAERR("DIERR"))'>0 D
. . S DVBMCTR=DVBMCTR+1
. . S DVBAMSG(DVBMCTR)=" Successfully added Entry #"_DVBIEN_" for exam"
. . S DVBMCTR=DVBMCTR+1
. . S DVBAMSG(DVBMCTR)=" "_DVBEXM_"."
. I $D(DVBAERR("DIERR"))>0 D
. . S DVBMCTR=DVBMCTR+1
. . S DVBAMSG(DVBMCTR)=" *** Warning - Unable to add Entry #"_DVBIEN
. . S DVBMCTR=DVBMCTR+1
. . S DVBAMSG(DVBMCTR)=" for exam "_DVBEXM_"."
;
;Include FILE^DIE or UPDATE^DIE error message in DVBAMSG array
I $D(DVBAERR("DIERR"))>0 D ADDERR(.DVBAMSG,.DVBAERR,.DVBMCTR)
Q
;
ADDERR(DVBMSG,DVBERR,DVBCTR) ;Include passed FM error message into DVBMSG
;array
;INPUT:
; DVBERR - Passed error Array from Fileman call
;INPUT/OUTPUT:
; DVBMSG - Passed array with status messages. Passed FM Error will
; be added to array and returned to calling API
; DVBCTR - Passed Counter Variable to used for DVBMSG array. Updated
; Counter will be returned to call API.
;Quit if DVBERR isn't defined
Q:$D(DVBERR)'>0
N DVBMSG1,CTR
D MSG^DIALOG("AE",.DVBMSG1,"","","DVBERR")
S CTR=0
F S CTR=$O(DVBMSG1(CTR)) Q:CTR'>0 D
. S DVBCTR=$G(DVBCTR)+1
. S DVBMSG(DVBCTR)=" "_DVBMSG1(CTR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAUTLP 12787 printed Nov 22, 2024@16:52:37 Page 2
DVBAUTLP ;ALB/SBW - Pre/Post Install APIs For CAPRI Templates & AMIE Exams ; 8/MAR/2011
+1 ;;2.7;AMIE;**166**;Apr 10, 1995;Build 6
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; No direct entry allowed
+5 QUIT
+6 ;
+7 ; This Pre/Post Install Utility has APIs for Disabling and Activating/
+8 ; Renaming CAPRI Templates Definition (File #396.18) entries.
+9 ; It also has APIs for Inactivating old and Creating new AMIE or
+10 ; Updating existing Exams (File # 396.6) entries.
+11 ;
+12 ; Note that for Development Test Environments and VAMC Test Sites there
+13 ; will be a CAPRI Template Definition entry for each Test Patch Version
+14 ; and the Released Patch installed. At all VAMC Sites who did not test
+15 ; the patch there will be just one released version per patch for which
+16 ; the original or updated template was distributed differentiated
+17 ; by Patch Number Version Suffix.
+18 ;
+19 ;
DISABLE(DVBNM,DVBVERSN,DVBACTR,DVBAMSG) ;Disable matching CAPRI template entries
+1 ;
+2 ; This procedure will find each entry in the CAPRI TEMPLATE
+3 ; DEFINITIONS (#396.18) file where the first delimited (~) piece
+4 ; matches the passed name (DVBNM) of the template being exported. Once
+5 ; a matching entry is found, it will be disabled if the 396.18 entry
+6 ; Version Suffix does not match the Passed (DVBERSN) Version Suffix
+7 ; to be used for new templates to be added by the patch.
+8 ; Format for Template Name is:
+9 ; Name~Version Suffix (e.g. DBQ TEST EXAMPLE~999T1)
+10 ;
+11 ; An entry will be disabled by doing the following:
+12 ; - Turning off the SELECTABLE BY USER? field. This will keep the
+13 ; entry from showing in the CAPRI GUI template list.
+14 ; - Looking at DE-ACTIVATION DATE field. If there's no date, set
+15 ; it to today.
+16 ;
+17 ;INPUT:
+18 ; DVBNM - Name of CAPRI template entry to be disabled
+19 ; DVBVERSN - Patch Version Suffix (e.g. 999 or 999T1)
+20 ; Format for version suffix are:
+21 ; Released patch will be just Patch Number (e.g 999)
+22 ; Test Patch will be Patch Number with a "T" and Test Patch
+23 ; Version Number (e.g. 999T1)
+24 ;INPUT/OUTPUT:
+25 ; DVBACTR - Passed variable which contains the number of
+26 ; CAPRI templates disabled (Incremented by one for
+27 ; each CAPRI template successfully disabled.
+28 ; DVBAMSG - Array variable passed back to calling API with
+29 ; API result messages
+30 ;
+31 ;Quit if Template name or Version is not passed
+32 if $GET(DVBNM)=""!($GET(DVBVERSN)="")
QUIT
+33 ;
+34 ;ien of CAPRI TEMPLATE DEFINITIONS file
NEW DVBABIEN
+35 ;template NAME field (i.e. DBQ PARKINSONS~999T1)
NEW DVBABST
+36 ;flag used to indicate template was disabled
NEW DVBACH
+37 ;FDA array for FILE^DIE
NEW DVBAFDA
+38 ;status message counter
NEW DVBMCTR
+39 ;
+40 SET DVBABIEN=0
SET DVBMCTR=0
+41 ;
+42 ;walk through CAPRI TEMPLATE DEFINITIONS (#396.18) file entries
+43 FOR
SET DVBABIEN=$ORDER(^DVB(396.18,DVBABIEN))
if 'DVBABIEN
QUIT
Begin DoDot:1
+44 ;template name
SET DVBABST=$PIECE($GET(^DVB(396.18,DVBABIEN,0)),U,1)
+45 ;if name matches and version is different, then disable entry
+46 IF $PIECE(DVBABST,"~",1)=DVBNM
IF $PIECE(DVBABST,"~",2)'=DVBVERSN
Begin DoDot:2
+47 SET DVBACH=0
+48 ;turn SELECTABLE BY USER (#7) field off
+49 IF $PIECE($GET(^DVB(396.18,DVBABIEN,6)),U,1)'="0"
SET DVBAFDA(396.18,DVBABIEN_",",7)="0"
SET DVBACH=1
+50 ;set DE-ACTIVATION DATE (#3) field to TODAY
+51 IF $PIECE($GET(^DVB(396.18,DVBABIEN,2)),U,2)=""
SET DVBAFDA(396.18,DVBABIEN_",",3)=DT
SET DVBACH=1
+52 ;Array where error can be stored for Fileman calls
NEW DVBAERR
+53 ;output list of disabled templates
+54 IF DVBACH=1
Begin DoDot:3
+55 DO FILE^DIE("K","DVBAFDA","DVBAERR")
+56 if $DATA(DVBAERR("DIERR"))'>0
SET DVBACTR=+$GET(DVBACTR)+1
+57 SET DVBMCTR=DVBMCTR+1
+58 SET DVBAMSG(DVBMCTR)=" Disabling: "_DVBABST
+59 ; Include Fileman Error message returned if any
+60 IF $DATA(DVBAERR("DIERR"))>0
Begin DoDot:4
+61 SET DVBMCTR=DVBMCTR+1
+62 SET DVBAMSG(DVBMCTR)=" *** Warning - Unable to disable."
+63 DO ADDERR(.DVBAMSG,.DVBAERR,.DVBMCTR)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+64 QUIT
+65 ;
RENAME(DVBNM,DVBVERSS,DVBVERSN,DVBACTR,DVBAMSG) ; Rename CAPRI templates loaded
+1 ; by the patch
+2 ;
+3 ; This procedure is used to lookup and rename a template in the
+4 ; CAPRI TEMPLATE DEFINITIONS (#396.18) file. This is done to
+5 ; rename the imported version of a template (i.e. DBQ
+6 ; PARKINSONS~999F) to its new name/version (i.e. TEST - DBQ
+7 ; PARKINSONS~999T1 or RELEASED - DBQ PARKINSONS~999).
+8 ;
+9 ;INPUT:
+10 ; DVBNM - Name of CAPRI template entry to be disabled
+11 ; DVBVERSS - Incoming Patch Version Suffix (e.g. 999F)
+12 ; DVBVERSN - Rename Patch Version Suffix (e.g. 999 or 999T1)
+13 ; Format for version suffix are (delimiter is "~"):
+14 ; New entry to be renamed is Patch Number with a "F" (e.g 999F)
+15 ; Released patch will be just Patch Number (e.g 999)
+16 ; Test Patch will be Patch Number with a "T" and Test Patch
+17 ; Version Number (e.g. 999T1)
+18 ;INPUT/OUTPUT:
+19 ; DVBACTR - Passed variable which contains the number of
+20 ; CAPRI templates renamed (Incremented by one for
+21 ; each CAPRI template disabled.
+22 ; DVBAMSG - Array variable passed back to calling API with
+23 ; API result messages
+24 ;
+25 ;Quit if Template Name, or Incoming Patch Version, or New Patch
+26 ;Version is not passed
+27 if $GET(DVBNM)=""!($GET(DVBVERSS)="")!($GET(DVBVERSN)="")
QUIT
+28 ;
+29 ;ien of CAPRI TEMPLATE DEFINITIONS file
NEW DVBABIEN,DVBABIE2
+30 ;incoming template NAME field (e.g. AUDIO~999F)
NEW DVBABST
+31 ;renamed template NAME field (e.g. AUDIO~999T1 or AUDIO~999)
NEW DVBABS2
+32 ;flag to indicate if template version is found or not
NEW DVBACH
+33 ;FDA array for FILE^DIE
NEW DVBAFDA
+34 ;template activation date
NEW DVBAADT
+35 ;status message counter
NEW DVBMCTR
+36 ;
+37 SET DVBABIEN=0
SET DVBMCTR=0
+38 ;
+39 ;main loop-walk through CAPRI TEMPLATE DEFINITIONS file entries
+40 FOR
SET DVBABIEN=$ORDER(^DVB(396.18,DVBABIEN))
if 'DVBABIEN
QUIT
Begin DoDot:1
+41 ;template name
SET DVBABST=$PIECE($GET(^DVB(396.18,DVBABIEN,0)),U,1)
+42 ;look for template versions just loaded by the patch by
+43 ; Checking Version Suffix
+44 IF $PIECE(DVBABST,"~",1)=DVBNM
IF $PIECE(DVBABST,"~",2)=DVBVERSS
Begin DoDot:2
+45 SET DVBABIE2=0
SET DVBACH=0
+46 ; secondary loop-walk through CAPRI TEMPLATE DEFINITIONS file
+47 ; entries
+48 FOR
SET DVBABIE2=$ORDER(^DVB(396.18,DVBABIE2))
if 'DVBABIE2
QUIT
Begin DoDot:3
+49 ;Template Name
+50 SET DVBABS2=$PIECE($GET(^DVB(396.18,DVBABIE2,0)),U,1)
+51 ; if new version of template exists in file, set flag
+52 IF $PIECE(DVBABS2,"~",1)=DVBNM
IF $PIECE(DVBABS2,"~",2)=DVBVERSN
SET DVBACH=1
End DoDot:3
+53 ; if new version already exists, delete the imported version
+54 ; (abort rename)
+55 ;Array where error can be stored for Fileman calls
NEW DVBAERR
+56 IF DVBACH=1
Begin DoDot:3
+57 SET DVBMCTR=DVBMCTR+1
+58 SET DVBAMSG(DVBMCTR)=" Found existing "_DVBNM_DVBVERSN_". No modifications made."
+59 SET DVBAFDA(396.18,DVBABIEN_",",.01)="@"
+60 DO FILE^DIE("","DVBAFDA","DVBAERR")
End DoDot:3
+61 ;
+62 ; Otherwise, if new version isn't found, rename imported
+63 ; template name to the new version name (e.g.
+64 ; DBQ PARKINSONS~999F --> DBQ PARKINSONS~999T1)
+65 IF DVBACH=0
Begin DoDot:3
+66 SET DVBAADT=$PIECE($GET(^DVB(396.18,DVBABIEN,2)),U)
+67 SET DVBAFDA(396.18,DVBABIEN_",",.01)=DVBNM_"~"_DVBVERSN
+68 IF DVBAADT=""!(DVBAADT<DT)
SET DVBAFDA(396.18,DVBABIEN_",",2)=DT
+69 DO FILE^DIE("K","DVBAFDA","DVBAERR")
+70 if $DATA(DVBAERR("DIERR"))'>0
SET DVBACTR=+$GET(DVBACTR)+1
+71 ;Include status message
+72 SET DVBMCTR=DVBMCTR+1
+73 SET DVBAMSG(DVBMCTR)=" Activating: "_$PIECE($GET(^DVB(396.18,DVBABIEN,0)),U,1)
+74 IF $DATA(DVBAERR("DIERR"))>0
Begin DoDot:4
+75 SET DVBMCTR=DVBMCTR+1
+76 SET DVBAMSG(DVBMCTR)=" *** Warning - Unable to activate."
End DoDot:4
End DoDot:3
+77 ;
+78 ; Include Fileman Error message returned if any
+79 IF $DATA(DVBAERR("DIERR"))>0
DO ADDERR(.DVBAMSG,.DVBAERR,.DVBMCTR)
End DoDot:2
End DoDot:1
+80 ;
+81 QUIT
+82 ;
INACTEXM(DVBIEN,DVBEXM,DVBAMSG) ;Inactivate old (current) AMIE Exam
+1 ; (#396.6) Entries
+2 ;
+3 ;INPUT:
+4 ; DVBIEN - Internal Entry Number of AMIE Exam to be inactivated
+5 ; DVBEXM - Exam Name of entry to to be inactivated
+6 ;INPUT/OUTPUT:
+7 ; DVBAMSG - Array variable passed back to calling API with
+8 ; action result message
+9 ;
+10 NEW DVBAFDA,DVBMCTR,DVBAERR
+11 SET DVBMCTR=0
+12 ; Quit if valid IEN and Exam (.01 field) not passed
+13 if $GET(DVBIEN)'>0!($GET(DVBEXM)']"")
QUIT
+14 ;If passed Exam Name different from .01 field, send warning msg
+15 IF $PIECE($GET(^DVB(396.6,+DVBIEN,0)),U,1)'=DVBEXM
Begin DoDot:1
+16 ; Create error message if Exam Name in Entry is different
+17 SET DVBMCTR=DVBMCTR+1
+18 SET DVBAMSG(DVBMCTR)=" *** Warning - Entry #"_DVBIEN_" for exam"
+19 SET DVBMCTR=DVBMCTR+1
+20 SET DVBAMSG(DVBMCTR)=" "_DVBEXM
+21 SET DVBMCTR=DVBMCTR+1
+22 SET DVBAMSG(DVBMCTR)=" could not be inactivated. Check Exam Name!"
End DoDot:1
+23 ;If passed Exam Name is same as .01 fld update Status to Inactive
+24 IF $PIECE($GET(^DVB(396.6,+DVBIEN,0)),U,1)=DVBEXM
Begin DoDot:1
+25 SET DVBAFDA(396.6,+DVBIEN_",",.5)="I"
+26 DO FILE^DIE("K","DVBAFDA","DVBAERR")
+27 ; Create status message if update successful
+28 IF $DATA(DVBAERR("DIERR"))'>0
Begin DoDot:2
+29 SET DVBMCTR=DVBMCTR+1
+30 SET DVBAMSG(DVBMCTR)=" Entry #"_DVBIEN_" for exam "_DVBEXM
+31 SET DVBMCTR=DVBMCTR+1
+32 SET DVBAMSG(DVBMCTR)=" successfully inactivated."
End DoDot:2
+33 ; Create status message if error with update
+34 IF $DATA(DVBAERR("DIERR"))>0
Begin DoDot:2
+35 SET DVBMCTR=DVBMCTR+1
+36 SET DVBAMSG(DVBMCTR)=" *** Warning - Unable to inactivate Entry #"_DVBIEN_" for exam"
+37 SET DVBMCTR=DVBMCTR+1
+38 SET DVBAMSG(DVBMCTR)=" "_DVBEXM_"."
+39 ; Include Fileman Error message returned if any
+40 DO ADDERR(.DVBAMSG,.DVBAERR,.DVBMCTR)
End DoDot:2
End DoDot:1
+41 QUIT
+42 ;
NEWEXAM(DVBIEN,DVBEXM,DVBPNM,DVBBDY,DVBROU,DVBSTAT,DVBWKS,DVBAMSG) ;
+1 ; Add new exam entries to AMIE EXAM (#396.6) File
+2 ;INPUT:
+3 ; DVBIEN - Internal Entry Number of AMIE Exam entry to be added
+4 ; DVBEXM - Name of AMIE Exam entry to be added
+5 ; DVBPNM - Print Name of AMIE Exam entry to be added
+6 ; DVBBDY - Body System of AMIE Exam entry to be added
+7 ; DVBROU - Reporting Program Name of AMIE Exam entry to be added
+8 ; DVBSTAT - Status of AMIE Exam entry to be added
+9 ; DVBWKS - AMIE Worksheet # of AMIE Exam entry to be added
+10 ;INPUT/OUTPUT:
+11 ; DVBAMSG - Array variable passed back to calling API with
+12 ; API result messages
+13 ;
+14 NEW DVBAFDA,DVBAIEN,DVBMCTR,DVBAERR
+15 SET DVBMCTR=0
+16 ;
+17 ; Quit if valid IEN and Exam (.01 field) not passed
+18 if $GET(DVBIEN)'>0!($GET(DVBEXM)']"")
QUIT
+19 ; Update existing entry
+20 IF $DATA(^DVB(396.6,DVBIEN,0))>0
Begin DoDot:1
+21 SET DVBMCTR=DVBMCTR+1
+22 SET DVBAMSG(DVBMCTR)=" You have an Entry #"_DVBIEN_"."
+23 SET DVBMCTR=DVBMCTR+1
+24 SET DVBAMSG(DVBMCTR)=" Updating "_DVBEXM_"."
+25 SET DVBAFDA(396.6,+DVBIEN_",",.01)=$GET(DVBEXM)
+26 SET DVBAFDA(396.6,+DVBIEN_",",.07)=$GET(DVBWKS)
+27 SET DVBAFDA(396.6,+DVBIEN_",",.5)=$GET(DVBSTAT)
+28 SET DVBAFDA(396.6,+DVBIEN_",",2)=$GET(DVBBDY)
+29 SET DVBAFDA(396.6,+DVBIEN_",",6)=$GET(DVBPNM)
+30 SET DVBAFDA(396.6,+DVBIEN_",",7)=$GET(DVBROU)
+31 DO FILE^DIE("K","DVBAFDA","DVBAERR")
+32 IF $DATA(DVBAERR("DIERR"))'>0
Begin DoDot:2
+33 SET DVBMCTR=DVBMCTR+1
+34 SET DVBAMSG(DVBMCTR)=" Successfully updated Entry #"_DVBIEN_" for exam"
+35 SET DVBMCTR=DVBMCTR+1
+36 SET DVBAMSG(DVBMCTR)=" "_DVBEXM_"."
End DoDot:2
+37 IF $DATA(DVBAERR("DIERR"))>0
Begin DoDot:2
+38 SET DVBMCTR=DVBMCTR+1
+39 SET DVBAMSG(DVBMCTR)=" *** Warning - Unable to update Entry."
End DoDot:2
End DoDot:1
+40 ;
+41 ; Add new entry
+42 IF $DATA(^DVB(396.6,DVBIEN,0))'>0
Begin DoDot:1
+43 SET DVBAIEN(1)=DVBIEN
+44 SET DVBAFDA(396.6,"+1,",.01)=$GET(DVBEXM)
+45 SET DVBAFDA(396.6,"+1,",.07)=$GET(DVBWKS)
+46 SET DVBAFDA(396.6,"+1,",.5)=$GET(DVBSTAT)
+47 SET DVBAFDA(396.6,"+1,",2)=$GET(DVBBDY)
+48 SET DVBAFDA(396.6,"+1,",6)=$GET(DVBPNM)
+49 SET DVBAFDA(396.6,"+1,",7)=$GET(DVBROU)
+50 DO UPDATE^DIE("","DVBAFDA","DVBAIEN","DVBAERR")
+51 IF $DATA(DVBAERR("DIERR"))'>0
Begin DoDot:2
+52 SET DVBMCTR=DVBMCTR+1
+53 SET DVBAMSG(DVBMCTR)=" Successfully added Entry #"_DVBIEN_" for exam"
+54 SET DVBMCTR=DVBMCTR+1
+55 SET DVBAMSG(DVBMCTR)=" "_DVBEXM_"."
End DoDot:2
+56 IF $DATA(DVBAERR("DIERR"))>0
Begin DoDot:2
+57 SET DVBMCTR=DVBMCTR+1
+58 SET DVBAMSG(DVBMCTR)=" *** Warning - Unable to add Entry #"_DVBIEN
+59 SET DVBMCTR=DVBMCTR+1
+60 SET DVBAMSG(DVBMCTR)=" for exam "_DVBEXM_"."
End DoDot:2
End DoDot:1
+61 ;
+62 ;Include FILE^DIE or UPDATE^DIE error message in DVBAMSG array
+63 IF $DATA(DVBAERR("DIERR"))>0
DO ADDERR(.DVBAMSG,.DVBAERR,.DVBMCTR)
+64 QUIT
+65 ;
ADDERR(DVBMSG,DVBERR,DVBCTR) ;Include passed FM error message into DVBMSG
+1 ;array
+2 ;INPUT:
+3 ; DVBERR - Passed error Array from Fileman call
+4 ;INPUT/OUTPUT:
+5 ; DVBMSG - Passed array with status messages. Passed FM Error will
+6 ; be added to array and returned to calling API
+7 ; DVBCTR - Passed Counter Variable to used for DVBMSG array. Updated
+8 ; Counter will be returned to call API.
+9 ;Quit if DVBERR isn't defined
+10 if $DATA(DVBERR)'>0
QUIT
+11 NEW DVBMSG1,CTR
+12 DO MSG^DIALOG("AE",.DVBMSG1,"","","DVBERR")
+13 SET CTR=0
+14 FOR
SET CTR=$ORDER(DVBMSG1(CTR))
if CTR'>0
QUIT
Begin DoDot:1
+15 SET DVBCTR=$GET(DVBCTR)+1
+16 SET DVBMSG(DVBCTR)=" "_DVBMSG1(CTR)
End DoDot:1
+17 QUIT
