source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBNHEDA1.m@ 1732

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1FBNHEDA1 ;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 ;
10UPDATE ;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 ;
25DEL ;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 ;
34CK ;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 ;
41GET 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
Note: See TracBrowser for help on using the repository browser.