DVBA189P ;ALB/GAK - PATCH DVBA*2.7*189 POST-INSTALL ROUTINE;08/08/2014
;;2.7;AMIE;**189**;Apr 10, 1995;Build 22
; This routine adds an entry to the REMOTE APPLICATION file (#8994.5) for VLER DAS-CAPRI
; ALB/RTW -This routine adds new and hides old 2507 Cancelation Reasons in global (#396.5) for VLER DAS-CAPRI
Q
;
ENTER ;
D INRSN
D SPCON
D CLMTYP
D CANRSN
Q
;
;
INRSN ;SETUP THE INSUFFICIENT REASON FILE #396.94
;HIDE REQUESTED INSUFFICIENT REASONS
N DVBAI,DVBLINE,FIND,OUT,IRIEN,RSN,CODE,REPORT
F DVBAI=1:1 S DVBLINE=$P($T(IRHIDE+DVBAI),";;",2) Q:DVBLINE="QUIT" D
. K FIND,OUT
. S FIND=DVBLINE
. D FIND^DIC(396.94,"",.01,"X",.FIND,"","","","","OUT")
. S IRIEN=$G(OUT("DILIST",2,1))
. I IRIEN="" D BMES^XPDUTL("INSUFFICIENT REASON NOT ON FILE TO HIDE: "_DVBLINE) Q
. I '$D(^DVB(396.94,IRIEN)) D BMES^XPDUTL("INSUFFICIENT REASON NOT ON FILE TO HIDE: "_DVBLINE) Q
. ;
. Q:$P(^DVB(396.94,IRIEN,0),"^",4)'=""
. ;
. K FDA,ERR,KEYIEN
. S FDA(396.94,IRIEN_",",1)="Y"
. S KEYIEN(1)=IRIEN
. D UPDATE^DIE("","FDA","KEYIEN","ERR")
. I $G(ERR)'="" D BMES^XPDUTL("INSUFFICIENT REASON: "_DVBLINE_" COULD NOT BE DEACTIVATED BY POST-INSTALL ROUTINE. PLEASE SET INACTIVE FIELD TO YES.") Q
. D BMES^XPDUTL("INSUFFICIENT REASON: "_DVBLINE_" HAS BEEN DEACTIVATED.") Q
;
;NEW REQUESTED INSUFFICIENT REASONS
N DVBAI,DVBLINE,FIND,OUT
F DVBAI=1:1 S DVBLINE=$P($T(IRNEW+DVBAI),";;",2) Q:DVBLINE="QUIT" D
. K FIND,OUT
. S FIND=$TR($P(DVBLINE,"^",1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
. D FIND^DIC(396.94,"",.01,"X",.FIND,"","","","","OUT")
. I $G(OUT("DILIST",2,1))'="" D BMES^XPDUTL("INSUFFICIENT REASON: "_FIND_" HAS ALREADY BEEN ADDED.") D Q
. . S DVBABIEN=OUT("DILIST","2",1)
. . S DVBAFDA(396.94,DVBABIEN_",",1)="N"
. . D FILE^DIE("","DVBAFDA","DVBAERR")
. K RSN,CODE,REPORT
. S RSN=$TR($P(DVBLINE,"^",1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
. S CODE=$P(DVBLINE,"^",2)
. S REPORT=$P(DVBLINE,"^",3)
. K FDA,ERR
. S FDA(396.94,"+1,",.01)=RSN
. S FDA(396.94,"+1,",.02)=CODE
. S FDA(396.94,"+1,",.03)=REPORT
. S FDA(396.94,"+1,",1)="N"
. D UPDATE^DIE("","FDA","","ERR")
. I $G(ERR)'="" D BMES^XPDUTL("INSUFFICIENT REASON: "_RSN_" COULD NOT BE ADDED BY POST-INSTALL ROUTINE.") Q
. D BMES^XPDUTL("INSUFFICIENT REASON: "_RSN_" HAS BEEN ADDED.") Q
;
Q
;
IRHIDE ;INACTIVATE THE FOLLOWING REASONS
;;DIAGNOSIS INCONSISTENT WITH EVIDENCE
;;EXAM PREVIOUSLY RETURNED AS INSUFFICIENT, RETURN AGAIN INSUFFICIENT
;;EYE EXAM IS INSUFFICIENT
;;FAILED TO PERFORM REQUESTED SPECIALIST EXAM
;;FAILED TO PROVIDE ADDITIONAL EXAM RECOMMENDED BY EXAMINING PHYSICIAN
;;FAILED TO PROVIDE RANGE OF MOTION
;;FAILED TO PROVIDE REQUESTED MEDICAL OPINION
;;FAILED TO PROVIDE TEST ROUTINELY DONE FOR SPECIFIC CONDITION
;;FAILED TO REVIEW TEST RESULTS BEFORE MAKING DIAGNOSIS
;;OTHER
;;QUIT
Q
;
IRNEW ;ADD THE FOLLOWING NEW REASONS
;;Failed to provide requested/required information^FRI^Failed to provide requested/required information
;;Failed to provide medical opinion^FMO^Failed to provide medical opinion
;;Failed to comply with BVA Remand Instructions^FBVA^Failed to comply with BVA Remand Instructions
;;Failed to provide diagnosis^FPD^Failed to provide diagnosis
;;Failed to provide rationale^FPR^Failed to provide rationale
;;Conflicting information in report^CIR^Conflicting information in report
;;Failed to address all conditions requested^FAC^Failed to address all conditions requested
;;In-person examination was not performed^IPN^In-person examination was not performed
;;Case required exam by a specialist^CRS^Case required exam by a specialist
;;QUIT
Q
;
;
SPCON ;SETUP THE 2507 SPECIAL CONSIDERATIONS FILE #396.25
;NEW REQUESTED SPECIAL CONSIDERATIONS
N DVBAI,DVBLINE,DVBLINE,FIND,OUT
F DVBAI=1:1 S DVBLINE=$P($T(SCNEW+DVBAI),";;",2) Q:DVBLINE="QUIT" D
. K FIND,OUT
. S FIND=$TR(DVBLINE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
. D FIND^DIC(396.25,"",.01,"X",.FIND,"","","","","OUT")
. I $G(OUT("DILIST",2,1))'="" D BMES^XPDUTL("SPECIAL CONSIDERATION: "_FIND_" HAS ALREADY BEEN ADDED.") Q
. K FDA,ERR
. S DVBLINE=$TR(DVBLINE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
. S FDA(396.25,"+1,",.01)=DVBLINE
. D UPDATE^DIE("","FDA","","ERR")
. I $G(ERR)'="" D BMES^XPDUTL("SPECIAL CONSIDERATION: "_DVBLINE_" COULD NOT BE ADDED BY POST-INSTALL ROUTINE.") Q
. D BMES^XPDUTL("SPECIAL CONSIDERATION: "_DVBLINE_" HAS BEEN ADDED.") Q
;
Q
;
SCNEW ;ADD THE FOLLOWING NEW SPECIAL CONSIDERATIONS
;;AGE OF CLAIM
;;FDC
;;HOMELESS
;;NOT APPLICABLE
;;POW
;;TERMINAL
;;QUIT
Q
;
;
CLMTYP ;SETUP THE 2507 CLAIM TYPE FILE #396.27
;NEW REQUESTED CLAIM TYPES
N DVBAI,DVBLINE,DVBLINE,FIND,OUT
F DVBAI=1:1 S DVBLINE=$P($T(CTNEW+DVBAI),";;",2) Q:DVBLINE="QUIT" D
. K FIND,OUT
. S FIND=$TR(DVBLINE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
. D FIND^DIC(396.27,"",.01,"X",.FIND,"","","","","OUT")
. I $G(OUT("DILIST",2,1))'="" D BMES^XPDUTL("CLAIM TYPE: "_FIND_" HAS ALREADY BEEN ADDED.") Q
. K FDA,ERR
. S DVBLINE=$TR(DVBLINE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
. S FDA(396.27,"+1,",.01)=DVBLINE
. D UPDATE^DIE("","FDA","","ERR")
. I $G(ERR)'="" D BMES^XPDUTL("CLAIM TYPE: "_DVBLINE_" COULD NOT BE ADDED BY POST-INSTALL ROUTINE.") Q
. D BMES^XPDUTL("CLAIM TYPE: "_DVBLINE_" HAS BEEN ADDED.") Q
;
Q
;
CTNEW ;ADD THE FOLLOWING NEW CLAIM TYPES
;;BDD
;;BDD - DOD SHA
;;IDES
;;INCREASE ONLY
;;ORIGINAL
;;QUICK START
;;SUPPLEMENTAL
;;QUIT
Q
;
CANRSN ;SETUP THE CANCELLATION REASON FILE #396.5
;HIDE REQUESTED CANCELLATION REASONS
N DVBAI,DVBLINE,FIND,OUT,IRIEN,RSN,CODE,REPORT
F DVBAI=1:1 S DVBLINE=$P($T(CANHIDE+DVBAI),";;",2) Q:DVBLINE="QUIT" D
. K FIND,OUT
. S FIND=DVBLINE
. D FIND^DIC(396.5,"",.01,"X",.FIND,"","","","","OUT")
. S IRIEN=$G(OUT("DILIST",2,1))
. I IRIEN="" D BMES^XPDUTL("CANCELLATION REASON NOT ON FILE TO HIDE: "_DVBLINE) Q
. I '$D(^DVB(396.5,IRIEN)) D BMES^XPDUTL("CANCELLATION REASON NOT ON FILE TO HIDE: "_DVBLINE) Q
. ;
. Q:$P(^DVB(396.5,IRIEN,0),"^",4)'=""
. ;
. K FDA,ERR,KEYIEN
. S FDA(396.5,IRIEN_",",.02)=0
. S KEYIEN(1)=IRIEN
. D UPDATE^DIE("","FDA","KEYIEN","ERR")
. I $G(ERR)'="" D BMES^XPDUTL("CANCELLATION REASON: "_DVBLINE_" COULD NOT BE DEACTIVATED BY POST-INSTALL ROUTINE. PLEASE SET INACTIVE FIELD TO YES.") Q
. D BMES^XPDUTL("CANCELLATION REASON: "_DVBLINE_" HAS BEEN DEACTIVATED.") Q
;
CANNEW ;NEW REQUESTED CANCELLATION REASONS
N DVBAI,DVBLINE,FIND,OUT
F DVBAI=1:1 S DVBLINE=$P($T(CANRNEW+DVBAI),";;",2) Q:DVBLINE="QUIT" D
. K FIND,OUT
. S FIND=$P(DVBLINE,"^",1)
. D FIND^DIC(396.5,"",.01,"X",.FIND,"","","","","OUT")
. I $G(OUT("DILIST",2,1))'="" D BMES^XPDUTL("CANCELLATION REASON: "_FIND_" HAS ALREADY BEEN ADDED.") D Q
. . S DVBABIEN=OUT("DILIST","2",1)
. . S DVBAFDA(396.5,DVBABIEN_",",.02)="1"
. . D FILE^DIE("","DVBAFDA","DVBAERR")
. K CRSN,CODE,REPORT
. S CRSN=$P(DVBLINE,"^",1)
. K FDA,ERR
. S FDA(396.5,"+1,",.01)=CRSN
. S FDA(396.5,"+1,",.02)="1"
. D UPDATE^DIE("","FDA","","ERR")
. I $G(ERR)'="" D BMES^XPDUTL("CANCELLATION REASON: "_CRSN_" COULD NOT BE ADDED BY POST-INSTALL ROUTINE.") Q
. D BMES^XPDUTL("CANCELLATION REASON: "_CRSN_" HAS BEEN ADDED.") Q
;
Q
;
CANHIDE ;INACTIVATE THE FOLLOWING CANCELLATION REASONS
;;ADEQUATE MEDICAL EVIDENCE
;;DUPLICATE EXAM
;;EMPLOYEE
;;EXAM NAME DELETED FROM FILE
;;FAILED TO REPORT
;;INCORRECT JURISDICTION
;;INCORRECT TEST ORDERED
;;NO EXAMS ORDERED
;;NOT ENOUGH INFORMATION
;;UNDELIVERED NOTIFICATION
;;VET REFUSED EXAM THIS LOCATION
;;VETERAN CANCELLED EXAM FOR DBQ
;;VETERAN WITHDREW CLAIM
;;QUIT
Q
;
CANRNEW ;ADD THE FOLLOWING NEW CANCELLATION REASONS
;;DUPLICATE REQUEST
;;EXAM REQUESTED AT DIFFERENT LOCATION
;;EXAM REQUESTED IN ERROR
;;INCOMPLETE REQUEST
;;UNABLE TO CONTACT VETERAN
;;VETERAN DIED
;;VETERAN FAILED TO REPORT
;;VETERAN FAILED TO RSVP
;;VETERAN HOSPITALIZED
;;VETERAN IS EMPLOYEE
;;VETERAN REFUSED EXAM
;;QUIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBA189P 8203 printed Apr 09, 2024@20:49:16 Page 2
DVBA189P ;ALB/GAK - PATCH DVBA*2.7*189 POST-INSTALL ROUTINE;08/08/2014
+1 ;;2.7;AMIE;**189**;Apr 10, 1995;Build 22
+2 ; This routine adds an entry to the REMOTE APPLICATION file (#8994.5) for VLER DAS-CAPRI
+3 ; ALB/RTW -This routine adds new and hides old 2507 Cancelation Reasons in global (#396.5) for VLER DAS-CAPRI
+4 QUIT
+5 ;
ENTER ;
+1 DO INRSN
+2 DO SPCON
+3 DO CLMTYP
+4 DO CANRSN
+5 QUIT
+6 ;
+7 ;
INRSN ;SETUP THE INSUFFICIENT REASON FILE #396.94
+1 ;HIDE REQUESTED INSUFFICIENT REASONS
+2 NEW DVBAI,DVBLINE,FIND,OUT,IRIEN,RSN,CODE,REPORT
+3 FOR DVBAI=1:1
SET DVBLINE=$PIECE($TEXT(IRHIDE+DVBAI),";;",2)
if DVBLINE="QUIT"
QUIT
Begin DoDot:1
+4 KILL FIND,OUT
+5 SET FIND=DVBLINE
+6 DO FIND^DIC(396.94,"",.01,"X",.FIND,"","","","","OUT")
+7 SET IRIEN=$GET(OUT("DILIST",2,1))
+8 IF IRIEN=""
DO BMES^XPDUTL("INSUFFICIENT REASON NOT ON FILE TO HIDE: "_DVBLINE)
QUIT
+9 IF '$DATA(^DVB(396.94,IRIEN))
DO BMES^XPDUTL("INSUFFICIENT REASON NOT ON FILE TO HIDE: "_DVBLINE)
QUIT
+10 ;
+11 if $PIECE(^DVB(396.94,IRIEN,0),"^",4)'=""
QUIT
+12 ;
+13 KILL FDA,ERR,KEYIEN
+14 SET FDA(396.94,IRIEN_",",1)="Y"
+15 SET KEYIEN(1)=IRIEN
+16 DO UPDATE^DIE("","FDA","KEYIEN","ERR")
+17 IF $GET(ERR)'=""
DO BMES^XPDUTL("INSUFFICIENT REASON: "_DVBLINE_" COULD NOT BE DEACTIVATED BY POST-INSTALL ROUTINE. PLEASE SET INACTIVE FIELD TO YES.")
QUIT
+18 DO BMES^XPDUTL("INSUFFICIENT REASON: "_DVBLINE_" HAS BEEN DEACTIVATED.")
QUIT
End DoDot:1
+19 ;
+20 ;NEW REQUESTED INSUFFICIENT REASONS
+21 NEW DVBAI,DVBLINE,FIND,OUT
+22 FOR DVBAI=1:1
SET DVBLINE=$PIECE($TEXT(IRNEW+DVBAI),";;",2)
if DVBLINE="QUIT"
QUIT
Begin DoDot:1
+23 KILL FIND,OUT
+24 SET FIND=$TRANSLATE($PIECE(DVBLINE,"^",1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+25 DO FIND^DIC(396.94,"",.01,"X",.FIND,"","","","","OUT")
+26 IF $GET(OUT("DILIST",2,1))'=""
DO BMES^XPDUTL("INSUFFICIENT REASON: "_FIND_" HAS ALREADY BEEN ADDED.")
Begin DoDot:2
+27 SET DVBABIEN=OUT("DILIST","2",1)
+28 SET DVBAFDA(396.94,DVBABIEN_",",1)="N"
+29 DO FILE^DIE("","DVBAFDA","DVBAERR")
End DoDot:2
QUIT
+30 KILL RSN,CODE,REPORT
+31 SET RSN=$TRANSLATE($PIECE(DVBLINE,"^",1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+32 SET CODE=$PIECE(DVBLINE,"^",2)
+33 SET REPORT=$PIECE(DVBLINE,"^",3)
+34 KILL FDA,ERR
+35 SET FDA(396.94,"+1,",.01)=RSN
+36 SET FDA(396.94,"+1,",.02)=CODE
+37 SET FDA(396.94,"+1,",.03)=REPORT
+38 SET FDA(396.94,"+1,",1)="N"
+39 DO UPDATE^DIE("","FDA","","ERR")
+40 IF $GET(ERR)'=""
DO BMES^XPDUTL("INSUFFICIENT REASON: "_RSN_" COULD NOT BE ADDED BY POST-INSTALL ROUTINE.")
QUIT
+41 DO BMES^XPDUTL("INSUFFICIENT REASON: "_RSN_" HAS BEEN ADDED.")
QUIT
End DoDot:1
+42 ;
+43 QUIT
+44 ;
IRHIDE ;INACTIVATE THE FOLLOWING REASONS
+1 ;;DIAGNOSIS INCONSISTENT WITH EVIDENCE
+2 ;;EXAM PREVIOUSLY RETURNED AS INSUFFICIENT, RETURN AGAIN INSUFFICIENT
+3 ;;EYE EXAM IS INSUFFICIENT
+4 ;;FAILED TO PERFORM REQUESTED SPECIALIST EXAM
+5 ;;FAILED TO PROVIDE ADDITIONAL EXAM RECOMMENDED BY EXAMINING PHYSICIAN
+6 ;;FAILED TO PROVIDE RANGE OF MOTION
+7 ;;FAILED TO PROVIDE REQUESTED MEDICAL OPINION
+8 ;;FAILED TO PROVIDE TEST ROUTINELY DONE FOR SPECIFIC CONDITION
+9 ;;FAILED TO REVIEW TEST RESULTS BEFORE MAKING DIAGNOSIS
+10 ;;OTHER
+11 ;;QUIT
+12 QUIT
+13 ;
IRNEW ;ADD THE FOLLOWING NEW REASONS
+1 ;;Failed to provide requested/required information^FRI^Failed to provide requested/required information
+2 ;;Failed to provide medical opinion^FMO^Failed to provide medical opinion
+3 ;;Failed to comply with BVA Remand Instructions^FBVA^Failed to comply with BVA Remand Instructions
+4 ;;Failed to provide diagnosis^FPD^Failed to provide diagnosis
+5 ;;Failed to provide rationale^FPR^Failed to provide rationale
+6 ;;Conflicting information in report^CIR^Conflicting information in report
+7 ;;Failed to address all conditions requested^FAC^Failed to address all conditions requested
+8 ;;In-person examination was not performed^IPN^In-person examination was not performed
+9 ;;Case required exam by a specialist^CRS^Case required exam by a specialist
+10 ;;QUIT
+11 QUIT
+12 ;
+13 ;
SPCON ;SETUP THE 2507 SPECIAL CONSIDERATIONS FILE #396.25
+1 ;NEW REQUESTED SPECIAL CONSIDERATIONS
+2 NEW DVBAI,DVBLINE,DVBLINE,FIND,OUT
+3 FOR DVBAI=1:1
SET DVBLINE=$PIECE($TEXT(SCNEW+DVBAI),";;",2)
if DVBLINE="QUIT"
QUIT
Begin DoDot:1
+4 KILL FIND,OUT
+5 SET FIND=$TRANSLATE(DVBLINE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+6 DO FIND^DIC(396.25,"",.01,"X",.FIND,"","","","","OUT")
+7 IF $GET(OUT("DILIST",2,1))'=""
DO BMES^XPDUTL("SPECIAL CONSIDERATION: "_FIND_" HAS ALREADY BEEN ADDED.")
QUIT
+8 KILL FDA,ERR
+9 SET DVBLINE=$TRANSLATE(DVBLINE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+10 SET FDA(396.25,"+1,",.01)=DVBLINE
+11 DO UPDATE^DIE("","FDA","","ERR")
+12 IF $GET(ERR)'=""
DO BMES^XPDUTL("SPECIAL CONSIDERATION: "_DVBLINE_" COULD NOT BE ADDED BY POST-INSTALL ROUTINE.")
QUIT
+13 DO BMES^XPDUTL("SPECIAL CONSIDERATION: "_DVBLINE_" HAS BEEN ADDED.")
QUIT
End DoDot:1
+14 ;
+15 QUIT
+16 ;
SCNEW ;ADD THE FOLLOWING NEW SPECIAL CONSIDERATIONS
+1 ;;AGE OF CLAIM
+2 ;;FDC
+3 ;;HOMELESS
+4 ;;NOT APPLICABLE
+5 ;;POW
+6 ;;TERMINAL
+7 ;;QUIT
+8 QUIT
+9 ;
+10 ;
CLMTYP ;SETUP THE 2507 CLAIM TYPE FILE #396.27
+1 ;NEW REQUESTED CLAIM TYPES
+2 NEW DVBAI,DVBLINE,DVBLINE,FIND,OUT
+3 FOR DVBAI=1:1
SET DVBLINE=$PIECE($TEXT(CTNEW+DVBAI),";;",2)
if DVBLINE="QUIT"
QUIT
Begin DoDot:1
+4 KILL FIND,OUT
+5 SET FIND=$TRANSLATE(DVBLINE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+6 DO FIND^DIC(396.27,"",.01,"X",.FIND,"","","","","OUT")
+7 IF $GET(OUT("DILIST",2,1))'=""
DO BMES^XPDUTL("CLAIM TYPE: "_FIND_" HAS ALREADY BEEN ADDED.")
QUIT
+8 KILL FDA,ERR
+9 SET DVBLINE=$TRANSLATE(DVBLINE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+10 SET FDA(396.27,"+1,",.01)=DVBLINE
+11 DO UPDATE^DIE("","FDA","","ERR")
+12 IF $GET(ERR)'=""
DO BMES^XPDUTL("CLAIM TYPE: "_DVBLINE_" COULD NOT BE ADDED BY POST-INSTALL ROUTINE.")
QUIT
+13 DO BMES^XPDUTL("CLAIM TYPE: "_DVBLINE_" HAS BEEN ADDED.")
QUIT
End DoDot:1
+14 ;
+15 QUIT
+16 ;
CTNEW ;ADD THE FOLLOWING NEW CLAIM TYPES
+1 ;;BDD
+2 ;;BDD - DOD SHA
+3 ;;IDES
+4 ;;INCREASE ONLY
+5 ;;ORIGINAL
+6 ;;QUICK START
+7 ;;SUPPLEMENTAL
+8 ;;QUIT
+9 QUIT
+10 ;
CANRSN ;SETUP THE CANCELLATION REASON FILE #396.5
+1 ;HIDE REQUESTED CANCELLATION REASONS
+2 NEW DVBAI,DVBLINE,FIND,OUT,IRIEN,RSN,CODE,REPORT
+3 FOR DVBAI=1:1
SET DVBLINE=$PIECE($TEXT(CANHIDE+DVBAI),";;",2)
if DVBLINE="QUIT"
QUIT
Begin DoDot:1
+4 KILL FIND,OUT
+5 SET FIND=DVBLINE
+6 DO FIND^DIC(396.5,"",.01,"X",.FIND,"","","","","OUT")
+7 SET IRIEN=$GET(OUT("DILIST",2,1))
+8 IF IRIEN=""
DO BMES^XPDUTL("CANCELLATION REASON NOT ON FILE TO HIDE: "_DVBLINE)
QUIT
+9 IF '$DATA(^DVB(396.5,IRIEN))
DO BMES^XPDUTL("CANCELLATION REASON NOT ON FILE TO HIDE: "_DVBLINE)
QUIT
+10 ;
+11 if $PIECE(^DVB(396.5,IRIEN,0),"^",4)'=""
QUIT
+12 ;
+13 KILL FDA,ERR,KEYIEN
+14 SET FDA(396.5,IRIEN_",",.02)=0
+15 SET KEYIEN(1)=IRIEN
+16 DO UPDATE^DIE("","FDA","KEYIEN","ERR")
+17 IF $GET(ERR)'=""
DO BMES^XPDUTL("CANCELLATION REASON: "_DVBLINE_" COULD NOT BE DEACTIVATED BY POST-INSTALL ROUTINE. PLEASE SET INACTIVE FIELD TO YES.")
QUIT
+18 DO BMES^XPDUTL("CANCELLATION REASON: "_DVBLINE_" HAS BEEN DEACTIVATED.")
QUIT
End DoDot:1
+19 ;
CANNEW ;NEW REQUESTED CANCELLATION REASONS
+1 NEW DVBAI,DVBLINE,FIND,OUT
+2 FOR DVBAI=1:1
SET DVBLINE=$PIECE($TEXT(CANRNEW+DVBAI),";;",2)
if DVBLINE="QUIT"
QUIT
Begin DoDot:1
+3 KILL FIND,OUT
+4 SET FIND=$PIECE(DVBLINE,"^",1)
+5 DO FIND^DIC(396.5,"",.01,"X",.FIND,"","","","","OUT")
+6 IF $GET(OUT("DILIST",2,1))'=""
DO BMES^XPDUTL("CANCELLATION REASON: "_FIND_" HAS ALREADY BEEN ADDED.")
Begin DoDot:2
+7 SET DVBABIEN=OUT("DILIST","2",1)
+8 SET DVBAFDA(396.5,DVBABIEN_",",.02)="1"
+9 DO FILE^DIE("","DVBAFDA","DVBAERR")
End DoDot:2
QUIT
+10 KILL CRSN,CODE,REPORT
+11 SET CRSN=$PIECE(DVBLINE,"^",1)
+12 KILL FDA,ERR
+13 SET FDA(396.5,"+1,",.01)=CRSN
+14 SET FDA(396.5,"+1,",.02)="1"
+15 DO UPDATE^DIE("","FDA","","ERR")
+16 IF $GET(ERR)'=""
DO BMES^XPDUTL("CANCELLATION REASON: "_CRSN_" COULD NOT BE ADDED BY POST-INSTALL ROUTINE.")
QUIT
+17 DO BMES^XPDUTL("CANCELLATION REASON: "_CRSN_" HAS BEEN ADDED.")
QUIT
End DoDot:1
+18 ;
+19 QUIT
+20 ;
CANHIDE ;INACTIVATE THE FOLLOWING CANCELLATION REASONS
+1 ;;ADEQUATE MEDICAL EVIDENCE
+2 ;;DUPLICATE EXAM
+3 ;;EMPLOYEE
+4 ;;EXAM NAME DELETED FROM FILE
+5 ;;FAILED TO REPORT
+6 ;;INCORRECT JURISDICTION
+7 ;;INCORRECT TEST ORDERED
+8 ;;NO EXAMS ORDERED
+9 ;;NOT ENOUGH INFORMATION
+10 ;;UNDELIVERED NOTIFICATION
+11 ;;VET REFUSED EXAM THIS LOCATION
+12 ;;VETERAN CANCELLED EXAM FOR DBQ
+13 ;;VETERAN WITHDREW CLAIM
+14 ;;QUIT
+15 QUIT
+16 ;
CANRNEW ;ADD THE FOLLOWING NEW CANCELLATION REASONS
+1 ;;DUPLICATE REQUEST
+2 ;;EXAM REQUESTED AT DIFFERENT LOCATION
+3 ;;EXAM REQUESTED IN ERROR
+4 ;;INCOMPLETE REQUEST
+5 ;;UNABLE TO CONTACT VETERAN
+6 ;;VETERAN DIED
+7 ;;VETERAN FAILED TO REPORT
+8 ;;VETERAN FAILED TO RSVP
+9 ;;VETERAN HOSPITALIZED
+10 ;;VETERAN IS EMPLOYEE
+11 ;;VETERAN REFUSED EXAM
+12 ;;QUIT
+13 QUIT
