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

FBAAUTL3.m

Go to the documentation of this file.
  1. FBAAUTL3 ;AISC/DMK - FEE BASIS UTILITY ROUTINE ;4/20/2012
  1. ;;3.5;FEE BASIS;**132,158**;JAN 30, 1995;Build 94
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. HDR() ;this is a supported call to be used by IFCAP to determine
  1. ;the System Identifier for the 994 code sheets
  1. ;Q $S($P($G(^FBAA(161.4,1,1)),U,10)]"":$P(^(1),U,10),1:"FEN")
  1. ; switch to FEE for the Subsystem Identifier FB*3.5*132
  1. ;Q $S($$VER5():"FEN",1:"FEE")
  1. Q "FEN" ;FB*3.5*158
  1. ;
  1. POV(X) ;determine ien of pov based on austin code
  1. ;INPUT: X = pov code
  1. ;OUTPUT: ien of active record containing passed pov code or 0
  1. S:X']"" X=0
  1. Q +$O(^FBAA(161.82,"AC",X,0))
  1. ;
  1. RCOMP ;entry point to re-compile templates
  1. S:'$D(DTIME) DTIME=300 S U="^"
  1. S DIR(0)="Y",DIR("A")="Re-compile FB input templates" D ^DIR K DIR G RCOMPQ:'Y
  1. S $P(QQ,"=",81)="" W !!?17,"Recompilation of Fee Basis Input Templates",!,QQ
  1. S FBMAX=^DD("ROU") F FBX="FB VENDOR UPDATE","FBAA AUTHORIZATION" S Y=$O(^DIE("B",FBX,0)) Q:'Y I $D(^DIE(Y,"ROUOLD")),^("ROUOLD")]"",$D(^(0)) S X=$P(^("ROUOLD"),"^"),DMAX=FBMAX D EN^DIEZ
  1. RCOMPQ ;kill off variables and exit re-compile option
  1. K DMAX,FBX,Y,X,QQ,FBMAX
  1. Q
  1. ;
  1. UP(X) ;entry point to convert lower case to upper case letters
  1. I $G(X)']"" Q 0
  1. Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. ;
  1. YN ;called from input transform on Yes - No type fields to allow
  1. ;a user to enter:
  1. ; 1 = Yes 0 = No stores Y or N
  1. ;
  1. S X=$E($$UP^FBAAUTL3(X))
  1. S X=$S(X:"Y",X="Y":X,X="N":X,X=0:"N",1:2)
  1. I X'=2 W " (",$S(X="Y":"YES",1:"NO"),")" Q
  1. W *7,!?4,"NOT A VALID ENTRY!" K X
  1. Q
  1. ;
  1. OUTYN ;called from output transform on fields that are defined as Y/N
  1. ;
  1. S Y=$S(Y="Y":"YES",Y="N":"NO",1:"")
  1. Q
  1. ;
  1. VER5() ;returns '1' if site is running version 5 of IFCAP
  1. ;used to handle record layouts for FMS payments
  1. N X
  1. ;S X=$G(^DIC(9.4,+$O(^DIC(9.4,"C","PRC",0)),"VERSION"))
  1. S X=$$VERSION^XPDUTL("PRC")
  1. Q $S(+X>4:1,1:0)
  1. ;
  1. IDCHK(DFN,AUTH) ;call to check if authorization being paid is
  1. ;an ID card. Called during payment process.
  1. ;DFN = patients internal entry number
  1. ;AUTH= internal entry number of authorization in 161.
  1. ;both are required
  1. I $S('$G(DFN):1,'$G(AUTH):1,1:0) Q 0
  1. Q $S('$D(^FBAAA(+DFN,1,+AUTH,0)):0,$P(^(0),U,13)=3:1,1:0)