FBAACLU ;AISC/DMK,WOIFO/SAB - CLERK WHO ENTERED AUTHORIZATION ;12/8/2014
;;3.5;FEE BASIS;**154**;JAN 30, 1995;Build 12
;;Per VA Directive 6402, this routine should not be modified.
;
; inputs
; FBFILE - (required) file/sub-file # from menu option entry action
;
; check for required input
Q:"^161.01^162.2^162.4^162.7^"'[("^"_$G(FBFILE)_"^")
;
N D,FBDA,POP,%ZIS
;
; ask record in file
I FBFILE=161.01 D
. S DIC="^FBAAA(",DIC(0)="AEQM"
. D ^DIC K DIC Q:Y<0 S FBDA(1)=+Y
. S DIC="^FBAAA("_FBDA(1)_",1,",DIC(0)="AEQM"
. D ^DIC K DIC Q:Y<0 S FBDA=+Y
I FBFILE=162.2 D
. S DIC="^FBAA(162.2,",DIC(0)="AQEM"
. D ^DIC K DIC Q:Y<0 S FBDA=+Y
I FBFILE=162.4 D
. S DIC="^FB7078(",DIC(0)="AQEM",DIC("A")="Select Patient: ",D="D"
. D IX^DIC K DIC Q:Y<0 S FBDA=+Y
I FBFILE=162.7 D
. N FBARY,FBI,FBOUT
. D LOOKUP^FBUCUTL3(0)
. I 'FBOUT D
. . S FBI=$O(^TMP("FBARY",$J,0))
. . S:FBI FBDA=$P($G(^TMP("FBARY",$J,FBI)),";",1)
. K ^TMP("FBARY",$J)
I '$G(FBDA) G EXIT
;
; ask device
S %ZIS="Q" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. N FBX
. N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
. S ZTRTN="QEN^FBAACLU",ZTDESC="Fee Clerk Lookup"
. F FBX="FBFILE","FBDA*" S ZTSAVE(FBX)=""
. D ^%ZTLOAD,HOME^%ZIS
;
QEN ; queued entry point
; inputs from Taskman
; ZTQUEUED - (optional) set by TaskMan to indicate report is tasked
; outputs to Taskman
; ZTREQ - set when report is tasked
; ZTSTOP - set when report is tasked and job was stopped per request
;
N %
;
U IO
;
S (FBQUIT,FBPG)=0 D NOW^%DTC S Y=% D DD^%DT S FBDTR=Y
K FBDL
S FBDL="",$P(FBDL,"-",80)=""
S FBDL("ED")=" "_$E(FBDL,1,21)_" "_$E(FBDL,1,35)
;
; build page header text
I FBFILE=161.01 S FBHD="Clerk Lookup for an authorization"
I FBFILE=162.2 S FBHD="Clerk Lookup for a CH notification"
I FBFILE=162.4 S FBHD="Clerk Lookup for a 7078 authorization"
I FBFILE=162.7 S FBHD="Clerk Lookup for an unauthorized claim"
;
; determine which files to display
F FBX=161.01,162.2,162.4,162.7 S FBSHOW(FBX)=0 ; init FBSHOW(
S FBSHOW(FBFILE)=FBDA ; always show input file
I FBFILE=161.01 D
. S FBX=$P($G(^FBAAA(FBDA(1),1,FBDA,0)),U,9) ; ASSOC 7078/583
. I FBX["FB7078" S FBSHOW(162.4)=+FBX
. I FBX["FB583" S FBSHOW(162.7)=+FBX
I FBSHOW(162.4) D
. S FBX=$O(^FBAA(162.2,"AM",FBSHOW(162.4),0))
. I FBX S FBSHOW(162.2)=FBX
;
; display output
D HD
;
; show information for authorization
I 'FBQUIT,FBSHOW(161.01) D
. N FBDATA
. ; skip if no user audit data and either 7078 or unauthorized claim
. ; (very similar information) will be shown later
. S FBDATA=$O(^FBAAA(FBDA(1),1,FBDA,"LOG1",0))
. I 'FBDATA,FBSHOW(162.4)!FBSHOW(162.7) Q
. ;
. S FBIENS=FBDA_","_FBDA(1)_","
. I $Y+6>IOSL D HD Q:FBQUIT
. W !!,"Authorization"
. W !,"Veteran: ",$$GET1^DIQ(161,FBDA(1)_",",.01)
. W ?40,"Vendor: ",$$GET1^DIQ(161.01,FBIENS,.04)
. W !,"Authorization Number: ",FBDA(1),"-",FBDA
. W !,"Authorized From Date: ",$$GET1^DIQ(161.01,FBIENS,.01)
. W ?40,"Authorized To Date: ",$$GET1^DIQ(161.01,FBIENS,.02)
. D DUA("^FBAAA("_FBDA(1)_",1,"_FBDA_",""LOG1"",")
;
; show information for 10-7078 authorization
I 'FBQUIT,FBSHOW(162.4) D
. N FBVEN
. S FBIENS=FBSHOW(162.4)_","
. I $Y+6>IOSL D HD Q:FBQUIT
. W !!,"10-7078 Authorization"
. W !,"Veteran: ",$$GET1^DIQ(162.4,FBIENS,2)
. S FBVEN=+$P($G(^FB7078(FBSHOW(162.4),0)),"^",2)
. W ?40,"Vendor: ",$$GET1^DIQ(161.2,FBVEN_",",.01)
. W !,"Reference Number: ",$$GET1^DIQ(162.4,FBIENS,.01)
. W ?40,"Fee Program: ",$$GET1^DIQ(162.4,FBIENS,.5)
. W !,"Authorized From Date: ",$$GET1^DIQ(162.4,FBIENS,3)
. W ?40,"Authorized To Date: ",$$GET1^DIQ(162.4,FBIENS,4)
. D DUA("^FB7078("_FBSHOW(162.4)_",""LOG1"",")
;
; show information for civil hospital notification
I 'FBQUIT,FBSHOW(162.2) D
. S FBIENS=FBSHOW(162.2)_","
. I $Y+6>IOSL D HD Q:FBQUIT
. W !!,"CH Notification"
. W !,"Date/Time: ",$$GET1^DIQ(162.2,FBIENS,.01)
. W !,"Veteran: ",$$GET1^DIQ(162.2,FBIENS,3)
. W ?40,"Vendor: ",$$GET1^DIQ(162.2,FBIENS,1)
. D DUA("^FBAA(162.2,"_FBSHOW(162.2)_",""LOG1"",")
;
; show information for unauthorized claim
I 'FBQUIT,FBSHOW(162.7) D
. S FBIENS=FBSHOW(162.7)_","
. I $Y+6>IOSL D HD Q:FBQUIT
. W !!,"Unauthorized Claim"
. W !,"Veteran: ",$$GET1^DIQ(162.7,FBIENS,2)
. W ?40,"Vendor: ",$$GET1^DIQ(162.7,FBIENS,1)
. W !,"Date Claim Received: ",$$GET1^DIQ(162.7,FBIENS,.01)
. W ?40,"Fee Program: ",$$GET1^DIQ(162.7,FBIENS,.5)
. W !,"Treatment From Date: ",$$GET1^DIQ(162.7,FBIENS,3)
. W ?40,"Treatment To Date: ",$$GET1^DIQ(162.7,FBIENS,4)
. D DUA("^FB583("_FBSHOW(162.7)_",""LOG1"",")
;
I 'FBQUIT,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
D ^%ZISC
;
EXIT ;
I $D(ZTQUEUED) S ZTREQ="@"
K FBDA,FBDL,FBDT,FBDTR,FBHD,FBIENS,FBPG,FBSHOW,FBQUIT,FBX
K DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
Q
;
HD ; page header
N FBI
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,FBQUIT=1 Q
I $E(IOST,1,2)="C-",FBPG S DIR(0)="E" D ^DIR K DIR I 'Y S FBQUIT=1 Q
I $E(IOST,1,2)="C-"!FBPG W @IOF
S FBPG=FBPG+1
W FBHD,?49,FBDTR,?72,"page ",FBPG
W !,FBDL
Q
;
HDEDT(FBCONT) ; header for edited table
; input
; FBCONT (optional) =1 when table continued after page break
W !!,?4,"Date/Time Edited",?27,"Edited By"
W:$G(FBCONT) " (continued)"
W !,FBDL("ED")
Q
;
DUA(FBROOT) ; display the user audit for a record in one of the supported files
N FBC,FBDT,FBI,FBTXT,FBUSR,FBY0
I $Y+6>IOSL D HD Q:FBQUIT
D HDEDT(0)
S (FBC,FBI)=0 F S FBI=$O(@(FBROOT_FBI_")")) Q:'FBI D Q:FBQUIT
. S FBC=FBC+1
. S FBY0=$G(@(FBROOT_FBI_",0)"))
. S FBDT=$P(FBY0,"^")
. S FBUSR=$P(FBY0,"^",2)
. S FBTXT=$P(FBY0,"^",3)
. I $Y+4>IOSL D HD Q:FBQUIT D HDEDT(1)
. W !
. W ?4,$S(FBDT:$$FMTE^XLFDT(FBDT),1:"")
. W ?27,$S(FBUSR:$$GET1^DIQ(200,FBUSR,.01),1:"")
. I FBTXT]"" W !,?6,"Comments: ",FBTXT
I FBC=0 W !,?4,"No information found in user audit"
Q
;
;FBAACLU
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAACLU 6022 printed Dec 13, 2024@01:55:06 Page 2
FBAACLU ;AISC/DMK,WOIFO/SAB - CLERK WHO ENTERED AUTHORIZATION ;12/8/2014
+1 ;;3.5;FEE BASIS;**154**;JAN 30, 1995;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; inputs
+5 ; FBFILE - (required) file/sub-file # from menu option entry action
+6 ;
+7 ; check for required input
+8 if "^161.01^162.2^162.4^162.7^"'[("^"_$GET(FBFILE)_"^")
QUIT
+9 ;
+10 NEW D,FBDA,POP,%ZIS
+11 ;
+12 ; ask record in file
+13 IF FBFILE=161.01
Begin DoDot:1
+14 SET DIC="^FBAAA("
SET DIC(0)="AEQM"
+15 DO ^DIC
KILL DIC
if Y<0
QUIT
SET FBDA(1)=+Y
+16 SET DIC="^FBAAA("_FBDA(1)_",1,"
SET DIC(0)="AEQM"
+17 DO ^DIC
KILL DIC
if Y<0
QUIT
SET FBDA=+Y
End DoDot:1
+18 IF FBFILE=162.2
Begin DoDot:1
+19 SET DIC="^FBAA(162.2,"
SET DIC(0)="AQEM"
+20 DO ^DIC
KILL DIC
if Y<0
QUIT
SET FBDA=+Y
End DoDot:1
+21 IF FBFILE=162.4
Begin DoDot:1
+22 SET DIC="^FB7078("
SET DIC(0)="AQEM"
SET DIC("A")="Select Patient: "
SET D="D"
+23 DO IX^DIC
KILL DIC
if Y<0
QUIT
SET FBDA=+Y
End DoDot:1
+24 IF FBFILE=162.7
Begin DoDot:1
+25 NEW FBARY,FBI,FBOUT
+26 DO LOOKUP^FBUCUTL3(0)
+27 IF 'FBOUT
Begin DoDot:2
+28 SET FBI=$ORDER(^TMP("FBARY",$JOB,0))
+29 if FBI
SET FBDA=$PIECE($GET(^TMP("FBARY",$JOB,FBI)),";",1)
End DoDot:2
+30 KILL ^TMP("FBARY",$JOB)
End DoDot:1
+31 IF '$GET(FBDA)
GOTO EXIT
+32 ;
+33 ; ask device
+34 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
+35 IF $DATA(IO("Q"))
Begin DoDot:1
+36 NEW FBX
+37 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
+38 SET ZTRTN="QEN^FBAACLU"
SET ZTDESC="Fee Clerk Lookup"
+39 FOR FBX="FBFILE","FBDA*"
SET ZTSAVE(FBX)=""
+40 DO ^%ZTLOAD
DO HOME^%ZIS
End DoDot:1
GOTO EXIT
+41 ;
QEN ; queued entry point
+1 ; inputs from Taskman
+2 ; ZTQUEUED - (optional) set by TaskMan to indicate report is tasked
+3 ; outputs to Taskman
+4 ; ZTREQ - set when report is tasked
+5 ; ZTSTOP - set when report is tasked and job was stopped per request
+6 ;
+7 NEW %
+8 ;
+9 USE IO
+10 ;
+11 SET (FBQUIT,FBPG)=0
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET FBDTR=Y
+12 KILL FBDL
+13 SET FBDL=""
SET $PIECE(FBDL,"-",80)=""
+14 SET FBDL("ED")=" "_$EXTRACT(FBDL,1,21)_" "_$EXTRACT(FBDL,1,35)
+15 ;
+16 ; build page header text
+17 IF FBFILE=161.01
SET FBHD="Clerk Lookup for an authorization"
+18 IF FBFILE=162.2
SET FBHD="Clerk Lookup for a CH notification"
+19 IF FBFILE=162.4
SET FBHD="Clerk Lookup for a 7078 authorization"
+20 IF FBFILE=162.7
SET FBHD="Clerk Lookup for an unauthorized claim"
+21 ;
+22 ; determine which files to display
+23 ; init FBSHOW(
FOR FBX=161.01,162.2,162.4,162.7
SET FBSHOW(FBX)=0
+24 ; always show input file
SET FBSHOW(FBFILE)=FBDA
+25 IF FBFILE=161.01
Begin DoDot:1
+26 ; ASSOC 7078/583
SET FBX=$PIECE($GET(^FBAAA(FBDA(1),1,FBDA,0)),U,9)
+27 IF FBX["FB7078"
SET FBSHOW(162.4)=+FBX
+28 IF FBX["FB583"
SET FBSHOW(162.7)=+FBX
End DoDot:1
+29 IF FBSHOW(162.4)
Begin DoDot:1
+30 SET FBX=$ORDER(^FBAA(162.2,"AM",FBSHOW(162.4),0))
+31 IF FBX
SET FBSHOW(162.2)=FBX
End DoDot:1
+32 ;
+33 ; display output
+34 DO HD
+35 ;
+36 ; show information for authorization
+37 IF 'FBQUIT
IF FBSHOW(161.01)
Begin DoDot:1
+38 NEW FBDATA
+39 ; skip if no user audit data and either 7078 or unauthorized claim
+40 ; (very similar information) will be shown later
+41 SET FBDATA=$ORDER(^FBAAA(FBDA(1),1,FBDA,"LOG1",0))
+42 IF 'FBDATA
IF FBSHOW(162.4)!FBSHOW(162.7)
QUIT
+43 ;
+44 SET FBIENS=FBDA_","_FBDA(1)_","
+45 IF $Y+6>IOSL
DO HD
if FBQUIT
QUIT
+46 WRITE !!,"Authorization"
+47 WRITE !,"Veteran: ",$$GET1^DIQ(161,FBDA(1)_",",.01)
+48 WRITE ?40,"Vendor: ",$$GET1^DIQ(161.01,FBIENS,.04)
+49 WRITE !,"Authorization Number: ",FBDA(1),"-",FBDA
+50 WRITE !,"Authorized From Date: ",$$GET1^DIQ(161.01,FBIENS,.01)
+51 WRITE ?40,"Authorized To Date: ",$$GET1^DIQ(161.01,FBIENS,.02)
+52 DO DUA("^FBAAA("_FBDA(1)_",1,"_FBDA_",""LOG1"",")
End DoDot:1
+53 ;
+54 ; show information for 10-7078 authorization
+55 IF 'FBQUIT
IF FBSHOW(162.4)
Begin DoDot:1
+56 NEW FBVEN
+57 SET FBIENS=FBSHOW(162.4)_","
+58 IF $Y+6>IOSL
DO HD
if FBQUIT
QUIT
+59 WRITE !!,"10-7078 Authorization"
+60 WRITE !,"Veteran: ",$$GET1^DIQ(162.4,FBIENS,2)
+61 SET FBVEN=+$PIECE($GET(^FB7078(FBSHOW(162.4),0)),"^",2)
+62 WRITE ?40,"Vendor: ",$$GET1^DIQ(161.2,FBVEN_",",.01)
+63 WRITE !,"Reference Number: ",$$GET1^DIQ(162.4,FBIENS,.01)
+64 WRITE ?40,"Fee Program: ",$$GET1^DIQ(162.4,FBIENS,.5)
+65 WRITE !,"Authorized From Date: ",$$GET1^DIQ(162.4,FBIENS,3)
+66 WRITE ?40,"Authorized To Date: ",$$GET1^DIQ(162.4,FBIENS,4)
+67 DO DUA("^FB7078("_FBSHOW(162.4)_",""LOG1"",")
End DoDot:1
+68 ;
+69 ; show information for civil hospital notification
+70 IF 'FBQUIT
IF FBSHOW(162.2)
Begin DoDot:1
+71 SET FBIENS=FBSHOW(162.2)_","
+72 IF $Y+6>IOSL
DO HD
if FBQUIT
QUIT
+73 WRITE !!,"CH Notification"
+74 WRITE !,"Date/Time: ",$$GET1^DIQ(162.2,FBIENS,.01)
+75 WRITE !,"Veteran: ",$$GET1^DIQ(162.2,FBIENS,3)
+76 WRITE ?40,"Vendor: ",$$GET1^DIQ(162.2,FBIENS,1)
+77 DO DUA("^FBAA(162.2,"_FBSHOW(162.2)_",""LOG1"",")
End DoDot:1
+78 ;
+79 ; show information for unauthorized claim
+80 IF 'FBQUIT
IF FBSHOW(162.7)
Begin DoDot:1
+81 SET FBIENS=FBSHOW(162.7)_","
+82 IF $Y+6>IOSL
DO HD
if FBQUIT
QUIT
+83 WRITE !!,"Unauthorized Claim"
+84 WRITE !,"Veteran: ",$$GET1^DIQ(162.7,FBIENS,2)
+85 WRITE ?40,"Vendor: ",$$GET1^DIQ(162.7,FBIENS,1)
+86 WRITE !,"Date Claim Received: ",$$GET1^DIQ(162.7,FBIENS,.01)
+87 WRITE ?40,"Fee Program: ",$$GET1^DIQ(162.7,FBIENS,.5)
+88 WRITE !,"Treatment From Date: ",$$GET1^DIQ(162.7,FBIENS,3)
+89 WRITE ?40,"Treatment To Date: ",$$GET1^DIQ(162.7,FBIENS,4)
+90 DO DUA("^FB583("_FBSHOW(162.7)_",""LOG1"",")
End DoDot:1
+91 ;
+92 IF 'FBQUIT
IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
+93 DO ^%ZISC
+94 ;
EXIT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL FBDA,FBDL,FBDT,FBDTR,FBHD,FBIENS,FBPG,FBSHOW,FBQUIT,FBX
+3 KILL DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+4 QUIT
+5 ;
HD ; page header
+1 NEW FBI
+2 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET FBQUIT=1
QUIT
+3 IF $EXTRACT(IOST,1,2)="C-"
IF FBPG
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET FBQUIT=1
QUIT
+4 IF $EXTRACT(IOST,1,2)="C-"!FBPG
WRITE @IOF
+5 SET FBPG=FBPG+1
+6 WRITE FBHD,?49,FBDTR,?72,"page ",FBPG
+7 WRITE !,FBDL
+8 QUIT
+9 ;
HDEDT(FBCONT) ; header for edited table
+1 ; input
+2 ; FBCONT (optional) =1 when table continued after page break
+3 WRITE !!,?4,"Date/Time Edited",?27,"Edited By"
+4 if $GET(FBCONT)
WRITE " (continued)"
+5 WRITE !,FBDL("ED")
+6 QUIT
+7 ;
DUA(FBROOT) ; display the user audit for a record in one of the supported files
+1 NEW FBC,FBDT,FBI,FBTXT,FBUSR,FBY0
+2 IF $Y+6>IOSL
DO HD
if FBQUIT
QUIT
+3 DO HDEDT(0)
+4 SET (FBC,FBI)=0
FOR
SET FBI=$ORDER(@(FBROOT_FBI_")"))
if 'FBI
QUIT
Begin DoDot:1
+5 SET FBC=FBC+1
+6 SET FBY0=$GET(@(FBROOT_FBI_",0)"))
+7 SET FBDT=$PIECE(FBY0,"^")
+8 SET FBUSR=$PIECE(FBY0,"^",2)
+9 SET FBTXT=$PIECE(FBY0,"^",3)
+10 IF $Y+4>IOSL
DO HD
if FBQUIT
QUIT
DO HDEDT(1)
+11 WRITE !
+12 WRITE ?4,$SELECT(FBDT:$$FMTE^XLFDT(FBDT),1:"")
+13 WRITE ?27,$SELECT(FBUSR:$$GET1^DIQ(200,FBUSR,.01),1:"")
+14 IF FBTXT]""
WRITE !,?6,"Comments: ",FBTXT
End DoDot:1
if FBQUIT
QUIT
+15 IF FBC=0
WRITE !,?4,"No information found in user audit"
+16 QUIT
+17 ;
+18 ;FBAACLU
