FBXIP38.m

FBXIP38 ;WOIFO/SAB-PATCH INSTALL ROUTINE ;11/26/2001

 ;;3.5;FEE BASIS;**38**;JAN 30, 1995

 Q

 ;

PS ; post-install entry point

 ; create KIDS checkpoints with call backs

 N FBX,Y

 F FBX="SUSCOD","STATEXP","EXPDT" D

 . S Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP38")

 . I 'Y D BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")

 Q

 ;

SUSCOD ; Add new Suspend Code to the FEE BASIS SUSPENSION (#161.27) file.

 D BMES^XPDUTL("  Adding new suspend code to file #161.27...")

 N FBDA

 ; check for J suspension code

 S FBDA=$$FIND1^DIC(161.27,"","X","J","B")

 ; if not found then add it

 I 'FBDA D

 . N DA,DD,DIC,DINUM,DLAYGO,DO,X,Y

 . S DIC="^FBAA(161.27,",DIC(0)="L",DLAYGO=161.27

 . S X="J"

 . S DIC("DR")="2///^S X=""Mill Bill Authority, 38 U.S.C. 1725"""

 . D FILE^DICN

 . I Y<0 D MES^XPDUTL("ERROR ADDING J SUSPEND CODE") Q

 . ; update Description wp field of entry (replaces current text)

 . K ^TMP($J,"FB1")

 . S ^TMP($J,"FB1",1,0)="Payment in Accordance with pricing for claims approved under 38 USC 1725"

 . S ^TMP($J,"FB1",2,0)="payer of last resort."

 . ;   replace existing text with content of array

 . D WP^DIE(161.27,+Y_",",1,"","^TMP($J,""FB1"")") D MSG^DIALOG()

 . K ^TMP($J,"FB1")

 Q

 ;

STATEXP ; Populate field .07 in file 162.92 for appropriate status

 D BMES^XPDUTL("  Populating new field in file #162.92...")

 N FBDA,FBFDA,FBORDER

 ; loop thru status orders that need to be populated

 F FBORDER=10,40,55,70 D

 . S FBDA=$$STATUS^FBUCUTL(FBORDER) ; get ien

 . Q:'FBDA

 . Q:$P($G(^FB(162.92,FBDA,0)),U,7)]""  ; field already populated

 . I FBORDER=10 S FBFDA(162.92,FBDA_",",.07)="31"

 . I FBORDER=40 S FBFDA(162.92,FBDA_",",.07)="366"

 . I FBORDER=55 S FBFDA(162.92,FBDA_",",.07)="366"

 . I FBORDER=70 S FBFDA(162.92,FBDA_",",.07)="121"

 ; update entries

 I $D(FBFDA) D FILE^DIE("E","FBFDA") D MSG^DIALOG()

 Q

 ;

EXPDT ; Recompute expiration dates of incomplete Mill Bill claims

 D BMES^XPDUTL("  Recalculating expiration date of incomplete claims...")

 N FBDA,FBEXP,FBEXPN,FBLETDT,FBORDER,FBSTATUS,FBUCA

 ;

 ; get ien for status 'incomplete unauthorized claim' 

 S FBORDER=10

 S FBSTATUS=$$STATUS^FBUCUTL(FBORDER)

 ;

 ; loop thru incomplete claims

 S FBDA=0 F  S FBDA=$O(^FB583("AS",FBSTATUS,FBDA)) Q:'FBDA  D

 . S FBUCA=$G(^FB583(FBDA,0))

 . S FBEXP=$P(FBUCA,U,26) ; expiration date

 . S FBLETDT=$P(FBUCA,U,19) ; date letter sent

 . Q:$P(FBUCA,U,28)'=1  ; skip if not mill bill claim

 . Q:FBEXP'>0  ; skip if no expiration date on file

 . Q:FBLETDT'>0  ; skip if letter date is not on file

 . ;

 . ; calculate new expiration date and update claim

 . S FBEXPN=$$EXPIRE^FBUCUTL8(FBDA,FBLETDT,FBUCA,FBORDER)

 . ;W !,FBDA,?10,FBLETDT,?20,FBEXP,?30,FBEXPN

 . D EDITL^FBUCED(FBDA,FBEXPN,0)

 Q

 ;FBXIP38

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBXIP38   2776     printed  Mar 13, 2025@21:06:41                                                                                                                                                                                                     Page 2

FBXIP38   ;WOIFO/SAB-PATCH INSTALL ROUTINE ;11/26/2001

 +1       ;;3.5;FEE BASIS;**38**;JAN 30, 1995

 +2        QUIT 

 +3       ;

PS        ; post-install entry point

 +1       ; create KIDS checkpoints with call backs

 +2        NEW FBX,Y

 +3        FOR FBX="SUSCOD","STATEXP","EXPDT"

               Begin DoDot:1

 +4                SET Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP38")

 +5                IF 'Y

                       DO BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")

               End DoDot:1

 +6        QUIT 

 +7       ;

SUSCOD    ; Add new Suspend Code to the FEE BASIS SUSPENSION (#161.27) file.

 +1        DO BMES^XPDUTL("  Adding new suspend code to file #161.27...")

 +2        NEW FBDA

 +3       ; check for J suspension code

 +4        SET FBDA=$$FIND1^DIC(161.27,"","X","J","B")

 +5       ; if not found then add it

 +6        IF 'FBDA

               Begin DoDot:1

 +7                NEW DA,DD,DIC,DINUM,DLAYGO,DO,X,Y

 +8                SET DIC="^FBAA(161.27,"

                   SET DIC(0)="L"

                   SET DLAYGO=161.27

 +9                SET X="J"

 +10               SET DIC("DR")="2///^S X=""Mill Bill Authority, 38 U.S.C. 1725"""

 +11               DO FILE^DICN

 +12               IF Y<0

                       DO MES^XPDUTL("ERROR ADDING J SUSPEND CODE")

                       QUIT 

 +13      ; update Description wp field of entry (replaces current text)

 +14               KILL ^TMP($JOB,"FB1")

 +15               SET ^TMP($JOB,"FB1",1,0)="Payment in Accordance with pricing for claims approved under 38 USC 1725"

 +16               SET ^TMP($JOB,"FB1",2,0)="payer of last resort."

 +17      ;   replace existing text with content of array

 +18               DO WP^DIE(161.27,+Y_",",1,"","^TMP($J,""FB1"")")

                   DO MSG^DIALOG()

 +19               KILL ^TMP($JOB,"FB1")

               End DoDot:1

 +20       QUIT 

 +21      ;

STATEXP   ; Populate field .07 in file 162.92 for appropriate status

 +1        DO BMES^XPDUTL("  Populating new field in file #162.92...")

 +2        NEW FBDA,FBFDA,FBORDER

 +3       ; loop thru status orders that need to be populated

 +4        FOR FBORDER=10,40,55,70

               Begin DoDot:1

 +5       ; get ien

                   SET FBDA=$$STATUS^FBUCUTL(FBORDER)

 +6                if 'FBDA

                       QUIT 

 +7       ; field already populated

                   if $PIECE($GET(^FB(162.92,FBDA,0)),U,7)]""

                       QUIT 

 +8                IF FBORDER=10

                       SET FBFDA(162.92,FBDA_",",.07)="31"

 +9                IF FBORDER=40

                       SET FBFDA(162.92,FBDA_",",.07)="366"

 +10               IF FBORDER=55

                       SET FBFDA(162.92,FBDA_",",.07)="366"

 +11               IF FBORDER=70

                       SET FBFDA(162.92,FBDA_",",.07)="121"

               End DoDot:1

 +12      ; update entries

 +13       IF $DATA(FBFDA)

               DO FILE^DIE("E","FBFDA")

               DO MSG^DIALOG()

 +14       QUIT 

 +15      ;

EXPDT     ; Recompute expiration dates of incomplete Mill Bill claims

 +1        DO BMES^XPDUTL("  Recalculating expiration date of incomplete claims...")

 +2        NEW FBDA,FBEXP,FBEXPN,FBLETDT,FBORDER,FBSTATUS,FBUCA

 +3       ;

 +4       ; get ien for status 'incomplete unauthorized claim' 

 +5        SET FBORDER=10

 +6        SET FBSTATUS=$$STATUS^FBUCUTL(FBORDER)

 +7       ;

 +8       ; loop thru incomplete claims

 +9        SET FBDA=0

           FOR 

               SET FBDA=$ORDER(^FB583("AS",FBSTATUS,FBDA))

               if 'FBDA

                   QUIT 

               Begin DoDot:1

 +10               SET FBUCA=$GET(^FB583(FBDA,0))

 +11      ; expiration date

                   SET FBEXP=$PIECE(FBUCA,U,26)

 +12      ; date letter sent

                   SET FBLETDT=$PIECE(FBUCA,U,19)

 +13      ; skip if not mill bill claim

                   if $PIECE(FBUCA,U,28)'=1

                       QUIT 

 +14      ; skip if no expiration date on file

                   if FBEXP'>0

                       QUIT 

 +15      ; skip if letter date is not on file

                   if FBLETDT'>0

                       QUIT 

 +16      ;

 +17      ; calculate new expiration date and update claim

 +18               SET FBEXPN=$$EXPIRE^FBUCUTL8(FBDA,FBLETDT,FBUCA,FBORDER)

 +19      ;W !,FBDA,?10,FBLETDT,?20,FBEXP,?30,FBEXPN

 +20               DO EDITL^FBUCED(FBDA,FBEXPN,0)

               End DoDot:1

 +21       QUIT 

 +22      ;FBXIP38