Changeset 623 for WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBCTAU1.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBCTAU1.m (modified) (2 diffs)

WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBCTAU1.m

@@ -1 @@
-FBCTAU1 ; ;11/08/09
+FBCTAU1 ; ;06/28/03
  D DE G BEGIN
 DE S DIE="^FBAAA(D0,1,",DIC=DIE,DP=161.01,DL=2,DIEL=1,DU="" K DG,DE,DB Q:$O(^FBAAA(D0,1,DA,""))=""
- I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,1) S:%]"" DE(4)=%,DE(8)=% S %=$P(%Z,U,2) S:%]"" DE(14)=% S %=$P(%Z,U,3) S:%]"" DE(16)=% S %=$P(%Z,U,5) S:%]"" DE(18)=% S %=$P(%Z,U,7) S:%]"" DE(22)=% S %=$P(%Z,U,13) S:%]"" DE(30)=%
- I  S %=$P(%Z,U,18) S:%]"" DE(29)=% S %=$P(%Z,U,21) S:%]"" DE(19)=%
+ I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,1) S:%]"" DE(4)=%,DE(8)=% S %=$P(%Z,U,2) S:%]"" DE(14)=% S %=$P(%Z,U,3) S:%]"" DE(16)=% S %=$P(%Z,U,5) S:%]"" DE(18)=% S %=$P(%Z,U,7) S:%]"" DE(20)=%
  K %Z Q
  ;
@@ -171 +170 @@
  G RE
 X18 Q
-19 S DW="0;21",DV="*P200'",DU="",DLB="REFERRING PROVIDER",DIFLD=104
- S DU="VA(200,"
+19 S DQ=20 ;@4
+20 S DW="0;7",DV="R*P161.82'",DU="",DLB="PURPOSE OF VISIT CODE",DIFLD=.07
+ S DU="FBAA(161.82,"
  G RE
-X19 S DIC("S")="I $$PROVIDER^FBAAAUT(+Y)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X
+X20 S DIC("S")="I $S('$G(^(""I"")):1,DT'>^(""I""):1,1:0),$S('$D(FBTYPE):1,$P(^(0),U,2)=FBTYPE:1,1:0)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X
  Q
  ;
-20 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=20 D X20 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X20 I $G(X) W !,"REFERRING PROVIDER NPI: ",$$REFNPI^FBCH78(X)
+21 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=21 D X21 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X21 S:$$EXTPV^FBAAUTL5(X)'=55 Y="@5"
  Q
-21 S DQ=22 ;@4
-22 S DW="0;7",DV="R*P161.82'",DU="",DLB="PURPOSE OF VISIT CODE",DIFLD=.07
- S DU="FBAA(161.82,"
- G RE
-X22 S DIC("S")="I $S('$G(^(""I"")):1,DT'>^(""I""):1,1:0),$S('$D(FBTYPE):1,$P(^(0),U,2)=FBTYPE:1,1:0)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X
+22 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=22 D X22 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X22 S:$P($$GETSTAT^DGMSTAPI(DA(1)),U,2)="Y" Y="@5"
  Q
- ;
 23 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=23 D X23 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X23 S:$$EXTPV^FBAAUTL5(X)'=55 Y="@5"
+X23 S DIE("NO^")=""
  Q
 24 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=24 D X24 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X24 S:$P($$GETSTAT^DGMSTAPI(DA(1)),U,2)="Y" Y="@5"
+X24 W !,$C(7),"MST POV can't be selected because veteran's MST status is not YES."
  Q
 25 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=25 D X25 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X25 S DIE("NO^")=""
+X25 S Y="@4"
  Q
-26 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=26 D X26 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X26 W !,$C(7),"MST POV can't be selected because veteran's MST status is not YES."
- Q
-27 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=27 D X27 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X27 S Y="@4"
- Q
-28 S DQ=29 ;@5
-29 S DW="0;18",DV="S",DU="",DLB="PATIENT TYPE CODE",DIFLD=.065
- S DU="00:SURGICAL;10:MEDICAL;60:HOME NURSING SERVICE;85:PSYCHIATRIC-CONTRACT;86:PSYCHIATRIC;95:NEUROLOGICAL-CONTRACT;96:NEUROLOGICAL;"
- G RE
-X29 Q
-30 S DW="0;13",DV="R*S",DU="",DLB="TREATMENT TYPE CODE",DIFLD=.095
- S DE(DW)="C30^FBCTAU1"
- S DU="1:SHORT TERM FEE STATUS;2:HOME NURSING SERVICES;3:I.D. CARD STATUS;4:STATE HOME;"
- G RE
-C30 G C30S:$D(DE(30))[0 K DB
- S X=DE(30),DIC=DIE
- ;
-C30S S X="" G:DG(DQ)=X C30F1 K DB
- D ^FBCTAU2
-C30F1 Q
-X30 Q
-31 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=31 D X31 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X31 S FBAATT=X
- Q
-32 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=32 D X32 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X32 S FBAALT=$S(X=2:"Y",X=3:"Y",1:"")
- Q
-33 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=33 D X33 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X33 K DIE("NO^")
- Q
-34 D:$D(DG)>9 F^DIE17 G ^FBCTAU3
+26 S DQ=27 ;@5
+27 D:$D(DG)>9 F^DIE17 G ^FBCTAU2