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

FBAAUTL2.m

Go to the documentation of this file.
  1. FBAAUTL2 ;AISC/GRR - FEE UTILITY ROUTINE ;9/21/14 21:48
  1. ;;3.5;FEE BASIS;**8,143,154**;JAN 30, 1995;Build 12
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. CONDAT ;called from input transform in 161.21,.02-.03
  1. S (FBOUT,Z)=0
  1. F S Z=$O(^FBAA(161.21,"C",+$G(FBVIEN),Z)) Q:'Z I $P($G(^FBAA(161.21,Z,0)),U,2) S Z(0)=^(0),FBVCON($P(Z(0),U,2))=$P(Z(0),U,3)
  1. K FBVCON(+$P(^FBAA(161.21,DA,0),U,2))
  1. S Z=0 F S Z=$O(FBVCON(Z)) Q:Z'>0!(FBOUT) I X'<Z&(X'>FBVCON(Z)) S FBOUT=1 W !,*7,"Date entered overlaps existing contract dates!",! K X,Z,FBVCON Q
  1. K Z,FBVCON
  1. Q
  1. DATES ;ASK FROM AND TO DATES AND ENSURE THEY DO NOT OVERLAP PRIOR AUTHORIZATIONS
  1. ;variables FBO and FB1 are set in FBNHEDAT as default dates
  1. S FBFLAG=1 K FBAUT
  1. FDAT S (FBBEGDT,FBENDDT)="",%DT("A")="Select FROM DATE: ",%DT="AEX" S:$S($G(FBO):1,1:0) %DT("B")=$$FMTE^XLFDT(FBO,1) D ^%DT G:Y'>0 END S FBBEGDT=Y
  1. G:FBFLAG=2 EN1
  1. EDAT S FBOUT=0,%DT("A")="Select TO DATE: ",%DT="AEX",%DT(0)=FBBEGDT S:$S($G(FB1):1,1:0) %DT("B")=$$FMTE^XLFDT(FB1,1) D ^%DT K %DT(0) G:Y'>0 END S FBENDDT=Y
  1. EN1 ;CHECK WHETHER AUTHORIZATION FROM DATE OVERLAPS PREVIOUS ENTRIES
  1. S (FBOUT,FBLG)=0 F Z=0:0 S Z=$O(^FBAAA(DFN,1,Z)) Q:Z'>0 I $D(^(Z,0)) S Z(0)=^(0) I $P(Z(0),"^",3)=FBPROG S FBAUT($P(Z(0),"^"))=$P(Z(0),"^",2)
  1. I $G(FBO),($G(FB1)),($G(FBAUT(FBO))=FB1) K FBAUT(FBO)
  1. F Z=0:0 S Z=$O(FBAUT(Z)) Q:Z'>0!(FBOUT) D CHKDT:FBFLAG=1,CHKBO:FBFLAG=2,ERRD:FBLG>0
  1. I FBOUT S FBOUT=0 G:FBLG>0&(FBFLAG=1) FDAT
  1. Q
  1. END S (FBBEGDT,FBENDDT)="" K Z,FBAUT,FBOUT,FBLG Q
  1. CHKDT I FBBEGDT<Z&(FBENDDT<Z) S FBLG=0,FBOUT=1 Q
  1. I FBBEGDT<Z&(FBENDDT'<Z) S FBLG=2,FBOUT=1 Q
  1. I FBPROG=7,FBAUT(Z)>DT S FBLG=0,FBOUT=1,FBBEGDT="" K FBAUT W !!?5,"There already is an active CNH authorization on file.",!?5,"Use the 'Edit CNH Authorization' option.",! Q
  1. I FBPROG=7,FBBEGDT=FBAUT(Z) Q
  1. CHKBO I FBBEGDT'<Z&(FBBEGDT'>FBAUT(Z)) S FBLG=1,FBOUT=1 Q
  1. Q
  1. ERRD W !,*7,$S(FBLG=1:"FROM ",1:"TO "),"DATE entered overlaps a previous Authorization!",!
  1. Q
  1. ;
  1. UPDT ;UPDATE BATCH STATUS
  1. S DA=J,(DIC,DIE)="^FBAA(161.7,",DR="11////^S X=FBSTAT;12////^S X=DT" D ^DIE Q
  1. Q
  1. ;
  1. PAT S FBSSN=$P(Y(0),"^",9) S:$L(FBSSN)=9 FBSSN=FBSSN_" " S FBSEX=$P(Y(0),"^",2),FBSEX=$S(FBSEX="F":FBSEX,1:"M")
  1. S FBDOB=$P(Y(0),"^",3),FBDOB=$S(FBDOB="":" ",1:$E(FBDOB,4,7)_($E(FBDOB,1,3)+1700))
  1. S FBNAME=$P(Y(0),"^",1),FBLNAM=$E($P(FBNAME,",",1),1,5),FBFLNAM=$E($P(FBNAME,",",1),1,21),FBFLNAM=FBFLNAM_$E(PAD,$L(FBFLNAM)+1,21)
  1. S:$L(FBLNAM)<5 FBLNAM=FBLNAM_$E(" ",$L(FBLNAM)+1,5)
  1. S FBFI=$E($P(FBNAME,",",2),1),FBMI=$P(FBNAME,",",2),A=$F(FBMI," "),FBMI=$S(A<1:" ",1:$E(FBMI,A)),FBMI=$S(FBMI="":" ",1:FBMI)
  1. Q
  1. ;
  1. ASKVOK S DIR(0)="Y",DIR("A")="Is this the correct vendor",DIR("B")="YES" D ^DIR K DIR G:$D(DIRUT) VENOUT S:'Y FBVENO=1
  1. Q
  1. VENOUT S FBVENOT=1 K DIRUT Q
  1. ;
  1. FBPH W ! S DIR("A")="Want to review fee pharmacy payment history",DIR("B")="No",DIR(0)="Y" D ^DIR K DIR
  1. I Y,$D(DFN),$D(^DPT(+DFN,0)) S N=$P(^(0),"^"),FBHDFN=DFN N FBAAOUT D LIST^FBAAPPH S DFN=FBHDFN K FBHDFN
  1. Q
  1. PRPRDT D NOW^%DTC S Y=% X ^DD("DD") W ?60,Y
  1. Q
  1. IFCAP S PRCF("X")="S" D ^PRCFSITE S PRC("SITE")=$S($D(PRC("SITE")):PRC("SITE"),1:"") I PRC("SITE")="" S FBERR(1)=1 Q
  1. S FB("SITE")=PRC("SITE")
  1. Q
  1. POV ;GET POV/TREATMENT TYPE FROM 161 FOR TRANSMISSION OF PAYMENTS
  1. ; in K, L, M, N - IENs for File 162 service provided multiple
  1. ; out POV - purpose of visit (internal pointer) or null
  1. ; out FBTT - treatment type (internal code) or null
  1. S (FBTT,POV)=""
  1. N FTP
  1. S FTP=$P($G(^FBAAC(K,1,L,1,M,1,N,3)),U,9)
  1. I FTP D
  1. . N FBY
  1. . S FBY=$G(^FBAAA(K,1,FTP,0))
  1. . S POV=$P(FBY,"^",7)
  1. . S FBTT=$P(FBY,"^",13)
  1. Q
  1. XREF ;SET X-REF FOR PRINT AUTHORIZATION FIELD (161.01,1)
  1. Q:'$D(^FBAAA(DA(1),1,DA,0)) N FBZZ S FBZZ(0)=^(0),FBZZ(1)=$P(FBZZ(0),"^",3)
  1. S FBZZ(2)=$S(FBZZ(1)=2:"",FBZZ(1)=3:"",FBZZ(1)=11:"",1:1) I FBZZ(2) S ZZZ="" Q
  1. S ZZZ=$P(FBZZ(0),"^",13),ZZZ=$S(ZZZ=1:$P(FBZZ(0),"^"),ZZZ=2:$P(FBZZ(0),"^"),ZZZ=3:$S($D(^FBAAA(DA(1),4)):$P(^(4),"^",2),1:""),1:"")
  1. Q
  1. ADD S ZZZ="" D XREF Q:ZZZ="" S ^FBAAA("AF",$P(^FBAAA(DA(1),1,DA,0),"^",3),ZZZ,DA(1),DA)=""
  1. Q
  1. KILL S ZZZ="" D XREF Q:ZZZ="" K ^FBAAA("AF",$P(^FBAAA(DA(1),1,DA,0),"^",3),ZZZ,DA(1),DA)
  1. Q
  1. ;
  1. VER(X) ;determine version of a file based on DD node
  1. ;X= file number
  1. Q $S('X:0,1:+$P($G(^DD(X,0,"VR")),U))