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

FBFPAR.m

Go to the documentation of this file. 
  1. FBFPAR ;WOIFO/SAB-FPPS AUDIT REPORT ;7/18/2003
  1.  ;;3.5;FEE BASIS;**61**;JAN 30, 1995
  1.  ;
  1.  ; ask if BY INVOICE or BY DATE RANGE
  1.  S DIR(0)="S^I:Invoice;D:Date Range"
  1.  S DIR("A")="Report one invoice or report by Date Range"
  1.  S DIR("B")="Date Range"
  1.  S DIR("?",1)="Enter I to print the audit data for one invoice."
  1.  S DIR("?",2)="Enter D to print all audit data for a date range."
  1.  S DIR("?")="Enter a code from the list."
  1.  D ^DIR K DIR G:$D(DIRUT) EXIT
  1.  S FBRANGE=$S(Y="D":1,1:0)
  1.  ;
  1.  I FBRANGE D  G:$D(DIRUT) EXIT
  1.  . ; ask dates
  1.  . S DIR(0)="D^::EX",DIR("A")="From Date"
  1.  . ;   default from date is first day of current month
  1.  . S DIR("B")=$$FMTE^XLFDT($E(DT,1,5)_"01")
  1.  . D ^DIR K DIR Q:$D(DIRUT)
  1.  . S FBDT1=Y
  1.  . S DIR(0)="DA^"_FBDT1_"::EX",DIR("A")="To Date: "
  1.  . ;   default to date is last day of specified month
  1.  . S X=FBDT1 D DAYS^FBAAUTL1
  1.  . S DIR("B")=$$FMTE^XLFDT($E(FBDT1,1,5)_X)
  1.  . D ^DIR K DIR Q:$D(DIRUT)
  1.  . S FBDT2=Y
  1.  ;
  1.  ; If not date range then ask invoice
  1.  I 'FBRANGE D  G:$D(DIRUT) EXIT
  1.  . S DIR(0)="N",DIR("A")="Invoice Number: "
  1.  . D ^DIR K DIR Q:$D(DIRUT)
  1.  . S FBAAIN=Y
  1.  ;
  1.  ; ask device
  1.  S %ZIS="QM" D ^%ZIS G:POP EXIT
  1.  I $D(IO("Q")) D  G EXIT
  1.  . S ZTRTN="QEN^FBFPAR",ZTDESC="FPPS Audit Report"
  1.  . F FBX="FBAAIN","FBDT*","FBRANGE" S ZTSAVE(FBX)=""
  1.  . D ^%ZTLOAD,HOME^%ZIS K ZTSK
  1.  ;
  1. QEN ; queued entry
  1.  U IO
  1.  ;
  1. GATHER ; collect and sort data
  1.  S FBQUIT=0
  1.  ;
  1. PRINT ; report data
  1.  S FBPG=0 D NOW^%DTC S Y=% D DD^%DT S FBDTR=Y
  1.  K FBDL S FBDL="",$P(FBDL,"-",IOM)=""
  1.  ;
  1.  ; build page header text for selection criteria
  1.  S:FBRANGE FBHDT(1)="  For "_$$FMTE^XLFDT(FBDT1)_" through "_$$FMTE^XLFDT(FBDT2)
  1.  ;
  1.  D HD
  1.  ;
  1.  ; Initialize Counter
  1.  S FBC=0
  1.  ;
  1.  ; if by date range
  1.  I FBRANGE D
  1.  . S FBDT=FBDT1-.0000001
  1.  . F  S FBDT=$O(^FB(163.7,"C",FBDT)) Q:'FBDT!(FBDT>(FBDT2_".999999"))  D  Q:FBQUIT
  1.  . . S FBDA=0 F  S FBDA=$O(^FB(163.7,"C",FBDT,FBDA)) Q:'FBDA  D  Q:FBQUIT
  1.  . . . D PRINT1
  1.  ;
  1.  ; if by invoice
  1.  I 'FBRANGE D
  1.  . S FBDA=0 F  S FBDA=$O(^FB(163.7,"B",FBAAIN,FBDA)) Q:'FBDA  D  Q:FBQUIT
  1.  . . D PRINT1
  1.  ;
  1.  I FBC=0 W !,"no Audit entries found."
  1.  ;
  1.  I FBQUIT W !!,"REPORT STOPPED AT USER REQUEST"
  1.  ;
  1.  I 'FBQUIT,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
  1.  D ^%ZISC
  1.  ;
  1. EXIT ;
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  K FBAAIN,FBC,FBDT,FBDT1,FBDT2,FBDTR,FBHDT,FBIENS,FBRANGE,FBPG,FBQUIT,FBX
  1.  K %,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,J,POP,X,Y
  1.  Q
  1. HD ; page header
  1.  N FBI
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,FBQUIT=1 Q
  1.  I $E(IOST,1,2)="C-",FBPG S DIR(0)="E" D ^DIR K DIR I 'Y S FBQUIT=1 Q
  1.  I $E(IOST,1,2)="C-"!FBPG W @IOF
  1.  S FBPG=FBPG+1
  1.  W !,"FPPS Data Audit Report "
  1.  I FBRANGE W "by Date Range"
  1.  E  W "for Invoice: ",FBAAIN
  1.  W ?49,FBDTR,?72,"page ",FBPG
  1.  S FBI=0 F  S FBI=$O(FBHDT(FBI)) Q:'FBI  W !,FBHDT(FBI)
  1.  W !!,"Date/Time Changed",?19,"File",?27,"IENS",?58,"User"
  1.  W !,FBDL
  1.  Q
  1.  ;
  1. PRINT1 ; Print one audit record (FBDA)
  1.  N FB,FBADT
  1.  S FBC=FBC+1
  1.  I $Y+9>IOSL D HD Q:FBQUIT
  1.  W !
  1.  ;
  1.  S FBIENS=FBDA_","
  1.  D GETS^DIQ(163.7,FBIENS,"*","","FB")
  1.  S FBADT=$$FMTE^XLFDT($$GET1^DIQ(163.7,FBIENS,1,"I"),"2F")
  1.  W !,FBADT,?19,FB(163.7,FBIENS,2),?27,FB(163.7,FBIENS,3)
  1.  W ?58,$E(FB(163.7,FBIENS,7),1,20)
  1.  W !?4,"Field: "
  1.  W $$GET1^DID(FB(163.7,FBIENS,2),FB(163.7,FBIENS,4),"","LABEL")
  1.  W ?27,"Old Field Value: ",FB(163.7,FBIENS,5)
  1.  W !
  1.  I FBRANGE W ?4,"Invoice: ",FB(163.7,FBIENS,.01)
  1.  W ?27,"New Field Value: ",FB(163.7,FBIENS,6)
  1.  ;
  1.  ; if prescription subfile then write more info to identify
  1.  I FB(163.7,FBIENS,2)="162.11" D
  1.  . W !,?4,"Prescription: "
  1.  . W $$GET1^DIQ(162.11,FB(163.7,FBIENS,3),.01)
  1.  ;
  1.  ; if service provided subfile then write more info to identify
  1.  I FB(163.7,FBIENS,2)="162.03" D
  1.  . N FBDA
  1.  . D DA^DILF(FB(163.7,FBIENS,3),.FBDA)
  1.  . W !,?4,"Patient: "
  1.  . W $$GET1^DIQ(162,FBDA(3)_",",.01)
  1.  . W ?40,"Vendor: "
  1.  . W $E($$GET1^DIQ(162.01,FBDA(2)_","_FBDA(3)_",",.01),1,30)
  1.  . W !,?4,"Date of Service: "
  1.  . W $$GET1^DIQ(162.02,FBDA(1)_","_FBDA(2)_","_FBDA(3)_",",.01)
  1.  . W ?36,"Service Provided: "
  1.  . W $$GET1^DIQ(162.03,FB(163.7,FBIENS,3),.01)
  1.  Q
  1.  ;
  1.  ;FBFPAR