| [613] | 1 | FBAAUTL3 ;AISC/DMK-FEE BASIS UTILITY ROUTINE ;5/12/93 13:42
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | HDR() ;this is a supported call to be used by IFCAP to determine
|
|---|
| 5 | ;the System Identifier for the 994 code sheets
|
|---|
| 6 | ;Q $S($P($G(^FBAA(161.4,1,1)),U,10)]"":$P(^(1),U,10),1:"FEN")
|
|---|
| 7 | Q $S($$VER5():"FEN",1:"FEE")
|
|---|
| 8 | ;
|
|---|
| 9 | POV(X) ;determine ien of pov based on austin code
|
|---|
| 10 | ;INPUT: X = pov code
|
|---|
| 11 | ;OUTPUT: ien of active record containing passed pov code or 0
|
|---|
| 12 | S:X']"" X=0
|
|---|
| 13 | Q +$O(^FBAA(161.82,"AC",X,0))
|
|---|
| 14 | ;
|
|---|
| 15 | RCOMP ;entry point to re-compile templates
|
|---|
| 16 | S:'$D(DTIME) DTIME=300 S U="^"
|
|---|
| 17 | S DIR(0)="Y",DIR("A")="Re-compile FB input templates" D ^DIR K DIR G RCOMPQ:'Y
|
|---|
| 18 | S $P(QQ,"=",81)="" W !!?17,"Recompilation of Fee Basis Input Templates",!,QQ
|
|---|
| 19 | 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
|
|---|
| 20 | RCOMPQ ;kill off variables and exit re-compile option
|
|---|
| 21 | K DMAX,FBX,Y,X,QQ,FBMAX
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | UP(X) ;entry point to convert lower case to upper case letters
|
|---|
| 25 | I $G(X)']"" Q 0
|
|---|
| 26 | Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
| 27 | ;
|
|---|
| 28 | YN ;called from input transform on Yes - No type fields to allow
|
|---|
| 29 | ;a user to enter:
|
|---|
| 30 | ; 1 = Yes 0 = No stores Y or N
|
|---|
| 31 | ;
|
|---|
| 32 | S X=$E($$UP^FBAAUTL3(X))
|
|---|
| 33 | S X=$S(X:"Y",X="Y":X,X="N":X,X=0:"N",1:2)
|
|---|
| 34 | I X'=2 W " (",$S(X="Y":"YES",1:"NO"),")" Q
|
|---|
| 35 | W *7,!?4,"NOT A VALID ENTRY!" K X
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | OUTYN ;called from output transform on fields that are defined as Y/N
|
|---|
| 39 | ;
|
|---|
| 40 | S Y=$S(Y="Y":"YES",Y="N":"NO",1:"")
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | VER5() ;returns '1' if site is running version 5 of IFCAP
|
|---|
| 44 | ;used to handle record layouts for FMS payments
|
|---|
| 45 | N X
|
|---|
| 46 | ;S X=$G(^DIC(9.4,+$O(^DIC(9.4,"C","PRC",0)),"VERSION"))
|
|---|
| 47 | S X=$$VERSION^XPDUTL("PRC")
|
|---|
| 48 | Q $S(+X>4:1,1:0)
|
|---|
| 49 | ;
|
|---|
| 50 | IDCHK(DFN,AUTH) ;call to check if authorization being paid is
|
|---|
| 51 | ;an ID card. Called during payment process.
|
|---|
| 52 | ;DFN = patients internal entry number
|
|---|
| 53 | ;AUTH= internal entry number of authorization in 161.
|
|---|
| 54 | ;both are required
|
|---|
| 55 | I $S('$G(DFN):1,'$G(AUTH):1,1:0) Q 0
|
|---|
| 56 | Q $S('$D(^FBAAA(+DFN,1,+AUTH,0)):0,$P(^(0),U,13)=3:1,1:0)
|
|---|
