source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBPST35A.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1FBPST35A ;AISC/CMR-MERGE & DELETION OF DENIALS FILES ; JUN 15 1994
2 ;;3.5;FEE BASIS;;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 I '$D(^DD(163,0)),('$D(^DD(163.1,0))) W !!,"Post-Init FBPST35A has already been run." Q
5 W !!,"Beginning FBPST35A....",!!?20,"CONVERSION OF DENIALS FILES"
6 I '$D(^FBAA(163,0)) G DEL
7 W !!,"Now I will move any Medical Denial information you wish to keep into the",!,"Fee Basis Payment File (#162). I will then remove the Fee Basis Medical",!,"Denials file (#163) and the Fee Basis Pharmacy Denials file (#163.1)."
8ASK W !!,"Do you want to keep any Medical Denials that are presently stored in the" S DIR(0)="Y",DIR("A")="Fee Basis Medical Denials file (#163)",DIR("B")="No"
9 S DIR("?")="Answering yes will move the denials to file #162, no will delete them" D ^DIR K DIR G:$D(DIRUT) ABRT I 'Y G DEL
10 S FBDEN=1
11 W !!,"You may elect to merge all of your Fee Basis Medical Denials. If you",!,"choose not to retain all denials, you will be prompted to select a",!,"STARTING DATE to retain denials. Denials from the starting date to the"
12 W !,"present date will be merged into file #162.",!!
13ASK1 S DIR(0)="Y",DIR("A")="Do you wish to retain all Medical Denials",DIR("B")="No" D ^DIR K DIR G ASK:$D(DIRUT),MOVE:Y
14 S DIR(0)="D",DIR("A")="Select date to retain denials" D ^DIR K DIR G ASK1:$D(DIRUT)!(Y'>0) S FBARDT=+Y
15MOVE S U="^" I '$G(FBDEN) G DEL
16 W !!?5,"Beginning merge"
17 ;get patient from denial file and set up or find in pmnt file
18 S DFN=0 F S DFN=$O(^FBAA(163,DFN)) Q:'DFN D
19 .;get vendor from denial file and set up or find in pmnt file
20 .S FBV=0 F S FBV=$O(^FBAA(163,DFN,1,FBV)) Q:'FBV D
21 ..;get trt dt from denial file and set up or find in pmnt file
22 ..S FBDSDI=0 F S FBDSDI=$O(^FBAA(163,DFN,1,FBV,1,FBDSDI)) Q:'FBDSDI S FBDDT=+^FBAA(163,DFN,1,FBV,1,FBDSDI,0),FBAUTH=$P(+^(0),"^",4) D:($S($G(FBARDT):FBDDT'<FBARDT,1:1))
23 ...D PAT^FBAACO,FILEV^FBAACO5(DFN,FBV) Q:$G(FBAAOUT) D GETSVDT^FBAACO5(DFN,FBV,FBAUTH,0,FBDDT) Q:$G(FBAAOUT)
24 ...;get and file svc provided multiples
25 ...S FBJ=0 F S FBJ=$O(^FBAA(163,DFN,1,FBV,1,FBDSDI,1,FBJ)) Q:'FBJ I $D(^FBAA(163,DFN,1,FBV,1,FBDSDI,1,FBJ,0)) S FBX=+^(0) D
26 ....W "." K DD,DO S DIC="^FBAAC(DFN,1,FBV,1,FBSDI,1,",DA(3)=DFN,DA(2)=FBV,DA(1)=FBSDI,X=FBX,DIC(0)="L",DIC("P")="162.03A" D FILE^DICN K DIC,DA Q:'Y S FBAACPI=+Y
27 ....S %X="^FBAA(163,DFN,1,FBV,1,FBDSDI,1,FBJ,",%Y="^FBAAC(DFN,1,FBV,1,FBSDI,1,FBAACPI," D %XY^%RCR
28 ....;re-index entry
29 ....S DIK="^FBAAC(DFN,1,FBV,1,FBSDI,1,",DA(3)=DFN,DA(2)=FBV,DA(1)=FBSDI,DA=FBAACPI D IX1^DIK K DIK,DA
30 ....;delete entry from 163
31 ....S DIK="^FBAA(163,DFN,1,FBV,1,FBDSDI,1,",DA(3)=DFN,DA(2)=FBV,DA(1)=FBDSDI,DA=FBJ D ^DIK K DIK,DA
32DEL ;delete files 163 and 163.1
33 I $D(^DD(163,0)) W !!?5,"Deleting the Fee Basis Medical Denials file (#163)..." S DIU="^FBAA(163,",DIU(0)="DT" D EN^DIU2
34 I $D(^DD(163.1,0)) W !!?5,"Deleting the Fee Basis Pharmacy Denials file (#163.1)..." S DIU="^FBAA(163.1,",DIU(0)="DT" D EN^DIU2
35 W !!?5,"Cleaning up DD nodes..."
36 K ^DD(200,0,"PT",163.03,6),^DD(200,0,"PT",163.1,2),^DD(200,0,"PT",163.11,11),^DD(161.2,0,"PT",163.01,.01),^DD(161.2,0,"PT",163.1,3),^DD(161,0,"PT",163.11,4),^DD(161.27,0,"PT",163.03,4),^DD(161.27,0,"PT",163.11,7)
37 K ^DD(50,0,"PT",163.11,9),^DD(161.7,0,"PT",163.03,7),^DD(161.7,0,"PT",163.03,21),^DD(161.7,0,"PT",163.04,1),^DD(161.7,0,"PT",163.04,6),^DD(161.7,0,"PT",163.1,10),^DD(161.7,0,"PT",163.11,13),^DD(161.7,0,"PT",163.11,19)
38 K ^DD(2,0,"PT",163,.01),^DD(161.8,0,"PT",163.02,1.5),^DD(161.8,0,"PT",163.03,23),^DD(81,0,"PT",163.03,.01),^DD(161.82,0,"PT",163.03,16)
39END K DFN,FBV,FBSDI,FBDSDI,DA,DIU,DIC,FBARDT,FBDEN,DIK,FBAADT,FBAUTH
40 W !!,"Completed FBPST35A " D NOW^%DTC W $$DATX^FBAAUTL(%)
41 Q
42ABRT ;
43 I $D(DUOUT) W !!,*7,"Required Response!!" G ASK
44 I $D(DTOUT) W !!,*7,"Unable to complete the FBPST35A Post-Init routine. To complete this",!,"process, run ^FBPST35A as soon as possible."
45 Q
Note: See TracBrowser for help on using the repository browser.