- FBCHREQ1 ;AISC/DMK - FEE NOTIFICATION CONT ;1/20/2015
- ;;3.5;FEE BASIS;**103,146,154**;JAN 30, 1995;Build 12
- ;;Per VA Directive 6402, this routine should not be modified.
- VENDOR ;ASK VENDOR FOR NOTIFICATION
- 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
- 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
- END K DIC,DIE,DLAYGO
- Q
- TIMCK ;72 hour time check called from FBAA ENTER REQUEST template
- S X1=$P(^FBAA(162.2,DA,0),"^",1),X=$P(^(0),"^",19),HY=Y,FBSW=""
- 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
- 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
- S Y=HY Q
- HELP W !,"Entering an '^' is not allowed. Please answer 'Yes' or 'No'." G SURE
- EN I $D(DA),DA S FBDA(0)=DA,DIE="^FBAA(162.2,",DIDEL=162.2,DR=".01////@" D ^DIE K DIDEL
- 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
- K DIC,DIE,DIK,DA,X,FBDA,DR,DLAYGO,FBDATE,FBLG,FBN,FBUP,FBVT,VA D END^FBCHREQ
- Q
- EDIT ;EDIT A REQUEST THAT'S NOT COMPLETE
- 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)
- S FB(1)=$G(^FBAA(162.2,DA,1))
- ; fb*3.5*103 add REFERRING PROVIDER (162.2,17) to DR string
- 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)
- S FBN(1)=$G(^FBAA(162.2,DA,1))
- I FB(0)'=FBN(0)!(FB(1)'=FBN(1)) D
- . S DR="7////^S X=DUZ" D ^DIE
- . N FBX
- . S FBX=$$ADDUA^FBUTL9(162.2,DA_",","Edit CH notification.")
- . I 'FBX W !,"Error adding record in User Audit. Please contact IRM."
- I $D(DA),$D(^FBAA(161.5,DA,0)) D
- .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
- .S FBREQED=1,DIC="^FBAA(161.5,",DIC(0)="AEQM" D EN^FBCHROC
- Q K DIE,DIC,DIRUT,DUOUT,DTOUT,X,Y,DR,FB,FBN,FBDA,FBDFN,FBNAME,FBSSN,DA,FBCHVEN,FBREQED,FBDOA,FBFRDT,J
- Q
- DATCK ;Verify authorized from date is > or = date of admission.
- I '$D(DFN) I $D(FBDFN) S DFN=FBDFN
- I '$D(DFN) I $D(FBVET) S DFN=FBVET
- 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
- S FBDOB=$P(^DPT(DFN,0),"^",3) I $G(FBDOB),X<FBDOB W !,*7,"Authorized From Date cannot be before the Date of Birth" S FBOUT=1
- ; Check if this is a Newborn. If Newborn Authorization date can not be after DOB+7
- N ENTDATE,NOW
- S ENTDATE=X
- N X
- D NOW^%DTC S NOW=X,X=ENTDATE
- I $$FMDIFF^XLFDT(NOW,FBDOB,1)<365 D ;PATIENT IS A NEWBORN
- . I $$FMDIFF^XLFDT(X,FBDOB,1)>7 W !,*7,"Authorized From Date for a Newborn cannot be after DOB+7" S FBOUT=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBCHREQ1 3355 printed Mar 13, 2025@21:02:47 Page 2
- FBCHREQ1 ;AISC/DMK - FEE NOTIFICATION CONT ;1/20/2015
- +1 ;;3.5;FEE BASIS;**103,146,154**;JAN 30, 1995;Build 12
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- VENDOR ;ASK VENDOR FOR NOTIFICATION
- +1 WRITE !
- KILL FBCHVEN
- SET DIC="^FBAAV("
- SET DIC(0)="AEQLM"
- SET DLAYGO=161.2
- DO ^DIC
- if X=""!(X="^")
- GOTO END
- if Y<0
- GOTO VENDOR
- SET (DA,FBCHVEN)=+Y
- SET DIE=DIC
- IF $PIECE(Y,"^",3)=1
- SET FBVENEW=1
- DO NEW^FBAAVD
- KILL DIC,DIE,DA,DLAYGO
- QUIT
- ASKVOK IF '$DATA(FBVENEW)
- DO EN1^FBAAVD
- SET DIR(0)="Y"
- SET DIR("A")="Is this the correct vendor"
- SET DIR("B")="YES"
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)!'Y
- GOTO VENDOR
- END KILL DIC,DIE,DLAYGO
- +1 QUIT
- TIMCK ;72 hour time check called from FBAA ENTER REQUEST template
- +1 SET X1=$PIECE(^FBAA(162.2,DA,0),"^",1)
- SET X=$PIECE(^(0),"^",19)
- SET HY=Y
- SET FBSW=""
- +2 SET Y=$EXTRACT(X1_"000",9,10)-$EXTRACT(X_"000",9,10)*60+$EXTRACT(X1_"00000",11,12)-$EXTRACT(X_"00000",11,12)
- SET X2=X
- SET X=$PIECE(X,".",1)'=$PIECE(X1,".",1)
- if X
- DO ^%DTC
- SET FBX=X*1440+Y
- SURE IF FBX>4320
- WRITE *7,!!,"This Authorization From Date exceeds the 72 hour notification period. ",!,?8,"Do you want to continue ? No// "
- READ X:DTIME
- if X=""
- SET X="N"
- if X["^"
- GOTO HELP
- DO VALCK^FBAAUTL1
- if 'VAL
- GOTO SURE
- IF "Nn"[$EXTRACT(X,1)
- SET FBSW=1
- SET Y=HY
- QUIT
- +1 SET Y=HY
- QUIT
- HELP WRITE !,"Entering an '^' is not allowed. Please answer 'Yes' or 'No'."
- GOTO SURE
- EN IF $DATA(DA)
- IF DA
- SET FBDA(0)=DA
- SET DIE="^FBAA(162.2,"
- SET DIDEL=162.2
- SET DR=".01////@"
- DO ^DIE
- KILL DIDEL
- +1 IF '$DATA(DA)
- WRITE *7,!?3,"...request deleted",!
- IF $DATA(^FBAA(161.5,FBDA(0),0))
- SET DA=FBDA(0)
- SET DIK="^FBAA(161.5,"
- DO ^DIK
- +2 KILL DIC,DIE,DIK,DA,X,FBDA,DR,DLAYGO,FBDATE,FBLG,FBN,FBUP,FBVT,VA
- DO END^FBCHREQ
- +3 QUIT
- EDIT ;EDIT A REQUEST THAT'S NOT COMPLETE
- +1 SET DIC("S")="I $P(^(0),U,15)'=3"
- DO ASKV^FBCHREQ
- KILL DIC("S")
- if X=""!(X="^")
- GOTO Q
- SET DA=+Y
- SET FB(0)=^FBAA(162.2,DA,0)
- SET FBDOA=$PIECE(FB(0),"^",19)
- SET FBFRDT=$PIECE(FB(0),"^",5)
- +2 SET FB(1)=$GET(^FBAA(162.2,DA,1))
- +3 ; fb*3.5*103 add REFERRING PROVIDER (162.2,17) to DR string
- +4 SET DIE="^FBAA(162.2,"
- SET 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"
- DO ^DIE
- SET FBN(0)=^FBAA(162.2,DA,0)
- +5 SET FBN(1)=$GET(^FBAA(162.2,DA,1))
- +6 IF FB(0)'=FBN(0)!(FB(1)'=FBN(1))
- Begin DoDot:1
- +7 SET DR="7////^S X=DUZ"
- DO ^DIE
- +8 NEW FBX
- +9 SET FBX=$$ADDUA^FBUTL9(162.2,DA_",","Edit CH notification.")
- +10 IF 'FBX
- WRITE !,"Error adding record in User Audit. Please contact IRM."
- End DoDot:1
- +11 IF $DATA(DA)
- IF $DATA(^FBAA(161.5,DA,0))
- Begin DoDot:1
- +12 IF FB(0)'=FBN(0)
- SET $PIECE(^FBAA(161.5,DA,0),"^",2)=$PIECE(FBN(0),"^",2)
- SET $PIECE(^(0),"^",5)=$PIECE(FBN(0),"^",5)
- SET $PIECE(^FBAA(161.5,DA,1),"^",7)=$PIECE(FBN(0),"^",19)
- SET $PIECE(^(1),U)=$PIECE(FBN(0),U,6)
- SET DIK="^FBAA(161.5,"
- DO IX^DIK
- KILL DIK
- +13 SET FBREQED=1
- SET DIC="^FBAA(161.5,"
- SET DIC(0)="AEQM"
- DO EN^FBCHROC
- End DoDot:1
- Q KILL DIE,DIC,DIRUT,DUOUT,DTOUT,X,Y,DR,FB,FBN,FBDA,FBDFN,FBNAME,FBSSN,DA,FBCHVEN,FBREQED,FBDOA,FBFRDT,J
- +1 QUIT
- DATCK ;Verify authorized from date is > or = date of admission.
- +1 IF '$DATA(DFN)
- IF $DATA(FBDFN)
- SET DFN=FBDFN
- +2 IF '$DATA(DFN)
- IF $DATA(FBVET)
- SET DFN=FBVET
- +3 SET FBDOA=$PIECE(^FBAA(162.2,DA,0),"^",19)
- IF $GET(FBDOA)
- IF X<FBDOA
- WRITE !,*7,"Authorized From Date must be equal to or greater than the Date of Admission"
- SET FBOUT=1
- +4 SET FBDOB=$PIECE(^DPT(DFN,0),"^",3)
- IF $GET(FBDOB)
- IF X<FBDOB
- WRITE !,*7,"Authorized From Date cannot be before the Date of Birth"
- SET FBOUT=1
- +5 ; Check if this is a Newborn. If Newborn Authorization date can not be after DOB+7
- +6 NEW ENTDATE,NOW
- +7 SET ENTDATE=X
- +8 NEW X
- +9 DO NOW^%DTC
- SET NOW=X
- SET X=ENTDATE
- +10 ;PATIENT IS A NEWBORN
- IF $$FMDIFF^XLFDT(NOW,FBDOB,1)<365
- Begin DoDot:1
- +11 IF $$FMDIFF^XLFDT(X,FBDOB,1)>7
- WRITE !,*7,"Authorized From Date for a Newborn cannot be after DOB+7"
- SET FBOUT=1
- End DoDot:1
- +12 QUIT
