Changeset 623 for WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBCHREQ1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBCHREQ1.m
r613 r623 1 FBCHREQ1 ;AISC/DMK-FEE NOTIFICATION CONT ;31AUG90 2 ;;3.5;FEE BASIS;**103**;JAN 30, 1995;Build 19 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 VENDOR ;ASK VENDOR FOR NOTIFICATION 5 W ! K FBCHVEN S DIC="^FBAAV(",DIC(0)="AEQLM",DLAYGO=161.2 D ^DIC G END:X=""!(X="^"),VENDOR:Y<0 S (DA,FBCHVEN)=+Y,DIE=DIC I $P(Y,"^",3)=1 S FBVENEW=1 D NEW^FBAAVD K DIC,DIE,DA,DLAYGO Q 6 ASKVOK I '$D(FBVENEW) D EN1^FBAAVD S DIR(0)="Y",DIR("A")="Is this the correct vendor",DIR("B")="YES" D ^DIR K DIR G VENDOR:$D(DIRUT)!'Y 7 END K DIC,DIE,DLAYGO 8 Q 9 TIMCK ;72 hour time check called from FBAA ENTER REQUEST template 10 S X1=$P(^FBAA(162.2,DA,0),"^",1),X=$P(^(0),"^",19),HY=Y,FBSW="" 11 S Y=$E(X1_"000",9,10)-$E(X_"000",9,10)*60+$E(X1_"00000",11,12)-$E(X_"00000",11,12),X2=X,X=$P(X,".",1)'=$P(X1,".",1) D ^%DTC:X S FBX=X*1440+Y 12 SURE I FBX>4320 W *7,!!,"This Authorization From Date exceeds the 72 hour notification period. ",!,?8,"Do you want to continue ? No// " R X:DTIME S:X="" X="N" G HELP:X["^" D VALCK^FBAAUTL1 G SURE:'VAL I "Nn"[$E(X,1) S FBSW=1,Y=HY Q 13 S Y=HY Q 14 HELP W !,"Entering an '^' is not allowed. Please answer 'Yes' or 'No'." G SURE 15 EN I $D(DA),DA S FBDA(0)=DA,DIE="^FBAA(162.2,",DR=".01////@" D ^DIE 16 I '$D(DA) W *7,!?3,"...request deleted",! I $D(^FBAA(161.5,FBDA(0),0)) S DA=FBDA(0),DIK="^FBAA(161.5," D ^DIK 17 K DIC,DIE,DIK,DA,X,FBDA,DR,DLAYGO,FBDATE,FBLG,FBN,FBUP,FBVT,VA D END^FBCHREQ 18 Q 19 EDIT ;EDIT A REQUEST THAT'S NOT COMPLETE 20 S DIC("S")="I $P(^(0),U,15)'=3" D ASKV^FBCHREQ K DIC("S") G Q:X=""!(X="^") S DA=+Y,FB(0)=^FBAA(162.2,DA,0),FBDOA=$P(FB(0),"^",19),FBFRDT=$P(FB(0),"^",5) 21 ; fb*3.5*103 add REFERRING PROVIDER (162.2,17) to DR string 22 S DIE="^FBAA(162.2,",DR="1;2;3.5;S:X=FBDOA!(X<FBFRDT) Y=""@10"";S FBDOA=X;4////^S X=FBDOA;I 1;@10;4;5;17;I $G(X) W !,""REFERRING PROVIDER NPI: "",$$REFNPI^FBCH78(X);6;S FBCHVEN=X" D ^DIE S FBN(0)=^FBAA(162.2,DA,0) 23 I FB(0)'=FBN(0) S DR="7////^S X=DUZ" D ^DIE 24 I $D(DA),$D(^FBAA(161.5,DA,0)) D 25 .I FB(0)'=FBN(0) S $P(^FBAA(161.5,DA,0),"^",2)=$P(FBN(0),"^",2),$P(^(0),"^",5)=$P(FBN(0),"^",5),$P(^FBAA(161.5,DA,1),"^",7)=$P(FBN(0),"^",19),$P(^(1),U)=$P(FBN(0),U,6),DIK="^FBAA(161.5," D IX^DIK K DIK 26 .S FBREQED=1,DIC="^FBAA(161.5,",DIC(0)="AEQM" D EN^FBCHROC 27 Q K DIE,DIC,DIRUT,DUOUT,DTOUT,X,Y,DR,FB,FBN,FBDA,FBDFN,FBNAME,FBSSN,DA,FBCHVEN,FBREQED,FBDOA,FBFRDT,J 28 Q 29 DATCK ;Verify authorized from date is > or = date of admission. 30 S FBDOA=$P(^FBAA(162.2,DA,0),"^",19) I $G(FBDOA),X<FBDOA W !,*7,"Authorized From Date must be equal to or greater than the Date of Admission" S FBOUT=1 31 Q 1 FBCHREQ1 ;AISC/DMK-FEE NOTIFICATION CONT ;31AUG90 2 ;;3.5;FEE BASIS;;JAN 30, 1995 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 VENDOR ;ASK VENDOR FOR NOTIFICATION 5 W ! K FBCHVEN S DIC="^FBAAV(",DIC(0)="AEQLM",DLAYGO=161.2 D ^DIC G END:X=""!(X="^"),VENDOR:Y<0 S (DA,FBCHVEN)=+Y,DIE=DIC I $P(Y,"^",3)=1 S FBVENEW=1 D NEW^FBAAVD K DIC,DIE,DA,DLAYGO Q 6 ASKVOK I '$D(FBVENEW) D EN1^FBAAVD S DIR(0)="Y",DIR("A")="Is this the correct vendor",DIR("B")="YES" D ^DIR K DIR G VENDOR:$D(DIRUT)!'Y 7 END K DIC,DIE,DLAYGO 8 Q 9 TIMCK ;72 hour time check called from FBAA ENTER REQUEST template 10 S X1=$P(^FBAA(162.2,DA,0),"^",1),X=$P(^(0),"^",19),HY=Y,FBSW="" 11 S Y=$E(X1_"000",9,10)-$E(X_"000",9,10)*60+$E(X1_"00000",11,12)-$E(X_"00000",11,12),X2=X,X=$P(X,".",1)'=$P(X1,".",1) D ^%DTC:X S FBX=X*1440+Y 12 SURE I FBX>4320 W *7,!!,"This Authorization From Date exceeds the 72 hour notification period. ",!,?8,"Do you want to continue ? No// " R X:DTIME S:X="" X="N" G HELP:X["^" D VALCK^FBAAUTL1 G SURE:'VAL I "Nn"[$E(X,1) S FBSW=1,Y=HY Q 13 S Y=HY Q 14 HELP W !,"Entering an '^' is not allowed. Please answer 'Yes' or 'No'." G SURE 15 EN I $D(DA),DA S FBDA(0)=DA,DIE="^FBAA(162.2,",DR=".01////@" D ^DIE 16 I '$D(DA) W *7,!?3,"...request deleted",! I $D(^FBAA(161.5,FBDA(0),0)) S DA=FBDA(0),DIK="^FBAA(161.5," D ^DIK 17 K DIC,DIE,DIK,DA,X,FBDA,DR,DLAYGO,FBDATE,FBLG,FBN,FBUP,FBVT,VA D END^FBCHREQ 18 Q 19 EDIT ;EDIT A REQUEST THAT'S NOT COMPLETE 20 S DIC("S")="I $P(^(0),U,15)'=3" D ASKV^FBCHREQ K DIC("S") G Q:X=""!(X="^") S DA=+Y,FB(0)=^FBAA(162.2,DA,0),FBDOA=$P(FB(0),"^",19),FBFRDT=$P(FB(0),"^",5) 21 S DIE="^FBAA(162.2,",DR="1;2;3.5;S:X=FBDOA!(X<FBFRDT) Y=""@10"";S FBDOA=X;4////^S X=FBDOA;I 1;@10;4:6;S FBCHVEN=X" D ^DIE S FBN(0)=^FBAA(162.2,DA,0) 22 I FB(0)'=FBN(0) S DR="7////^S X=DUZ" D ^DIE 23 I $D(DA),$D(^FBAA(161.5,DA,0)) D 24 .I FB(0)'=FBN(0) S $P(^FBAA(161.5,DA,0),"^",2)=$P(FBN(0),"^",2),$P(^(0),"^",5)=$P(FBN(0),"^",5),$P(^FBAA(161.5,DA,1),"^",7)=$P(FBN(0),"^",19),$P(^(1),U)=$P(FBN(0),U,6),DIK="^FBAA(161.5," D IX^DIK K DIK 25 .S FBREQED=1,DIC="^FBAA(161.5,",DIC(0)="AEQM" D EN^FBCHROC 26 Q K DIE,DIC,DIRUT,DUOUT,DTOUT,X,Y,DR,FB,FBN,FBDA,FBDFN,FBNAME,FBSSN,DA,FBCHVEN,FBREQED,FBDOA,FBFRDT,J 27 Q 28 DATCK ;Verify authorized from date is > or = date of admission. 29 S FBDOA=$P(^FBAA(162.2,DA,0),"^",19) I $G(FBDOA),X<FBDOA W !,*7,"Authorized From Date must be equal to or greater than the Date of Admission" S FBOUT=1 30 Q
Note:
See TracChangeset
for help on using the changeset viewer.