Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBUCUTL

FBUCUTL.m

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