Routine: FB35167P

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

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")

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

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)_"-"

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

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)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFB35167P   2234     printed  Apr 09, 2024@21:06:53                                                                                                                                                                                                    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

FB35167P.m