- 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 Mar 13, 2025@20:59:28 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
