| [613] | 1 | FBNHEDA1 ;AISC/DMK-EDIT CNH AUTHORIZATION CONT ;4/28/93 11:05
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | I FBO'=FBAA(1) D Q:FBERR
|
|---|
| 5 | .D CK I FBERR D
|
|---|
| 6 | ..S DA(1)=$G(DFN),DA=$G(FTP),DIE="^FBAAA("_DA(1)_",1,",DR=".01////^S X=FBO;.02////^S X=FB1" D ^DIE K DIE,DR
|
|---|
| 7 | .D DEL
|
|---|
| 8 | .D FILE^FBNHEAU2
|
|---|
| 9 | ;
|
|---|
| 10 | UPDATE ;called from edit authorization and FBNHED (enter discharge)
|
|---|
| 11 | I FBO=FBAA(1),FB1'=FBAA(2) D GET D
|
|---|
| 12 | .I FB1>FBAA(2) S (X,HOLDX)=$O(FBZ(FBAA(2)-.9)),X=$G(FBZ(+X)) I X D
|
|---|
| 13 | ..S DA=X,DIE="^FBAA(161.23,",DR=".02////^S X="_FBAA(2) D ^DIE K DIE,DR
|
|---|
| 14 | ..N FBI F FBI=HOLDX:0 S FBI=$O(FBZ(FBI)) Q:'FBI D
|
|---|
| 15 | ...S DA=FBZ(FBI),DIK="^FBAA(161.23," D ^DIK K DIK
|
|---|
| 16 | .I FBAA(2)>FB1 D
|
|---|
| 17 | ..S X=$O(^FBAA(161.23,"AD",FB7078,-(FB1+.9)))
|
|---|
| 18 | ..S (FBPAYDT,FBBEGDT)=$S(X>-FB1:$FN(X,"-"),1:FB1),(FBPAYDT,FBBEGDT)=$$CDTC^FBUCUTL(FBPAYDT,1),FBENDDT=FBAA(2) D Q:FBERR
|
|---|
| 19 | ...S X=+FBPAYDT D DAYS^FBAAUTL1 S FBDAYS=$S(X>(FBENDDT-FBBEGDT):(FBENDDT-FBBEGDT),1:X)
|
|---|
| 20 | ...S IFN=+$P(FBNEW,U,4) D GETRAT^FBNHEAU2 Q:$G(FBERR)
|
|---|
| 21 | ...D FILE^FBNHEAU2
|
|---|
| 22 | ;
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | DEL ;if from date of authorization is changed locate and delete
|
|---|
| 26 | ;current entries in CNH authorization rate file.
|
|---|
| 27 | ;FB7078 equal to internal entry number of 7078 for authorization
|
|---|
| 28 | I '$G(FB7078) S FBERR=1 Q
|
|---|
| 29 | N FBI S FBI=0
|
|---|
| 30 | F S FBI=$O(^FBAA(161.23,"AC",FB7078,FBI)) Q:'FBI I $D(^FBAA(161.23,FBI,0)) D
|
|---|
| 31 | .S DA=FBI,DIK="^FBAA(161.23," D ^DIK K DIK
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | CK ;check if vendor has sufficient contract data
|
|---|
| 35 | N X,X1,Y
|
|---|
| 36 | S IFN=$P(FBNEW,U,4)
|
|---|
| 37 | S (FBBEGDT,FBPAYDT)=FBAA(1),FBENDDT=FBAA(2),X=+FBAA(1) D DAYS^FBAAUTL1 S FBDAYS=$S(X>(FBENDDT-FBBEGDT):(FBENDDT-FBBEGDT),1:X)
|
|---|
| 38 | D GETRAT^FBNHEAU2
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | GET I '$G(FB7078) S FBERR=1 Q
|
|---|
| 42 | I '$D(^FBAA(161.23,"AC",FB7078)) S FBERR=1 Q
|
|---|
| 43 | S FBZ=0
|
|---|
| 44 | F S FBZ=$O(^FBAA(161.23,"AC",FB7078,FBZ)) Q:'FBZ I $D(^FBAA(161.23,FBZ,0)) S FBZ(0)=^(0) D
|
|---|
| 45 | .S FBZ($P(FBZ(0),U,2))=FBZ
|
|---|
| 46 | K FBZ(0) Q
|
|---|
