| 1 | IBPO ;ALB/CPM - ARCHIVE/PURGING OUTPUTS ; 23-APR-92
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | LST ; List Archive/Purge Log Entries
|
|---|
| 6 | S DIC="^IBE(350.6,",FLDS="[IB PURGE LIST LOG ENTRIES]",L=0,(BY,FR,TO)=""
|
|---|
| 7 | D EN1^DIP
|
|---|
| 8 | Q
|
|---|
| 9 | ;
|
|---|
| 10 | ;
|
|---|
| 11 | INQ ; Archive/Purge Log Inquiry
|
|---|
| 12 | S DIC="^IBE(350.6,",DIC(0)="QEAMZ",DIC("A")="Select LOG #: " D ^DIC K DIC G INQQ:Y<0 S IBDA=+Y
|
|---|
| 13 | S %ZIS="QM" D ^%ZIS G:POP INQQ
|
|---|
| 14 | I $D(IO("Q")) S ZTRTN="INQS^IBPO",ZTSAVE("IBDA")="",ZTDESC="ARCHIVE/PURGE LOG INQUIRY" D ^%ZTLOAD K IO("Q") D HOME^%ZIS G INQQ
|
|---|
| 15 | U IO
|
|---|
| 16 | ;
|
|---|
| 17 | INQS ; Tasked Entry Point
|
|---|
| 18 | D NOW^%DTC W:$E(IOST,1,2)["C-" @IOF,*13 W " LOG #: ",IBDA,?15,$S($D(^DIC($P($G(^IBE(350.6,+IBDA,0)),"^",3),0)):$P(^(0),"^"),1:"FILE UNSPECIFIED"),?(IOM-25),$$DAT2^IBOUTL(%),!
|
|---|
| 19 | F I=1:1:IOM W "="
|
|---|
| 20 | S IBLOG0=$G(^IBE(350.6,+IBDA,0)),IBLOG1=$G(^(1)),IBLOG2=$G(^(2)),IBLOG3=$G(^(3))
|
|---|
| 21 | W !!,$J("Search Template : ",27),$S($P(IBLOG0,"^",2)]"":$P(IBLOG0,"^",2),1:"UNSPECIFIED")
|
|---|
| 22 | S IBX=$S($P(IBLOG3,"^",2):"Purged",$P(IBLOG2,"^",2):"Archived",1:"Found")
|
|---|
| 23 | W !,$J("# Records "_IBX_" : ",27),+$P(IBLOG0,"^",4)
|
|---|
| 24 | W !,$J("Log Status : ",27),$P("OPEN^CLOSED^CANCELLED","^",+$P(IBLOG0,"^",5))
|
|---|
| 25 | F I=1,2,3 D
|
|---|
| 26 | . S IBNOD="IBLOG"_I,IBNAM=$P("Search^Archive^Purge","^",I)
|
|---|
| 27 | . Q:@IBNOD=""
|
|---|
| 28 | . S Y=+@IBNOD W !!,$J(IBNAM_" Begin Date/Time : ",27),$S(Y:$$DAT2^IBOUTL(Y),1:"UNSPECIFIED")
|
|---|
| 29 | . S Y=$P(@IBNOD,"^",2) W !,$J(IBNAM_" End Date/Time : ",27),$S('Y:"UNSPECIFIED",1:$$DAT2^IBOUTL(Y))
|
|---|
| 30 | . S Y=$P(@IBNOD,"^",3) W !,$J(IBNAM_" Initiator : ",27),$S($D(^VA(200,Y,0)):$P(^(0),"^"),1:"UNSPECIFIED")
|
|---|
| 31 | F I=$Y:1:(IOSL-4) W !
|
|---|
| 32 | I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
|
|---|
| 33 | Q:$D(ZTQUEUED) D ^%ZISC
|
|---|
| 34 | INQQ K DIRUT,DUOUT,DTOUT,IBDA,IBLOG0,IBLOG1,IBLOG2,IBLOG3,IBX,X,Y
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | ;
|
|---|
| 38 | TMP ; List Search Template Entries
|
|---|
| 39 | S IBF=$$SEL^IBPUDEL G TMPQ:'IBF
|
|---|
| 40 | ;
|
|---|
| 41 | ; - display selection
|
|---|
| 42 | W ! F I=1:1:80 W "-"
|
|---|
| 43 | W !,"Template entries will be listed for the following file:"
|
|---|
| 44 | S IBOP=$P(IBD(IBF),"^",2),IBLOG=$P(IBD(IBF),"^",3)
|
|---|
| 45 | W !,$P($G(^DIC(IBF,0)),"^")," Entries ",$S(IBOP>2:"Archived",1:"Found")," on ",$$DAT2^IBOUTL($P($G(^IBE(350.6,IBLOG,IBOP-1)),"^",2)),!
|
|---|
| 46 | F I=1:1:80 W "-"
|
|---|
| 47 | W !!,"Specify Sort Criteria:",!
|
|---|
| 48 | ;
|
|---|
| 49 | ; - print list
|
|---|
| 50 | S DIC=^DIC(IBF,0,"GL"),L=0,FLDS=$S(IBF=399:".02;L25,.07;L20,.13;L10,.14",IBF=351:".02,.03,.04,.1",1:".02;L25,.08,.05;L10,DATE(#12);""DATE ADDED""")
|
|---|
| 51 | S BY="[IB ARCHIVE/PURGE #"_$$LOGIEN^IBPU1(IBF)_"],@.02,@",DHD=$P(^DIC(IBF,0),"^")_" SEARCH TEMPLATE"
|
|---|
| 52 | D EN1^DIP
|
|---|
| 53 | ;
|
|---|
| 54 | TMPQ K I,IBD,IBF,IBLOG,IBOP,IBTM,IBTMDA,J,K
|
|---|
| 55 | Q
|
|---|
