96 lines
3.1 KiB
Mathematica
96 lines
3.1 KiB
Mathematica
FBFHLP ;WOIFO/SAB-FPPS MESSAGE PURGE ;9/9/2003
|
|
;;3.5;FEE BASIS;**61**;JAN 30, 1995
|
|
;
|
|
W !,"When an invoice is transmitted to FPPS via the HL7 package, a copy of the HL7"
|
|
W !,"message text is saved in the FPPS QUEUED INVOICES (#163.5) file."
|
|
W !!,"This option purges the message text for invoices transmitted prior to a"
|
|
W !,"specified date. Messages that have not been accepted by the VistA Interface"
|
|
W !,"Engine will not be purged unless there is a later message for the same"
|
|
W !,"invoice number that has been accepted.",!
|
|
;
|
|
; ask date
|
|
S DIR(0)="D^:"_$$FMADD^XLFDT(DT,-30)_":EX"
|
|
S DIR("A")="Purge text of messages transmitted prior to"
|
|
S DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-60),2)
|
|
S DIR("?",1)="The purge date must be at least 30 days ago."
|
|
S DIR("?")="This response must be a date. Enter '^' to quit."
|
|
D ^DIR K DIR G:$D(DIRUT) EXIT
|
|
S FBDTP=Y
|
|
;
|
|
; ask device
|
|
S %ZIS="QM" D ^%ZIS G:POP EXIT
|
|
I $D(IO("Q")) D G EXIT
|
|
. S ZTRTN="QEN^FBFHLP",ZTDESC="FB FPPS Message Text Purge"
|
|
. F FBX="FBDTP" S ZTSAVE(FBX)=""
|
|
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
|
|
;
|
|
QEN ; queued entry
|
|
U IO
|
|
;
|
|
PURGE ; Start Purge
|
|
S FBPG=0 D NOW^%DTC S Y=% D DD^%DT S FBDTR=Y
|
|
K FBDL S FBDL="",$P(FBDL,"-",IOM)=""
|
|
;
|
|
; build page header text for selection criteria
|
|
S FBHDT(1)=" For Messages Transmitted Prior To "_$$FMTE^XLFDT(FBDTP)
|
|
;
|
|
D HD
|
|
;
|
|
S FBQUIT=0
|
|
;
|
|
; initialize counters
|
|
S FBC=0 ; count of messages processed
|
|
S FBC("PRG")=0 ; count of message text purged
|
|
;
|
|
W !,"Starting Purge..."
|
|
;
|
|
; loop thru entries by MESSAGE DATE/TIME x-ref by date
|
|
S FBDT=0
|
|
F S FBDT=$O(^FBHL(163.5,"AMD",FBDT)) Q:FBDT=""!($P(FBDT,".")>FBDTP) D Q:FBQUIT
|
|
. S FBDA=0 F S FBDA=$O(^FBHL(163.5,"AMD",FBDT,FBDA)) Q:'FBDA D Q:FBQUIT
|
|
. . S FBC=FBC+1 ; increment count of records processed
|
|
. . ; if tasked then check for stop request
|
|
. . I $D(ZTQUEUED),FBC\1000,$$S^%ZTLOAD S ZTSTOP=1,FBQUIT=1 Q
|
|
. . Q:$O(^FBHL(163.5,FBDA,1,0))'>0 ; quit if no data in message text
|
|
. . ;
|
|
. . ; check if OK to purge
|
|
. . S FBPRG=0 ; init as NO
|
|
. . S FBY=$G(^FBHL(163.5,FBDA,0))
|
|
. . I $P(FBY,U,8)="A" S FBPRG=1 ; was accepted
|
|
. . I 'FBPRG D
|
|
. . . ; check if last entry for invoice was accepted
|
|
. . . N FBLDA
|
|
. . . S FBLDA=$$LAST^FBFHLU($P(FBY,U))
|
|
. . . I FBLDA,FBLDA'=FBDA,$P($G(^FBHL(163.5,FBLDA,0)),U,8)="A" S FBPRG=1
|
|
. . ;
|
|
. . ; if OK then purge
|
|
. . I FBPRG D WP^DIE(163.5,FBDA_",",7,"","@") S FBC("PRG")=FBC("PRG")+1
|
|
;
|
|
I 'FBQUIT W !,"Purge Completed."
|
|
;
|
|
W !!,"The message text was purged from ",FBC("PRG")," entr",$S(FBC("PRG")=1:"y",1:"ies")," in file 163.5."
|
|
;
|
|
I FBQUIT W !!,"REPORT STOPPED AT USER REQUEST"
|
|
;
|
|
I 'FBQUIT,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
|
|
D ^%ZISC
|
|
;
|
|
EXIT ;
|
|
I $D(ZTQUEUED) S ZTREQ="@"
|
|
K FBC,FBDA,FBDL,FBDT,FBDTP,FBDTR,FBHDT,FBPG,FBPRG,FBQUIT,FBX,FBY
|
|
K %,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,J,POP,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 !,"FPPS Message Text Purge",?49,FBDTR,?72,"page ",FBPG
|
|
S FBI=0 F S FBI=$O(FBHDT(FBI)) Q:'FBI W !,FBHDT(FBI)
|
|
W !,FBDL
|
|
Q
|
|
;
|
|
;FBFHLP
|