- 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 Jan 18, 2025@02:56:19 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