60 lines
3.3 KiB
Mathematica
60 lines
3.3 KiB
Mathematica
FBPST35B ;ACAMPUS/DMK-CONVERT FILE 163.99
|
|
;;3.5;FEE BASIS;;JAN 30, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;This post-init routine goes through file 163.99 and converts the .01
|
|
;field from a pointer to the CPT file(#81) to the external value.
|
|
;The .01 field is converted to free text with this install to allow
|
|
;for the incorperation of CPT Modifiers to the Fee Schedule.
|
|
;
|
|
Q:+$G(^DD(163.99,0,"VR"))>3
|
|
W !!,"Beginning FBPST35B ....",!!?18,"CONVERSION OF FEE BASIS FEE SCHEDULE FILE (#163.99)"
|
|
N FBI,FBX,DA,DIE,DR,X
|
|
S FBI=0
|
|
F S FBI=$O(^FBAA(163.99,FBI)) Q:'FBI I $D(^(FBI,0)) D
|
|
. S DA=FBI Q:'$D(^ICPT(FBI,0)) S FBX=$P(^(0),U)
|
|
. S DIE="^FBAA(163.99,",DR=".01////^S X=FBX" D ^DIE
|
|
;clean up old PT node in file 81
|
|
K ^DD(81,0,"PT",163.99,.01)
|
|
W !!,"Completed FBPST35B " D NOW^%DTC W $$DATX^FBAAUTL(%)
|
|
Q
|
|
VENDOR ;clean up invalid ID entries still in 161.25
|
|
S FBI=0 F S FBI=$O(^FBAA(161.25,FBI)) Q:'FBI S FBL=+$P($G(^FBAA(161.25,FBI,0)),U,6) D
|
|
.I FBL,(FBI'=FBL) Q
|
|
.S FBJ=0 F S FBJ=$O(^FBAA(161.25,"AF",FBI,FBJ)) Q:'FBJ I (FBI'=FBJ) S FBOUT=1 Q
|
|
.I $G(FBOUT) K FBOUT Q
|
|
.S FBID=$P($G(^FBAAV(FBI,0)),U,2) I FBID']""!($A(FBID)=45)!($L(FBID)>11)!($L(FBID)<9)!(+FBID=0)!(FBID'?9N.2AN) D
|
|
..S FB(FBI)=""
|
|
..S DIK="^FBAA(161.25,",DA=FBI D ^DIK K DIK,DA
|
|
..S DIE="^FBAAV(",DA=FBI,DR="9////^S X=""Y"";13///^S X=""T""" D ^DIE K DIE,DA,DR
|
|
I '$D(FB) G END
|
|
S PAD=" ",$P(PAD," ",40)="",FBCTR=2,FBTEXT(1,0)="The following vendors with invalid ID's have been placed in delete status:",FBTEXT(2,0)=" "
|
|
S FBI=0 F S FBI=$O(FB(FBI)) Q:'FBI S FBCTR=FBCTR+1,FBTEXT((FBCTR),0)=" "_$E($$VNAME^FBNHEXP(FBI),1,30)_$E(PAD,$L($$VNAME^FBNHEXP(FBI))+1,40)_$$VID^FBNHEXP(FBI)
|
|
S XMSUB="FEE BASIS VENDOR CORRECTIONS CLEANUP",XMDUZ=.5,XMY("G.FEE")="",XMTEXT="FBTEXT(" D ^XMD K FBTEXT,XMDUZ,XMSUB,XMY,XMTEXT,XMZ,PAD,FBCTR
|
|
END K FBI,FBJ,FBL,FBID,FB,X,Y,DIC
|
|
Q
|
|
XREF ;fix cross-references in 162 and 162.1 on date finalized & cert fields
|
|
S ZTRTN="FIX^FBPST35B",ZTIO="",ZTDTH=$H D ^%ZTLOAD
|
|
K ZTSK
|
|
Q
|
|
FIX ;outpatient x-ref fix on field date finalized
|
|
S FBV=0 F S FBV=$O(^FBAAC("AP",FBV)) Q:'FBV D
|
|
.S FBI=0 F S FBI=$O(^FBAAC("AP",FBV,FBI)) Q:'FBI D
|
|
..S DFN=0 F S DFN=$O(^FBAAC("AP",FBV,FBI,DFN)) Q:'DFN D
|
|
...S FBSDT=0 F S FBSDT=$O(^FBAAC("AP",FBV,FBI,DFN,FBSDT)) Q:'FBSDT D
|
|
....S FBCPT=0 F S FBCPT=$O(^FBAAC("AP",FBV,FBI,DFN,FBSDT,FBCPT)) Q:'FBCPT D
|
|
.....I $P($G(^FBAAC(DFN,1,FBV,1,FBSDT,1,FBCPT,0)),"^",6)'=FBI D
|
|
......K ^FBAAC("AK",FBI,DFN,FBV,FBSDT,FBCPT),^FBAAC("AP",FBV,FBI,DFN,FBSDT,FBCPT)
|
|
......S FBPSA=$P($G(^FBAAC(DFN,1,FBV,1,FBSDT,1,FBCPT,0)),"^",12) I FBPSA K ^FBAAC("AQ",FBPSA,9999999-FBI,DFN,FBV,FBSDT,FBCPT)
|
|
FIXRX ;fix Pharmacy Invoice x-ref on field date certified for payment
|
|
S FBI=0 F S FBI=$O(^FBAA(162.1,"AA",FBI)) Q:'FBI D
|
|
.S DFN=0 F S DFN=$O(^FBAA(162.1,"AA",FBI,DFN)) Q:'DFN D
|
|
..S FBIN=0 F S FBIN=$O(^FBAA(162.1,"AA",FBI,DFN,FBIN)) Q:'FBIN D
|
|
...S FBRX=0 F S FBRX=$O(^FBAA(162.1,"AA",FBI,DFN,FBIN,FBRX)) Q:'FBRX D
|
|
....S FBDT=$P($G(^FBAA(162.1,FBIN,"RX",FBRX,0)),"^",19) D K FBDT
|
|
.....Q:FBDT=FBI
|
|
.....I FBDT,(FBDT'=FBI) S $P(^FBAA(162.1,FBIN,"RX",FBRX,0),"^",19)=FBI Q
|
|
.....K ^FBAA(162.1,"AA",FBI,DFN,FBIN,FBRX)
|
|
.....S FBPSA=$P($G(^FBAA(162.1,FBIN,"RX",FBRX,2)),"^",5) I FBPSA K ^FBAA(162.1,"AI",FBPSA,9999999-FBI,FBIN,FBRX)
|
|
K FBI,DFN,FBV,FBSDT,FBCPT,FBPSA,FBIN,FBRX,FBDT S ZTREQ="@"
|
|
Q
|