source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBPO.m@ 1464

Last change on this file since 1464 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1IBPO ;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 ;
5LST ; 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 ;
11INQ ; 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 ;
17INQS ; 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
34INQQ K DIRUT,DUOUT,DTOUT,IBDA,IBLOG0,IBLOG1,IBLOG2,IBLOG3,IBX,X,Y
35 Q
36 ;
37 ;
38TMP ; 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 ;
54TMPQ K I,IBD,IBF,IBLOG,IBOP,IBTM,IBTMDA,J,K
55 Q
Note: See TracBrowser for help on using the repository browser.