FBAAPM ;AISC/DMK,GRR - CREATE PATIENT MRA TRANSACTION ;6/5/2009
;;3.5;FEE BASIS;**13,108**;JAN 30, 1995;Build 115
;;Per VHA Directive 2004-038, this routine should not be modified.
1 Q:'$D(FBMTYPE)
D GETVET^FBAAUTL1 G END:'DFN
D GETAUTH^FBAAUTL1 G 1:FTP']""
S FBD1=+FTP
3 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"
D ^DIR K DIR G 1:$D(DIRUT)!('Y)
S FBMST=$S($P(^FBAAA(DFN,1,FBD1,0),"^",13)=1:"Y",1:"")
S DIC="^FBAA(161.26,",DIC(0)="L",DLAYGO=161.26,X=DFN
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"
; for Change MRA (expect State Home) ask if From Date was changed
I FBMTYPE="C",$P($G(^FBAAA(DFN,1,FBD1,0)),U,13)'=4 S DR=DR_";5"
S DIE=DIC K DD,DO D FILE^DICN K DLAYGO G:Y<0 END S DA=+Y
D ^DIE I $D(Y)>0 S DIK=DIE D ^DIK W !,*7,"MRA deleted.",! G 1
W !!,"Transaction Created!"
I FBMTYPE="D" S $P(^FBAAA(DFN,1,FBD1,"ADEL"),"^",1,2)="Y^"_DT
I FBMTYPE="R"!(FBMTYPE="A") S:$D(^FBAAA(DFN,1,FBD1,"ADEL")) ^("ADEL")=""
G 1
END 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
D GETAUTHK^FBAAUTL1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAPM 1380 printed Oct 16, 2024@17:57:02 Page 2
FBAAPM ;AISC/DMK,GRR - CREATE PATIENT MRA TRANSACTION ;6/5/2009
+1 ;;3.5;FEE BASIS;**13,108**;JAN 30, 1995;Build 115
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
1 if '$DATA(FBMTYPE)
QUIT
+1 DO GETVET^FBAAUTL1
if 'DFN
GOTO END
+2 DO GETAUTH^FBAAUTL1
if FTP']""
GOTO 1
+3 SET FBD1=+FTP
3 WRITE !
SET DIR("A")="Are you sure you want to create a '"_$SELECT(FBMTYPE="A":"Add",FBMTYPE="D":"Delete",FBMTYPE="C":"Change",FBMTYPE="R":"Reinstate",1:"")_"' type MRA for this patient"
SET DIR("B")="Yes"
SET DIR(0)="Y"
+1 DO ^DIR
KILL DIR
if $DATA(DIRUT)!('Y)
GOTO 1
+2 SET FBMST=$SELECT($PIECE(^FBAAA(DFN,1,FBD1,0),"^",13)=1:"Y",1:"")
+3 SET DIC="^FBAA(161.26,"
SET DIC(0)="L"
SET DLAYGO=161.26
SET X=DFN
+4 SET DR="1////^S X=""P"";2////^S X=FBD1;S Y=$S(FBMST="""":3,1:6);6////^S X=FBMST;3////^S X=FBMTYPE"
+5 ; for Change MRA (expect State Home) ask if From Date was changed
+6 IF FBMTYPE="C"
IF $PIECE($GET(^FBAAA(DFN,1,FBD1,0)),U,13)'=4
SET DR=DR_";5"
+7 SET DIE=DIC
KILL DD,DO
DO FILE^DICN
KILL DLAYGO
if Y<0
GOTO END
SET DA=+Y
+8 DO ^DIE
IF $DATA(Y)>0
SET DIK=DIE
DO ^DIK
WRITE !,*7,"MRA deleted.",!
GOTO 1
+9 WRITE !!,"Transaction Created!"
+10 IF FBMTYPE="D"
SET $PIECE(^FBAAA(DFN,1,FBD1,"ADEL"),"^",1,2)="Y^"_DT
+11 IF FBMTYPE="R"!(FBMTYPE="A")
if $DATA(^FBAAA(DFN,1,FBD1,"ADEL"))
SET ^("ADEL")=""
+12 GOTO 1
END KILL 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
+1 DO GETAUTHK^FBAAUTL1
+2 QUIT
