source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBAAPM.m@ 1608

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

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1FBAAPM ;AISC/DMK,GRR-CREATE PATIENT MRA TRANSACTION ;7/7/1998
2 ;;3.5;FEE BASIS;**13**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
41 Q:'$D(FBMTYPE)
5 D GETVET^FBAAUTL1 G END:'DFN
6 D GETAUTH^FBAAUTL1 G 1:FTP']""
7 S FBD1=+FTP
83 W ! S DIR("A")="Are you sure you want to create a '"_$S(FBMTYPE="A":"Add",FBMTYPE="D":"Delete",FBMTYPE="C":"Change",FBMTYPE="R":"Reinstate",1:"")_"' type MRA for this patient",DIR("B")="Yes",DIR(0)="Y"
9 D ^DIR K DIR G 1:$D(DIRUT)!('Y)
10 S FBMST=$S($P(^FBAAA(DFN,1,FBD1,0),"^",13)=1:"Y",1:"")
11 S DIC="^FBAA(161.26,",DIC(0)="L",DLAYGO=161.26,X=DFN
12 S DR="1////^S X=""P"";2////^S X=FBD1;S Y=$S(FBMST="""":3,1:6);6////^S X=FBMST;3////^S X=FBMTYPE"
13 ; for Change MRA (expect State Home) ask if From Date was changed
14 I FBMTYPE="C",$P($G(^FBAAA(DFN,1,FBD1,0)),U,13)'=4 S DR=DR_";5"
15 S DIE=DIC K DD,DO D FILE^DICN K DLAYGO G:Y<0 END S DA=+Y
16 D ^DIE I $D(Y)>0 S DIK=DIE D ^DIK W !,*7,"MRA deleted.",! G 1
17 W !!,"Transaction Created!"
18 I FBMTYPE="D" S $P(^FBAAA(DFN,1,FBD1,"ADEL"),"^",1,2)="Y^"_DT
19 I FBMTYPE="R"!(FBMTYPE="A") S:$D(^FBAAA(DFN,1,FBD1,"ADEL")) ^("ADEL")=""
20 G 1
21END K DIC,CNT,Y,X,I,DIC,D0,DFN,F,C,FBD1,DA,DAT,DI,DIE,DQ,DR,PE,FBMST,FBMTYPE,FBVEN,FTP,FBPSA,FBLOC,FBASSOC,FB7078,FBAABDT,FBAAEDT,FBAAOUT,FBAUT,FBPOV,FBPROG,FBPT,FBTT,FBTYPE,PI,TA,Z,FBDMRA
22 Q
Note: See TracBrowser for help on using the repository browser.