FB35167P ;ALBANY/BJR-PATCH INSTALL ROUTINE ; 11/18/15 12:59pm
;;3.5;FEE BASIS;**167**;JAN 30, 1995;Build 13
;Per VA Directive 6402, this routine should not be modified
Q
;
EN ; post-install entry point
K ^TMP("FB167",$J)
D MES^XPDUTL("")
D MES^XPDUTL("Running FB*3.5*167 Post Install")
D MES^XPDUTL("Check your Mailman Inbox for message 'FB*3.5*167 Data'")
D HDR,DATA,MAIL
K ^TMP("FB167",$J)
D MES^XPDUTL("")
D MES^XPDUTL("FB*3.5*167 Post Install Complete")
Q
DATA ;Create temp global for report
N FBPROG,FBDT,FBIEN,FBDFN,FBAUTH,FBGBL,FBINV,FBX
S FBX=5
S FBPROG=0 F S FBPROG=$O(^FBAA(161.8,FBPROG)) Q:'FBPROG D
.S FBDT=3150930 F S FBDT=$O(^FB583("AD",FBPROG,FBDT)) Q:'FBDT D
..S FBIEN=0 F S FBIEN=$O(^FB583("AD",FBPROG,FBDT,FBIEN)) Q:'FBIEN D
...Q:$$GET1^DIQ(162.7,FBIEN,5.1)=""
...S FBDFN=$O(^FBAAA("AG",FBIEN_";FB583(","")) Q:'FBDFN S FBAUTH=$O(^FBAAA("AG",FBIEN_";FB583(",FBDFN,""))
...S FBGBL=^FBAAA(FBDFN,1,FBAUTH,0) I $P($G(^FBAAA(FBDFN,1,FBAUTH,"C")),"^",2)="" D
....S ^TMP("FB167",$J,FBX)=$E($$GET1^DIQ(162.7,FBIEN,2)_" ",1,32)
....S ^TMP("FB167",$J,FBX)=^TMP("FB167",$J,FBX)_$E($$GET1^DIQ(162.7,FBIEN,3)_" ",1,16)
....S ^TMP("FB167",$J,FBX)=^TMP("FB167",$J,FBX)_$E($$GET1^DIQ(162.7,FBIEN,4)_" ",1,16)
....S ^TMP("FB167",$J,FBX)=^TMP("FB167",$J,FBX)_$E($$GET1^DIQ(162.7,FBIEN,1),1,15)
....S FBX=FBX+1
Q
HDR ;Header for report
N FBY
S ^TMP("FB167",$J,3)="PATIENT"_" "_"FROM DATE"_" "_"TO DATE"_" "_"VENDOR"
S ^TMP("FB167",$J,4)="" F FBY=1:1:79 S ^TMP("FB167",$J,4)=^TMP("FB167",$J,4)_"-"
Q
MAIL ; send the mail message
;Call to ^XMD supported by ICR #10070
S ^TMP("FB167",$J,1)="The following Unauthorized Claims have data missing in the FEE BASIS PATIENT (#161) file."
S ^TMP("FB167",$J,2)=" "
N XMY,XMDUZ,XMSUB,XMTEXT,DIFROM
S XMY(DUZ)="",XMDUZ="FB_3.5_167 Post Install"
S XMSUB="FB*3.5*167 Data"
S XMTEXT="^TMP(""FB167"",$J,"
D ^XMD
Q
PRINT ;Print to screen instead of Mailman
K ^TMP("FB167",$J)
D HDR,DATA
N FBCNT
S FBCNT=0 F S FBCNT=$O(^TMP("FB167",$J,FBCNT)) Q:'FBCNT W !,^TMP("FB167",$J,FBCNT)
K ^TMP("FB167",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFB35167P 2234 printed Sep 23, 2025@19:30:50 Page 2
FB35167P ;ALBANY/BJR-PATCH INSTALL ROUTINE ; 11/18/15 12:59pm
+1 ;;3.5;FEE BASIS;**167**;JAN 30, 1995;Build 13
+2 ;Per VA Directive 6402, this routine should not be modified
+3 QUIT
+4 ;
EN ; post-install entry point
+1 KILL ^TMP("FB167",$JOB)
+2 DO MES^XPDUTL("")
+3 DO MES^XPDUTL("Running FB*3.5*167 Post Install")
+4 DO MES^XPDUTL("Check your Mailman Inbox for message 'FB*3.5*167 Data'")
+5 DO HDR
DO DATA
DO MAIL
+6 KILL ^TMP("FB167",$JOB)
+7 DO MES^XPDUTL("")
+8 DO MES^XPDUTL("FB*3.5*167 Post Install Complete")
+9 QUIT
DATA ;Create temp global for report
+1 NEW FBPROG,FBDT,FBIEN,FBDFN,FBAUTH,FBGBL,FBINV,FBX
+2 SET FBX=5
+3 SET FBPROG=0
FOR
SET FBPROG=$ORDER(^FBAA(161.8,FBPROG))
if 'FBPROG
QUIT
Begin DoDot:1
+4 SET FBDT=3150930
FOR
SET FBDT=$ORDER(^FB583("AD",FBPROG,FBDT))
if 'FBDT
QUIT
Begin DoDot:2
+5 SET FBIEN=0
FOR
SET FBIEN=$ORDER(^FB583("AD",FBPROG,FBDT,FBIEN))
if 'FBIEN
QUIT
Begin DoDot:3
+6 if $$GET1^DIQ(162.7,FBIEN,5.1)=""
QUIT
+7 SET FBDFN=$ORDER(^FBAAA("AG",FBIEN_";FB583(",""))
if 'FBDFN
QUIT
SET FBAUTH=$ORDER(^FBAAA("AG",FBIEN_";FB583(",FBDFN,""))
+8 SET FBGBL=^FBAAA(FBDFN,1,FBAUTH,0)
IF $PIECE($GET(^FBAAA(FBDFN,1,FBAUTH,"C")),"^",2)=""
Begin DoDot:4
+9 SET ^TMP("FB167",$JOB,FBX)=$EXTRACT($$GET1^DIQ(162.7,FBIEN,2)_" ",1,32)
+10 SET ^TMP("FB167",$JOB,FBX)=^TMP("FB167",$JOB,FBX)_$EXTRACT($$GET1^DIQ(162.7,FBIEN,3)_" ",1,16)
+11 SET ^TMP("FB167",$JOB,FBX)=^TMP("FB167",$JOB,FBX)_$EXTRACT($$GET1^DIQ(162.7,FBIEN,4)_" ",1,16)
+12 SET ^TMP("FB167",$JOB,FBX)=^TMP("FB167",$JOB,FBX)_$EXTRACT($$GET1^DIQ(162.7,FBIEN,1),1,15)
+13 SET FBX=FBX+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT
HDR ;Header for report
+1 NEW FBY
+2 SET ^TMP("FB167",$JOB,3)="PATIENT"_" "_"FROM DATE"_" "_"TO DATE"_" "_"VENDOR"
+3 SET ^TMP("FB167",$JOB,4)=""
FOR FBY=1:1:79
SET ^TMP("FB167",$JOB,4)=^TMP("FB167",$JOB,4)_"-"
+4 QUIT
MAIL ; send the mail message
+1 ;Call to ^XMD supported by ICR #10070
+2 SET ^TMP("FB167",$JOB,1)="The following Unauthorized Claims have data missing in the FEE BASIS PATIENT (#161) file."
+3 SET ^TMP("FB167",$JOB,2)=" "
+4 NEW XMY,XMDUZ,XMSUB,XMTEXT,DIFROM
+5 SET XMY(DUZ)=""
SET XMDUZ="FB_3.5_167 Post Install"
+6 SET XMSUB="FB*3.5*167 Data"
+7 SET XMTEXT="^TMP(""FB167"",$J,"
+8 DO ^XMD
+9 QUIT
PRINT ;Print to screen instead of Mailman
+1 KILL ^TMP("FB167",$JOB)
+2 DO HDR
DO DATA
+3 NEW FBCNT
+4 SET FBCNT=0
FOR
SET FBCNT=$ORDER(^TMP("FB167",$JOB,FBCNT))
if 'FBCNT
QUIT
WRITE !,^TMP("FB167",$JOB,FBCNT)
+5 KILL ^TMP("FB167",$JOB)
+6 QUIT
