- 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 Jan 18, 2025@02:40:40 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