Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBXIP155

FBXIP155.m

Go to the documentation of this file.
  1. FBXIP155 ;ALB/BJR-PATCH INSTALL ROUTINE ; 10/8/14 11:22am
  1. ;;3.5;FEE BASIS;**155**;JAN 30, 1995;Build 2
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. UPDPOV ; Update Selected Purpose of Visits (POV)
  1. N FBCODE,FBDA,FBFDA,FBI,FBNAME,FBPROG,FBX,X,Y,FBCCODE
  1. D BMES^XPDUTL(" Updating selected POVs in the FEE BASIS PURPOSE OF VISIT (161.82) file...")
  1. ; verify IEN of OUTPATIENT program in FEE BASIS PROGRAM file
  1. I $P($G(^FBAA(161.8,2,0)),U)'="OUTPATIENT" D Q
  1. . D MES^XPDUTL(" ERROR: Fee Program with IEN 2 is not OUTPATIENT.")
  1. . D MES^XPDUTL(" Purpose of Visits could not be updated.")
  1. . D MES^XPDUTL(" Please contact your IRM for assistance.")
  1. F FBI=1:1 S FBX=$P($T(POV+FBI),";;",2) Q:FBX="END" D
  1. . S FBCODE=$P(FBX,U)
  1. . S FBNAME=$P(FBX,U,2)
  1. . S FBPROG=$P(FBX,U,3)
  1. . N DA,DD,DIC,DINUM,DLAYGO,DO,X
  1. . S FBCCODE=$O(^FBAA(161.82,"B",FBNAME,"")) I FBCCODE,$P(^FBAA(161.82,FBCCODE,0),U,3)=FBCODE D MES^XPDUTL("POV WITH CODE "_FBCODE_" ALREADY EXISTS AND HAS NOT BEEN ADDED") Q
  1. . S DIC="^FBAA(161.82,",DIC(0)="L",DLAYGO=161.82
  1. . S X=FBNAME
  1. . S DIC("DR")="2///^S X=FBPROG;3///^S X=FBCODE"
  1. . I +FBCODE,'$D(^FBAA(161.82,+FBCODE,0)) S DINUM=+FBCODE
  1. . D FILE^DICN
  1. . I Y<0 D MES^XPDUTL("ERROR ADDING POV WITH CODE "_FBCODE) Q
  1. . D MES^XPDUTL("POV WITH CODE "_FBCODE_" HAS BEEN ADDED")
  1. D BMES^XPDUTL("Post Install Completed.")
  1. Q
  1. ;
  1. POV ;austin code^name^fee program for Purpose of Visit (POV) code(s)
  1. ;;25^NON-VA MEDICAL CARE, CAREGIVER OVERSIGHT VISITS^2
  1. ;;26^PROGRAM OF ALL-INCLUSIVE CARE OF THE ELDERLY (PACE)^2
  1. ;;27^VETERAN-DIRECTED HOME AND COMMUNITY BASED SERVICES (VD-HCBS)^2
  1. ;;28^AMBULANCE/TRAVEL - FOR INPATIENT OR OUTPATIENT SERVICES^2
  1. ;;END
  1. ;
  1. ;FBXIP155