FBAAAUDR ;WIOFO/SAB - AUTHORIZATION DATA AUDIT REPORT ;3/27/2014
;;3.5;FEE BASIS;**151**;JAN 30, 1995;Build 14
;;Per VA Directive 6402, this routine should not be modified.
;
; IAs
; #10003 DD^%DT
; #10000 NOW^%DTC
; #10086 %ZIS, HOME^%ZIS
; #10089 %ZISC
; #10063 %ZTLOAD
; #2056 $$GET1^DIQ
; #10004 EN^DIQ
; #10026 DIR
;
N DFN,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FTP,%ZIS,POP,X,Y
;
; ask patient
S DFN=$$ASKVET^FBAAUTL1()
G:'DFN EXIT
;
; ask authorization
D GETAUTH^FBAAUTL1
G:$G(FTP)="" EXIT
;
; ask device
S %ZIS="Q" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
. S ZTRTN="QEN^FBAAAUDR",ZTDESC="Historical Authorization Data Report"
. F FBX="DFN","FTP" S ZTSAVE(FBX)=""
. D ^%ZTLOAD,HOME^%ZIS
;
QEN ; queued entry point
N %
;
U IO
;
S FBQUIT=0
D NOW^%DTC S Y=% D DD^%DT S FBDTR=Y
;
I $E(IOST,1,2)="C-" W @IOF
W !,"Historical Authorization Data Report",?49,FBDTR
;
; display patient
W !,"Patient: ",$$GET1^DIQ(161,DFN_",",.01)
W " Pt.ID: ",$$SSN^FBAAUTL(DFN),!
;
; display current authorization data
W !,"Current Authorization Data: "
S DIC="^FBAAA("_DFN_",1,",DA(1)=DFN,DA=FTP,DR="0:LOG"
D EN^DIQ
;
I $E(IOST,1,2)="C-",IOSL<($Y+18) S DIR(0)="E" D ^DIR K DIR I 'Y S FBQUIT=1
;
; display historical data
I 'FBQUIT D
. W !,"Historical Audit Data (since patch FB*3.5*151): "
. W:'$O(^FBAAA(DA(1),1,DA,"LOG2",0)) !," No historical audit data on file."
. S DIC="^FBAAA("_DFN_",1,",DA(1)=DFN,DA=FTP,DR="LOG2"
. D EN^DIQ
. I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR I 'Y S FBQUIT=1
;
; close device
D ^%ZISC
;
EXIT ; exit
I $D(ZTQUEUED) S ZTREQ="@"
K DA,DIC,DIR,DR,DIROUT,DTOUT,DUOUT,X,Y
K FB583,FB7078,FBAABDT,FBAAEDT,FBASSOC,FBDMRA,FBDTR,FBPOV,FBPROG,FBPSA
K FBPT,FBQUIT,FBTT,FBTYPE,FBVEN,FBX,FTP,TA
D GETAUTHK^FBAAUTL1
K FBAAOUT,FBAUD,CNT,DFN,PI
Q
;
;FBAAAUDR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAAUDR 1990 printed Nov 22, 2024@17:05:03 Page 2
FBAAAUDR ;WIOFO/SAB - AUTHORIZATION DATA AUDIT REPORT ;3/27/2014
+1 ;;3.5;FEE BASIS;**151**;JAN 30, 1995;Build 14
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; IAs
+5 ; #10003 DD^%DT
+6 ; #10000 NOW^%DTC
+7 ; #10086 %ZIS, HOME^%ZIS
+8 ; #10089 %ZISC
+9 ; #10063 %ZTLOAD
+10 ; #2056 $$GET1^DIQ
+11 ; #10004 EN^DIQ
+12 ; #10026 DIR
+13 ;
+14 NEW DFN,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FTP,%ZIS,POP,X,Y
+15 ;
+16 ; ask patient
+17 SET DFN=$$ASKVET^FBAAUTL1()
+18 if 'DFN
GOTO EXIT
+19 ;
+20 ; ask authorization
+21 DO GETAUTH^FBAAUTL1
+22 if $GET(FTP)=""
GOTO EXIT
+23 ;
+24 ; ask device
+25 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
+26 IF $DATA(IO("Q"))
Begin DoDot:1
+27 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
+28 SET ZTRTN="QEN^FBAAAUDR"
SET ZTDESC="Historical Authorization Data Report"
+29 FOR FBX="DFN","FTP"
SET ZTSAVE(FBX)=""
+30 DO ^%ZTLOAD
DO HOME^%ZIS
End DoDot:1
GOTO EXIT
+31 ;
QEN ; queued entry point
+1 NEW %
+2 ;
+3 USE IO
+4 ;
+5 SET FBQUIT=0
+6 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET FBDTR=Y
+7 ;
+8 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+9 WRITE !,"Historical Authorization Data Report",?49,FBDTR
+10 ;
+11 ; display patient
+12 WRITE !,"Patient: ",$$GET1^DIQ(161,DFN_",",.01)
+13 WRITE " Pt.ID: ",$$SSN^FBAAUTL(DFN),!
+14 ;
+15 ; display current authorization data
+16 WRITE !,"Current Authorization Data: "
+17 SET DIC="^FBAAA("_DFN_",1,"
SET DA(1)=DFN
SET DA=FTP
SET DR="0:LOG"
+18 DO EN^DIQ
+19 ;
+20 IF $EXTRACT(IOST,1,2)="C-"
IF IOSL<($Y+18)
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET FBQUIT=1
+21 ;
+22 ; display historical data
+23 IF 'FBQUIT
Begin DoDot:1
+24 WRITE !,"Historical Audit Data (since patch FB*3.5*151): "
+25 if '$ORDER(^FBAAA(DA(1),1,DA,"LOG2",0))
WRITE !," No historical audit data on file."
+26 SET DIC="^FBAAA("_DFN_",1,"
SET DA(1)=DFN
SET DA=FTP
SET DR="LOG2"
+27 DO EN^DIQ
+28 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET FBQUIT=1
End DoDot:1
+29 ;
+30 ; close device
+31 DO ^%ZISC
+32 ;
EXIT ; exit
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL DA,DIC,DIR,DR,DIROUT,DTOUT,DUOUT,X,Y
+3 KILL FB583,FB7078,FBAABDT,FBAAEDT,FBASSOC,FBDMRA,FBDTR,FBPOV,FBPROG,FBPSA
+4 KILL FBPT,FBQUIT,FBTT,FBTYPE,FBVEN,FBX,FTP,TA
+5 DO GETAUTHK^FBAAUTL1
+6 KILL FBAAOUT,FBAUD,CNT,DFN,PI
+7 QUIT
+8 ;
+9 ;FBAAAUDR
