DGBT1P28 ;ALB/DBE - BENEFICIARY TRAVEL PATCH 28 POST-INIT ;6/5/15 11:47am
;;1.0;Beneficiary Travel;**28**;September 25, 2001;Build 12
;
;this routine is a post-init to update the zip code
;fields in the Beneficiary Travel Claim (#392) file
;and the 30 Day Application Requirement template in
;the Beneficiary Travel Denial Reasons (392.8) file
;
EN ;entry point
;
D BMES^XPDUTL("Post-init starting...")
D UPDZIP
D DGBTDLT
D BMES^XPDUTL("...Post-init complete")
;
Q
;
UPDZIP ;remove hyphen from internal zip code entry
;
N DGBTDT
D BMES^XPDUTL(" Updating zip codes...")
S DGBTDT=0 F S DGBTDT=$O(^DGBT(392,DGBTDT)) Q:'DGBTDT D
.I $D(^DGBT(392,DGBTDT,"D")) D
..I $P(^DGBT(392,DGBTDT,"D"),U,6)["-" D
...S $P(^DGBT(392,DGBTDT,"D"),U,6)=$TR($P(^DGBT(392,DGBTDT,"D"),U,6),"-","")
.I $D(^DGBT(392,DGBTDT,"T")) D
..I $P(^DGBT(392,DGBTDT,"T"),U,6)["-" D
...S $P(^DGBT(392,DGBTDT,"T"),U,6)=$TR($P(^DGBT(392,DGBTDT,"T"),U,6),"-","")
D BMES^XPDUTL(" ...zip code update complete")
Q
;
DGBTDLT ;update the 30 Day Application Requirement denial letter template
;
N DGBTIEN,DGBTARAY,DGBTLP
D BMES^XPDUTL(" Updating denial letter...")
S DGBTIEN=$O(^DGBT(392.8,"B","30 DAY APPLICATION REQUIREMENT",""))
I 'DGBTIEN D BMES^XPDUTL("***Error encountered: 30 DAY APPLICATION REQUIREMENT letter not found***") Q
F DGBTLP=1:1:5 S DGBTARAY(DGBTLP)=$P($T(TEXT+DGBTLP),";;",2)
D WP^DIE(392.8,DGBTIEN_",",1,"K","DGBTARAY","DGBTERR")
I $D(DGBTERR) D BMES^XPDUTL("***Error encountered while attempting to update the denial letter***")
E D BMES^XPDUTL(" ...denial letter update complete")
Q
;
TEXT ;new text for 30 Day Application Requirement template
;;
;; Your request for payment consideration was received greater than 30
;; calendar days from the date you completed travel associated with your
;; appointment or the date you became administratively eligible for
;; payment of Beneficiary Travel benefits.
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBT1P28 1989 printed Dec 13, 2024@01:40:15 Page 2
DGBT1P28 ;ALB/DBE - BENEFICIARY TRAVEL PATCH 28 POST-INIT ;6/5/15 11:47am
+1 ;;1.0;Beneficiary Travel;**28**;September 25, 2001;Build 12
+2 ;
+3 ;this routine is a post-init to update the zip code
+4 ;fields in the Beneficiary Travel Claim (#392) file
+5 ;and the 30 Day Application Requirement template in
+6 ;the Beneficiary Travel Denial Reasons (392.8) file
+7 ;
EN ;entry point
+1 ;
+2 DO BMES^XPDUTL("Post-init starting...")
+3 DO UPDZIP
+4 DO DGBTDLT
+5 DO BMES^XPDUTL("...Post-init complete")
+6 ;
+7 QUIT
+8 ;
UPDZIP ;remove hyphen from internal zip code entry
+1 ;
+2 NEW DGBTDT
+3 DO BMES^XPDUTL(" Updating zip codes...")
+4 SET DGBTDT=0
FOR
SET DGBTDT=$ORDER(^DGBT(392,DGBTDT))
if 'DGBTDT
QUIT
Begin DoDot:1
+5 IF $DATA(^DGBT(392,DGBTDT,"D"))
Begin DoDot:2
+6 IF $PIECE(^DGBT(392,DGBTDT,"D"),U,6)["-"
Begin DoDot:3
+7 SET $PIECE(^DGBT(392,DGBTDT,"D"),U,6)=$TRANSLATE($PIECE(^DGBT(392,DGBTDT,"D"),U,6),"-","")
End DoDot:3
End DoDot:2
+8 IF $DATA(^DGBT(392,DGBTDT,"T"))
Begin DoDot:2
+9 IF $PIECE(^DGBT(392,DGBTDT,"T"),U,6)["-"
Begin DoDot:3
+10 SET $PIECE(^DGBT(392,DGBTDT,"T"),U,6)=$TRANSLATE($PIECE(^DGBT(392,DGBTDT,"T"),U,6),"-","")
End DoDot:3
End DoDot:2
End DoDot:1
+11 DO BMES^XPDUTL(" ...zip code update complete")
+12 QUIT
+13 ;
DGBTDLT ;update the 30 Day Application Requirement denial letter template
+1 ;
+2 NEW DGBTIEN,DGBTARAY,DGBTLP
+3 DO BMES^XPDUTL(" Updating denial letter...")
+4 SET DGBTIEN=$ORDER(^DGBT(392.8,"B","30 DAY APPLICATION REQUIREMENT",""))
+5 IF 'DGBTIEN
DO BMES^XPDUTL("***Error encountered: 30 DAY APPLICATION REQUIREMENT letter not found***")
QUIT
+6 FOR DGBTLP=1:1:5
SET DGBTARAY(DGBTLP)=$PIECE($TEXT(TEXT+DGBTLP),";;",2)
+7 DO WP^DIE(392.8,DGBTIEN_",",1,"K","DGBTARAY","DGBTERR")
+8 IF $DATA(DGBTERR)
DO BMES^XPDUTL("***Error encountered while attempting to update the denial letter***")
+9 IF '$TEST
DO BMES^XPDUTL(" ...denial letter update complete")
+10 QUIT
+11 ;
TEXT ;new text for 30 Day Application Requirement template
+1 ;;
+2 ;; Your request for payment consideration was received greater than 30
+3 ;; calendar days from the date you completed travel associated with your
+4 ;; appointment or the date you became administratively eligible for
+5 ;; payment of Beneficiary Travel benefits.
