FBUCUTL ;ALBISC/TET - UNAUTHORIZED CLAIMS UTILITY ;12/7/2001
;;3.5;FEE BASIS;**38**;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
CDTC(X1,X2) ;date comparison
;INPUT: X1 = date
; X2 = days to subtract or add
;OUTPUT: date less/plus x days
N X D C^%DTC K %H Q $G(X)
;
DTC(X1,X2) ;days between two days
;INPUT: X1 = date one
; X2 = date two
;OUTPUT: difference between two days
N X,%Y D ^%DTC K %Y Q $G(X)
;
VET(X) ;veteran name
;INPUT: internal entry number of veteran
;OUTPUT: veteran name or unknown
S X=$G(^DPT(+X,0)) Q $S($P(X,U)]"":$P(X,U),1:"UNKNOWN")
;
VEN(X) ;vendor name
;INPUT: internal entry number of vendor
;OUTPUT: vendor name or unknown
S X=$G(^FBAAV(+X,0)) Q $S($P(X,U)]"":$P(X,U),1:"UNKNOWN")
;
PROG(X) ;fee program name
;INPUT: internal entry number of fee program
;OUTPUT: fee program name or unknown
S X=$G(^FBAA(161.8,+X,0)) Q $S($P(X,U)]"":$P(X,U),1:"UNKNOWN")
;
PTR(FBGL,FBIEN) ;get .01 value of pointer
;INPUT: FBGL = global root
; FBIEN = internal entry number (DA) of pointed to file
;OUTPUT: zero node, or 'UNKNOWN'
N FBVAL,NODE S NODE=FBGL_+FBIEN_",0)"
S FBVAL=$G(@(NODE))
Q $S(FBVAL]"":FBVAL,1:"UNKNOWN")
;
LOCK(FBGL,FBDA,GO) ;lock entry before editing
;INPUT: FBGL = global root
; FBDA = interal entry number of file
; GO = 1 to continue to try (enter/updates),
; 0 to notify user and quit on failure (edits)
; (optional, if not set will be set to 0)
;OUTPUT: FBLOCK = 1 if successful; 0 if failed
; incremental lock may be issued
S FBLOCK=0,GO=$S('$D(GO):0,1:+GO) I $S('$D(FBGL):1,FBGL']"":1,'$D(FBDA):1,'+FBDA:1,1:0) Q
S FBGL=FBGL_FBDA_")"
L L +@FBGL:2 S FBLOCK=$T I 'FBLOCK G:GO L W:'GO&('$D(ZTQUEUED)) !,"Another user is editing this entry."
Q
DAYS(X,FB1725) ;number of days associated with a status
;INPUT: X=ien of status in file 162.92
; FB1725=true if days for 38 U.S.C. 1725 claim should be returned
;OUTPUT: 0 or number of days
N FBY
S FBY=$G(^FB(162.92,X,0))
Q $S($G(FB1725):+$P(FBY,U,7),1:+$P(FBY,U,3))
;
DISAP(DA1,X) ;disapproval reason for disapproved dispositions
;INPUT: DA1 = DA of top level of record (DA(1))
; X = ien of disapproval reason, 162.94
;OUTPUT: none - entry to disapproval multiple if not already there, disapproval reason is active and disposition reason is other than approved.
N Y,DA,DIC
S DIC(0)="Z",DIC="^FB583("_DA1_",""D"","
I $P(^FB583(DA1,0),U,11)>1,$P(^FB(162.94,+X,0),U,2),'$D(^FB583(DA1,"D","B",+X)) S:'$D(^FB583(DA1,"D")) ^FB583(DA1,"D",0)="^162.715PA^^" S DA(1)=DA1 K DD,DO D FILE^DICN
Q
STATUS(X) ;get status internal entry number
;INPUT: X = order number of status in file 162.92
;OUTPUT: ien of status in file 162.92 (status file)
Q +$O(^FB(162.92,"AO",X,0))
;
ORDER(X) ;get order number of status
;INPUT: X = ien of status in file 162.92, status file
;OUTPUT: order number of status
S X=$G(^FB(162.92,+X,0)) Q +$P(X,U,4)
;
PAY(X,FBGL) ;determine if any payments have been made
;INPUT: X= ien in file
; FBGL= global root
;OUTPUT: 0 if no payments, 1 if payments
S:$E(FBGL,1)="^" FBGL=$P(FBGL,"^",2) S FBGL=X_";"_FBGL
Q $S(+$O(^FBAA(162.1,"AO",FBGL,0)):1,+$O(^FBAAC("AM",FBGL,0)):1,+$O(^FBAAI("E",FBGL,0)):1,1:0)
;
OVER(KEY) ;determine if ability to override
;INPUT: KEY=security key
;OUTPUT: 0 if not holder of key, 1 if holder of key
Q $S($D(^XUSEC(KEY,DUZ)):1,1:0)
;
UPOK(X) ;ok to update
;INPUT: X= ien of 162.7
;OUTPUT: 0 if NOT OK to update, 1 if OK to update
Q $S('$$PAY(X,"^FB583("):1,$$OVER("FBAASUPERVISOR"):1,1:0)
;
TIME(ED) ;determine if expiration date passed
;INPUT: ED= expiration date
;OUTPUT: 0 if late, 1 if within timeframe
Q $S('ED:1,DT>ED:0,1:1)
UNTIME(FBX) ;write untimely message - called from input templates
;INPUT: FBX = disapproval reason
W !?5,"Claim has been dispositioned to DISAPPROVED" W:+FBX !?8,"with disapproval reason of '",$P($$PTR("^FB(162.94,",FBX),U),"'.",!,*7
Q
;
FBZ(X) ;get zero node on 162.7
;INPUT: X = ien of 162.7, unauthorized claim file
;OUTPUT: zero node of 162.7
I '+X Q 0
S X=+X Q $G(^FB583(X,0))
;
FILE(FBGL,X,FBDI,FBDA1) ;add entry to file or subfile
;INPUT: FBGL = global root
; X = value for .01 field
; FBDI = 1 for dinum entry, 0 or null if not (optional)
; FBDA1 = DA(1) value (optional), if doesn't exist will not set
;OUTPUT: entry is added to designated file
; Y is returned ien^value of .01 field^1
N DA,DIC,DINUM,Y I $S(X']"":1,'$D(FBDI):1,+FBDI&(X'=+X):1,'$D(FBDA):1,1:0) Q ""
I $D(FBDA1) S DA(1)=FBDA1
ADD S:+FBDI DINUM=X S DIC(0)="MZ",DIC=FBGL K DD,DO D FILE^DICN G:+Y'>0 ADD K DIC,DINUM
Q $G(Y)
;
PEND(FBDA) ;check if any info pending for claim
;INPUT: FBDA = ien of unauthorized claim in 162.7
;OUTPUT: 1 if info pending, otherwise 0
Q $S(+$O(^FBAA(162.8,"ACD",FBDA,0)):1,1:0)
PAYST(FBDA,FBUCP) ; unauthorized claim payment status (released+)
;INPUT: FBDA = ien of unauthorized claim in 162.7
; FBUCP = name of array (optional)
;RESULT: 1 (true) if at least one payment and all have been released
; 0 (false) if no payments or if some have not been released
;OUTPUT: if FBCUP contains the name of an array then that array will
; be populated with payment information in the following format
; array (claim ien) = result ^ number of payments
; array (claim ien, payment file #, payment iens) = batch status
N FBGL,FBRET,FBPDA,FBPDA1,FBPDA2,FBPDA3,FBBS,FBC
S FBRET=1
S FBC=0
I $G(FBUCP)]"" K FBCUP(FBDA)
S FBGL=FBDA_";FB583("
; pharmacy payments
S FBPDA=0
F S FBPDA=$O(^FBAA(162.1,"AO",FBGL,FBPDA)) Q:'FBPDA D
.S FBPDA1=0
.F S FBPDA1=$O(^FBAA(162.1,"AO",FBGL,FBPDA,FBPDA1)) Q:'FBPDA1 D
..S FBIENS=FBPDA1_","_FBPDA_","
..S FBBS=$$GET1^DIQ(162.11,FBIENS,"13:11","I")
..I $G(FBUCP)]"" S @FBUCP@(FBDA,162.11,FBIENS)=FBBS
..I "^S^T^V^R^"'[(U_FBBS_U) S FBRET=0
..S FBC=FBC+1
; outpatient and ancillary payments
S FBPDA=0
F S FBPDA=$O(^FBAAC("AM",FBGL,FBPDA)) Q:'FBPDA D
.S FBPDA1=0
.F S FBPDA1=$O(^FBAAC("AM",FBGL,FBPDA,FBPDA1)) Q:'FBPDA1 D
..S FBPDA2=0
..F S FBPDA2=$O(^FBAAC("AM",FBGL,FBPDA,FBPDA1,FBPDA2)) Q:'FBPDA2 D
...S FBPDA3=0
...F S FBPDA3=$O(^FBAAC("AM",FBGL,FBPDA,FBPDA1,FBPDA2,FBPDA3)) Q:'FBPDA3 D
....S FBIENS=FBPDA3_","_FBPDA2_","_FBPDA1_","_FBPDA_","
....S FBBS=$$GET1^DIQ(162.03,FBIENS,"7:11","I")
....I $G(FBUCP)]"" S @FBUCP@(FBDA,162.03,FBIENS)=FBBS
....I "^S^T^V^R^"'[(U_FBBS_U) S FBRET=0
....S FBC=FBC+1
; civil hospital payments
S FBPDA=0
F S FBPDA=$O(^FBAAI("E",FBGL,FBPDA)) Q:'FBPDA D
.S FBIENS=FBPDA_","
.S FBBS=$$GET1^DIQ(162.5,FBIENS,"20:11","I")
.I $G(FBUCP)]"" S @FBUCP@(FBDA,162.5,FBIENS)=FBBS
.I "^S^T^V^R^"'[(U_FBBS_U) S FBRET=0
.S FBC=FBC+1
I FBC=0 S FBRET=0
I $G(FBUCP)]"" S @FBUCP@(FBDA)=FBRET_U_FBC
Q FBRET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCUTL 7026 printed Oct 16, 2024@18:01:19 Page 2
FBUCUTL ;ALBISC/TET - UNAUTHORIZED CLAIMS UTILITY ;12/7/2001
+1 ;;3.5;FEE BASIS;**38**;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
CDTC(X1,X2) ;date comparison
+1 ;INPUT: X1 = date
+2 ; X2 = days to subtract or add
+3 ;OUTPUT: date less/plus x days
+4 NEW X
DO C^%DTC
KILL %H
QUIT $GET(X)
+5 ;
DTC(X1,X2) ;days between two days
+1 ;INPUT: X1 = date one
+2 ; X2 = date two
+3 ;OUTPUT: difference between two days
+4 NEW X,%Y
DO ^%DTC
KILL %Y
QUIT $GET(X)
+5 ;
VET(X) ;veteran name
+1 ;INPUT: internal entry number of veteran
+2 ;OUTPUT: veteran name or unknown
+3 SET X=$GET(^DPT(+X,0))
QUIT $SELECT($PIECE(X,U)]"":$PIECE(X,U),1:"UNKNOWN")
+4 ;
VEN(X) ;vendor name
+1 ;INPUT: internal entry number of vendor
+2 ;OUTPUT: vendor name or unknown
+3 SET X=$GET(^FBAAV(+X,0))
QUIT $SELECT($PIECE(X,U)]"":$PIECE(X,U),1:"UNKNOWN")
+4 ;
PROG(X) ;fee program name
+1 ;INPUT: internal entry number of fee program
+2 ;OUTPUT: fee program name or unknown
+3 SET X=$GET(^FBAA(161.8,+X,0))
QUIT $SELECT($PIECE(X,U)]"":$PIECE(X,U),1:"UNKNOWN")
+4 ;
PTR(FBGL,FBIEN) ;get .01 value of pointer
+1 ;INPUT: FBGL = global root
+2 ; FBIEN = internal entry number (DA) of pointed to file
+3 ;OUTPUT: zero node, or 'UNKNOWN'
+4 NEW FBVAL,NODE
SET NODE=FBGL_+FBIEN_",0)"
+5 SET FBVAL=$GET(@(NODE))
+6 QUIT $SELECT(FBVAL]"":FBVAL,1:"UNKNOWN")
+7 ;
LOCK(FBGL,FBDA,GO) ;lock entry before editing
+1 ;INPUT: FBGL = global root
+2 ; FBDA = interal entry number of file
+3 ; GO = 1 to continue to try (enter/updates),
+4 ; 0 to notify user and quit on failure (edits)
+5 ; (optional, if not set will be set to 0)
+6 ;OUTPUT: FBLOCK = 1 if successful; 0 if failed
+7 ; incremental lock may be issued
+8 SET FBLOCK=0
SET GO=$SELECT('$DATA(GO):0,1:+GO)
IF $SELECT('$DATA(FBGL):1,FBGL']"":1,'$DATA(FBDA):1,'+FBDA:1,1:0)
QUIT
+9 SET FBGL=FBGL_FBDA_")"
L LOCK +@FBGL:2
SET FBLOCK=$TEST
IF 'FBLOCK
if GO
GOTO L
if 'GO&('$DATA(ZTQUEUED))
WRITE !,"Another user is editing this entry."
+1 QUIT
DAYS(X,FB1725) ;number of days associated with a status
+1 ;INPUT: X=ien of status in file 162.92
+2 ; FB1725=true if days for 38 U.S.C. 1725 claim should be returned
+3 ;OUTPUT: 0 or number of days
+4 NEW FBY
+5 SET FBY=$GET(^FB(162.92,X,0))
+6 QUIT $SELECT($GET(FB1725):+$PIECE(FBY,U,7),1:+$PIECE(FBY,U,3))
+7 ;
DISAP(DA1,X) ;disapproval reason for disapproved dispositions
+1 ;INPUT: DA1 = DA of top level of record (DA(1))
+2 ; X = ien of disapproval reason, 162.94
+3 ;OUTPUT: none - entry to disapproval multiple if not already there, disapproval reason is active and disposition reason is other than approved.
+4 NEW Y,DA,DIC
+5 SET DIC(0)="Z"
SET DIC="^FB583("_DA1_",""D"","
+6 IF $PIECE(^FB583(DA1,0),U,11)>1
IF $PIECE(^FB(162.94,+X,0),U,2)
IF '$DATA(^FB583(DA1,"D","B",+X))
if '$DATA(^FB583(DA1,"D"))
SET ^FB583(DA1,"D",0)="^162.715PA^^"
SET DA(1)=DA1
KILL DD,DO
DO FILE^DICN
+7 QUIT
STATUS(X) ;get status internal entry number
+1 ;INPUT: X = order number of status in file 162.92
+2 ;OUTPUT: ien of status in file 162.92 (status file)
+3 QUIT +$ORDER(^FB(162.92,"AO",X,0))
+4 ;
ORDER(X) ;get order number of status
+1 ;INPUT: X = ien of status in file 162.92, status file
+2 ;OUTPUT: order number of status
+3 SET X=$GET(^FB(162.92,+X,0))
QUIT +$PIECE(X,U,4)
+4 ;
PAY(X,FBGL) ;determine if any payments have been made
+1 ;INPUT: X= ien in file
+2 ; FBGL= global root
+3 ;OUTPUT: 0 if no payments, 1 if payments
+4 if $EXTRACT(FBGL,1)="^"
SET FBGL=$PIECE(FBGL,"^",2)
SET FBGL=X_";"_FBGL
+5 QUIT $SELECT(+$ORDER(^FBAA(162.1,"AO",FBGL,0)):1,+$ORDER(^FBAAC("AM",FBGL,0)):1,+$ORDER(^FBAAI("E",FBGL,0)):1,1:0)
+6 ;
OVER(KEY) ;determine if ability to override
+1 ;INPUT: KEY=security key
+2 ;OUTPUT: 0 if not holder of key, 1 if holder of key
+3 QUIT $SELECT($DATA(^XUSEC(KEY,DUZ)):1,1:0)
+4 ;
UPOK(X) ;ok to update
+1 ;INPUT: X= ien of 162.7
+2 ;OUTPUT: 0 if NOT OK to update, 1 if OK to update
+3 QUIT $SELECT('$$PAY(X,"^FB583("):1,$$OVER("FBAASUPERVISOR"):1,1:0)
+4 ;
TIME(ED) ;determine if expiration date passed
+1 ;INPUT: ED= expiration date
+2 ;OUTPUT: 0 if late, 1 if within timeframe
+3 QUIT $SELECT('ED:1,DT>ED:0,1:1)
UNTIME(FBX) ;write untimely message - called from input templates
+1 ;INPUT: FBX = disapproval reason
+2 WRITE !?5,"Claim has been dispositioned to DISAPPROVED"
if +FBX
WRITE !?8,"with disapproval reason of '",$PIECE($$PTR("^FB(162.94,",FBX),U),"'.",!,*7
+3 QUIT
+4 ;
FBZ(X) ;get zero node on 162.7
+1 ;INPUT: X = ien of 162.7, unauthorized claim file
+2 ;OUTPUT: zero node of 162.7
+3 IF '+X
QUIT 0
+4 SET X=+X
QUIT $GET(^FB583(X,0))
+5 ;
FILE(FBGL,X,FBDI,FBDA1) ;add entry to file or subfile
+1 ;INPUT: FBGL = global root
+2 ; X = value for .01 field
+3 ; FBDI = 1 for dinum entry, 0 or null if not (optional)
+4 ; FBDA1 = DA(1) value (optional), if doesn't exist will not set
+5 ;OUTPUT: entry is added to designated file
+6 ; Y is returned ien^value of .01 field^1
+7 NEW DA,DIC,DINUM,Y
IF $SELECT(X']"":1,'$DATA(FBDI):1,+FBDI&(X'=+X):1,'$DATA(FBDA):1,1:0)
QUIT ""
+8 IF $DATA(FBDA1)
SET DA(1)=FBDA1
ADD if +FBDI
SET DINUM=X
SET DIC(0)="MZ"
SET DIC=FBGL
KILL DD,DO
DO FILE^DICN
if +Y'>0
GOTO ADD
KILL DIC,DINUM
+1 QUIT $GET(Y)
+2 ;
PEND(FBDA) ;check if any info pending for claim
+1 ;INPUT: FBDA = ien of unauthorized claim in 162.7
+2 ;OUTPUT: 1 if info pending, otherwise 0
+3 QUIT $SELECT(+$ORDER(^FBAA(162.8,"ACD",FBDA,0)):1,1:0)
PAYST(FBDA,FBUCP) ; unauthorized claim payment status (released+)
+1 ;INPUT: FBDA = ien of unauthorized claim in 162.7
+2 ; FBUCP = name of array (optional)
+3 ;RESULT: 1 (true) if at least one payment and all have been released
+4 ; 0 (false) if no payments or if some have not been released
+5 ;OUTPUT: if FBCUP contains the name of an array then that array will
+6 ; be populated with payment information in the following format
+7 ; array (claim ien) = result ^ number of payments
+8 ; array (claim ien, payment file #, payment iens) = batch status
+9 NEW FBGL,FBRET,FBPDA,FBPDA1,FBPDA2,FBPDA3,FBBS,FBC
+10 SET FBRET=1
+11 SET FBC=0
+12 IF $GET(FBUCP)]""
KILL FBCUP(FBDA)
+13 SET FBGL=FBDA_";FB583("
+14 ; pharmacy payments
+15 SET FBPDA=0
+16 FOR
SET FBPDA=$ORDER(^FBAA(162.1,"AO",FBGL,FBPDA))
if 'FBPDA
QUIT
Begin DoDot:1
+17 SET FBPDA1=0
+18 FOR
SET FBPDA1=$ORDER(^FBAA(162.1,"AO",FBGL,FBPDA,FBPDA1))
if 'FBPDA1
QUIT
Begin DoDot:2
+19 SET FBIENS=FBPDA1_","_FBPDA_","
+20 SET FBBS=$$GET1^DIQ(162.11,FBIENS,"13:11","I")
+21 IF $GET(FBUCP)]""
SET @FBUCP@(FBDA,162.11,FBIENS)=FBBS
+22 IF "^S^T^V^R^"'[(U_FBBS_U)
SET FBRET=0
+23 SET FBC=FBC+1
End DoDot:2
End DoDot:1
+24 ; outpatient and ancillary payments
+25 SET FBPDA=0
+26 FOR
SET FBPDA=$ORDER(^FBAAC("AM",FBGL,FBPDA))
if 'FBPDA
QUIT
Begin DoDot:1
+27 SET FBPDA1=0
+28 FOR
SET FBPDA1=$ORDER(^FBAAC("AM",FBGL,FBPDA,FBPDA1))
if 'FBPDA1
QUIT
Begin DoDot:2
+29 SET FBPDA2=0
+30 FOR
SET FBPDA2=$ORDER(^FBAAC("AM",FBGL,FBPDA,FBPDA1,FBPDA2))
if 'FBPDA2
QUIT
Begin DoDot:3
+31 SET FBPDA3=0
+32 FOR
SET FBPDA3=$ORDER(^FBAAC("AM",FBGL,FBPDA,FBPDA1,FBPDA2,FBPDA3))
if 'FBPDA3
QUIT
Begin DoDot:4
+33 SET FBIENS=FBPDA3_","_FBPDA2_","_FBPDA1_","_FBPDA_","
+34 SET FBBS=$$GET1^DIQ(162.03,FBIENS,"7:11","I")
+35 IF $GET(FBUCP)]""
SET @FBUCP@(FBDA,162.03,FBIENS)=FBBS
+36 IF "^S^T^V^R^"'[(U_FBBS_U)
SET FBRET=0
+37 SET FBC=FBC+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+38 ; civil hospital payments
+39 SET FBPDA=0
+40 FOR
SET FBPDA=$ORDER(^FBAAI("E",FBGL,FBPDA))
if 'FBPDA
QUIT
Begin DoDot:1
+41 SET FBIENS=FBPDA_","
+42 SET FBBS=$$GET1^DIQ(162.5,FBIENS,"20:11","I")
+43 IF $GET(FBUCP)]""
SET @FBUCP@(FBDA,162.5,FBIENS)=FBBS
+44 IF "^S^T^V^R^"'[(U_FBBS_U)
SET FBRET=0
+45 SET FBC=FBC+1
End DoDot:1
+46 IF FBC=0
SET FBRET=0
+47 IF $GET(FBUCP)]""
SET @FBUCP@(FBDA)=FBRET_U_FBC
+48 QUIT FBRET
