1 | FBUCDD ;ALBISC/TET - DD UTILITY ROUTINE ;5/27/93 19:28
|
---|
2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | INPUT(DA,X,Y,FBZZ) ;input transform of status field, file 162.7
|
---|
5 | ;INPUT: X and Y - FM variables
|
---|
6 | ; DA - internal entry number of 162.7, Unauthorized Claims
|
---|
7 | ; FBZZ - set in input transform, identifies the field in 162.7
|
---|
8 | ;OUTPUT: 1 if x should be killed, otherwise 0.
|
---|
9 | N FBZ S FBZ=$G(^FB583(DA,0))
|
---|
10 | 23 ;If FBZZ=23 - CLAIM SUBMITTED BY
|
---|
11 | ;ensure that if vendor or veteran entered, same as vendor or veteran field
|
---|
12 | I FBZZ=23 Q $S(X["FBAAV"&(+X'=$P(FBZ,U,3)):1,X["DPT"&(+X'=$P(FBZ,U,4)):1,1:0)
|
---|
13 | 24 ;IF FBZZ=24 - STATUS
|
---|
14 | ;if y<0 k x
|
---|
15 | ;if dispositioned, status can only be dispositioned (and converse).
|
---|
16 | ;if not dispositioned, valid claim received, cannot select status
|
---|
17 | ; which indicates incomplete claim (and converse).
|
---|
18 | I FBZZ=24 N O S O=$$ORDER^FBUCUTL(X) Q $S(Y<0:1,"^40^70^90^"[O&('$P(FBZ,U,11)):1,"^40^70^90^"'[O&($P(FBZ,U,11)):1,$P(FBZ,U,8)&(O'>20):1,'$P(FBZ,U,8)&(O>20):1,1:0)
|
---|
19 | 10 ;IF FBZZ=10 - DISPOSITION
|
---|
20 | ;dispositon to cancelled/withdrawn or abandoned if date valid claim received is null,
|
---|
21 | ; k x if disposition is other than approved(1) or approved to stabilization(4)
|
---|
22 | ; and not ok to updated (payments were made and user doesn't hold key)
|
---|
23 | ;otherwise can select any disposition.
|
---|
24 | I FBZZ=10 Q $S(Y<0:1,'(X=3!(X=5))&('$P(FBZ,U,8)):1,((X=2)!(X=3)!(X=5))&('$$UPOK^FBUCUTL(DA)):1,1:0)
|
---|
25 | 7 ;IF FBZZ=7 - DATE VALID CLAIM RECEIVED
|
---|
26 | ;claim is considered valid when all pending information is received.
|
---|
27 | I FBZZ=7 Q $S(Y<1:1,$$PEND^FBUCUTL(DA):1,1:0)
|
---|
28 | 4 ;IF FBZZ=4 - TREATMENT TO DATE
|
---|
29 | ;if y<1 k x
|
---|
30 | ;if treatment to date is before treatment from date, k x
|
---|
31 | I FBZZ=4 Q $S(Y<1:1,$P(FBZ,U,5)>X:1,1:0)
|
---|
32 | 12 ;IF FBZZ=12 - AUTHORIZED FROM DATE
|
---|
33 | ;if y<1 k x
|
---|
34 | ;if authorized from date is before treatment from date, k x
|
---|
35 | ;if authorized from date is after treatment to date, k x
|
---|
36 | I FBZZ=12 Q $S(Y<1:1,$P(FBZ,U,5)>X:1,X>$P(FBZ,U,6):1,1:0)
|
---|
37 | 13 ;IF FBZZ=14 - AUTHORIZED TO DATE
|
---|
38 | ;if y<1 k x
|
---|
39 | ;if authorized to date is before authorized from date, k x
|
---|
40 | ;if authorized to date is after treatment to date, k x
|
---|
41 | I FBZZ=13 Q $S(Y<1:1,$P(FBZ,U,13)>X:1,X>$P(FBZ,U,6):1,1:0)
|
---|
42 | Q
|
---|
43 | DISCHTYP(DA) ;discharge type - computed field expression from field 29 of 162.7
|
---|
44 | ;INPUT: DA = ien
|
---|
45 | ;OUTPUT: long value of discharge type for file 161.01,.06
|
---|
46 | N FBZ,FBIEN
|
---|
47 | I '+$G(DA) Q ""
|
---|
48 | S FBZ=$$FBZ^FBUCUTL(DA),FBIEN=+$O(^FBAAA("AG",DA_";FB583(",+$P(FBZ,U,4),0)) I 'FBIEN Q ""
|
---|
49 | S FBZ=$$PTR^FBUCUTL("^FBAAA("_+$P(FBZ,U,4)_",1,",FBIEN),FBIEN=$P(FBZ,U,15)
|
---|
50 | Q $S('FBIEN:"",FBIEN=4:"DISCHARGE",FBIEN=3:"DEATH WITHOUT AUTOPSY",FBIEN=2:"DEATH WITH AUTOPSY",1:"TRANSFER TO VA")
|
---|
51 | ;
|
---|
52 | MSIX(X,DA,FLD,ACT,FBIX) ;cross-reference on either vendor/veteran/other,master claim,status order
|
---|
53 | ;INPUT: X = value edited
|
---|
54 | ; DA = internal entry number of record
|
---|
55 | ; FLD = field edited
|
---|
56 | ; ACT = action: 1 for set; 2 for kill
|
---|
57 | ; FBIX = cross-ref to be set, either APMS, AVMS or AOMS
|
---|
58 | ;VAR: FBZ = zero node and value of first subscript of cross-ref
|
---|
59 | ; FBZ(1) = master claim designation
|
---|
60 | ; FBZ(2) = status order
|
---|
61 | ;OUTPUT: set or kill cross-reference, depending upon the action
|
---|
62 | I $S('+$G(X):1,'+$G(DA):1,'+$G(FLD):1,'+$G(ACT):1,$G(FBIX)']"":1,1:0) Q
|
---|
63 | I $S(FBIX="APMS":0,FBIX="AVMS":0,FBIX="AOMS":0,1:1) Q
|
---|
64 | N FBZ S FBZ=$$FBZ^FBUCUTL(DA) I FBIX="AOMS",$P(FBZ,U,23)'["VA(200" Q
|
---|
65 | S FBZ(1)=$S(FLD=20:X,1:+$P(FBZ,U,20)) Q:'FBZ(1) S FBZ(1)=FBZ(1)_$S(DA=FBZ(1):"P",1:"S")
|
---|
66 | S FBZ(2)=$$ORDER^FBUCUTL($S(FLD=24:X,1:+$P(FBZ,U,24))) Q:'FBZ(2)
|
---|
67 | S FBZ=$S(FLD'=20&(FLD'=24):+X,FBIX="APMS":+$P(FBZ,U,4),FBIX="AVMS":+$P(FBZ,U,3),1:+$P(FBZ,U,23)) Q:'FBZ
|
---|
68 | I ACT=1 S ^FB583(FBIX,FBZ,FBZ(1),FBZ(2),DA)="" Q
|
---|
69 | I ACT=2 K ^FB583(FBIX,FBZ,FBZ(1),FBZ(2),DA)
|
---|
70 | Q
|
---|