source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRODA.m@ 1006

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

initial load of WorldVistAEHR

File size: 5.1 KB
Line 
1PRCPRODA ;WOIFO/VAC-On-Demand Audit Activity Report ; 2/22/07 9:05am
2 ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5PRIMARY ;This routine displays the audit information on On-Demand Items updates
6 N X,Y,GROUPALL,SRT,GROUP,ITEMFLG,PERS1,PERSNAM,TIMFLG,GR,GROUPYES
7 N ITEMSEL,DATESTRT,DATEEND,GRPFLG,DESCR,NOW,ORDER,PRCPFLAG,X1,X2
8 N POP,ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE
9 K ^TMP($J,"PRCPRODA")
10 S DATESTRT=1,DATEEND=9999999
11 D ^PRCPUSEL Q:'$G(PRCP("I"))
12 K X S X(1)="The On-Demand Audit Report will print the audit trail for items in Primary and/or Secondary Inventory that are either designated as ODI or were designated as ODI but are not now."
13 D DISPLAY^PRCPUX2(2,79,.X)
14 ; Prompt for All or single item
15 K X S X(1)="Select specific items to display."
16 D DISPLAY^PRCPUX2(2,40,.X)
17 S ITEMSEL=$$SINGIT^PRCPUX2(PRCP("I"))
18 I ITEMSEL="^" Q
19 ; set up ^TMP is single item selected, skip remaining prompts
20 I ITEMSEL'="" D G BEGIN
21 .S ORDER=ITEMSEL
22 .S GRPFLG=$P($G(^PRCP(445,PRCP("I"),1,ITEMSEL,0)),"^",21)
23 .I GRPFLG="" S GRPFLG=0
24 .S DESCR=$$DESCR^PRCPUX1(PRCP("I"),ITEMSEL)
25 .S:DESCR="" DESCR=" "
26 .S I=0 F S I=$O(^PRCP(445,PRCP("I"),1,ITEMSEL,10,I)) Q:+I=0 D
27 ..S TIMFLG=($G(^PRCP(445,PRCP("I"),1,ITEMSEL,10,I,0))*(-1))
28 ..S ^TMP($J,"PRCPRODA",GRPFLG,PRCP("I"),ORDER,TIMFLG)=ITEMSEL_"^"_DESCR_"^"_$G(^PRCP(445,PRCP("I"),1,ITEMSEL,10,I,0))
29 W !
30 K X S X(1)="Select the date range which should be used for displaying the usage."
31 D DISPLAY^PRCPUX2(2,40,.X)
32 ;Select a date range to print
33 D DATESEL^PRCPURS2("") I '$G(DATEEND) D Q Q
34 S X1=DATEEND,X2=DATESTRT D ^%DTC
35 W !,"-- TOTAL NUMBER OF DAYS: ",X+1,!
36 K X S X(1)=""
37 K X S X(1)="Select the Group categories to display." D DISPLAY^PRCPUX2(2,40,.X)
38 D GROUPSEL^PRCPURS1(PRCP("I"))
39 I '$G(GROUPALL),'$O(^TMP($J,"PRCPURS1","YES",0)) W !,"*** NO GROUP CATEGORIES SELECTED !" D Q Q
40 W !,"NOTE: The report will",$S('$G(GROUPALL):" NOT",1:"")," include items not stored in a group category."
41DESC ; Ask user for Item#/Description sort preference
42 S SRT=$$SRTPRMP^PRCPUX2(0)
43 Q:SRT=0
44 I (+SRT<1)!(SRT>2) G DESC
45 ;
46BEGIN S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD,HOME^%ZIS K IO("Q"),ZTSK Q
47 . S ZTDESC="ON-DEMAND AUDIT REPORT",ZTRTN="DQ^PRCPRODA"
48 . S ZTSAVE("PRCP*")="",ZTSAVE("GROUP*")="",ZTSAVE("^TMP($J,""PRCPURS1"",")="",ZTSAVE("ZTREQ")="@",ZTSAVE("S*")=""
49 . S ZTSAVE("DATE*")="",ZTSAVE("ITEM*")=""
50 W !!,"<*> please wait <*>"
51DQ ; queue starts here
52 N X,Y,%,ITEMDA,D,CTR,DESCR,ORDER,I,PAGE,SCREEN
53 N PRCPFLAG,GRPDESC,DIST,DAT,DATE0,DATE1,DATE2
54 I ITEMSEL'="" G REPORT
55 S ITEMDA=0 F S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA S D=$G(^(ITEMDA,0)) I D'="" D
56 .; If no audit trail quit
57 .I $G(^PRCP(445,PRCP("I"),1,ITEMDA,10,0))="" Q
58 .S DESCR=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA) S:DESCR="" DESCR=" "
59 .; Determine the Group
60 .S GROUP=+$P(D,"^",21),GRPFLG=GROUP
61 .S GROUPYES="NO"
62 .I $G(GROUPALL)=1 S GROUPYES="YES"
63 .I $G(GROUPALL)="" D
64 ..S GR="" F S GR=$O(^TMP($J,"PRCPURS1","YES",GR)) Q:GR="" D
65 ...I GR=GRPFLG S GROUPYES="YES"
66 .Q:GROUPYES="NO"
67 .I SRT=1 S ORDER=DESCR
68 .I SRT=2 S ORDER=ITEMDA
69 .S I=0 F S I=$O(^PRCP(445,PRCP("I"),1,ITEMDA,10,I)) Q:+I=0 D
70 . . S TIMFLG=+$P($G(^PRCP(445,PRCP("I"),1,ITEMDA,10,I,0)),".",1)
71 . . Q:TIMFLG<DATESTRT
72 . . Q:TIMFLG>DATEEND
73 . . S TIMFLG=TIMFLG*(-1)
74 . . S ^TMP($J,"PRCPRODA",GRPFLG,PRCP("I"),ORDER,TIMFLG)=ITEMDA_"^"_DESCR_"^"_$G(^PRCP(445,PRCP("I"),1,ITEMDA,10,I,0))
75 ;
76REPORT ; Print Report
77 D NOW^%DTC S Y=% D DD^%DT S NOW=$P(Y,"@",1),PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
78 ;
79 S GROUP="" F S GROUP=$O(^TMP($J,"PRCPRODA",GROUP)) Q:GROUP="" D Q:$D(PRCPFLAG)
80 . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINIATED BY USER >>>" Q
81 .I $Y>(IOSL-8) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
82 .I GROUP=0 S GRPDESC="<<NONE>>"
83 .I GROUP'=0 D
84 .. S GRPDESC=$$GROUPNM^PRCPEGRP(GROUP)
85 .. S GRPDESC=$E(GRPDESC,1,20)_" (#"_GROUP_")"
86 . W !?7,"GROUP: ",GRPDESC,!
87 . S DIST="" F S DIST=$O(^TMP($J,"PRCPRODA",GROUP,DIST)) Q:DIST="" D Q:$D(PRCPFLAG)
88 .. S ORDER="" F S ORDER=$O(^TMP($J,"PRCPRODA",GROUP,DIST,ORDER)) Q:ORDER="" D Q:$D(PRCPFLAG)
89 ... S ITEMFLG=""
90 ... S TIMFLG="" F S TIMFLG=$O(^TMP($J,"PRCPRODA",GROUP,DIST,ORDER,TIMFLG)) Q:TIMFLG="" D Q:$D(PRCPFLAG)
91 .... S ITEMDA=$G(^TMP($J,"PRCPRODA",GROUP,DIST,ORDER,TIMFLG)) Q:ITEMDA=""
92 .... I ITEMFLG="" D Q:$D(PRCPFLAG)
93 ..... I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
94 ..... W !,$P(ITEMDA,"^",1),?9,$P(ITEMDA,"^",2) S ITEMFLG="X"
95 ....S DATE0=$P(ITEMDA,"^",3),DATE1=$P($$FMTE^XLFDT(DATE0,2),"@",1),DATE2=$P($$FMTE^XLFDT(DATE0,3),"@",2)
96 ....S PERS1=$P(ITEMDA,"^",4),PERSNAM=$P(^VA(200,PERS1,20),"^",2)
97 ....I $Y>(IOSL-5) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
98 ....W !,?9,$P(ITEMDA,"^",6),?12,DATE1,?21,DATE2,?32,$E(PERSNAM,1,15),?49,$E($P(ITEMDA,"^",5),1,30)
99 ... W !
100 .. W !
101 I '$G(PRCPFLAG) D END^PRCPUREP
102Q D ^%ZISC K ^TMP($J,"PRCPRODA"),^TMP($J,"PRCPURS1")
103 Q
104H ;PRINT HEADING
105 S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
106 W "ON-DEMAND AUDIT FOR: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
107 S %="",$P(%,"-",81)=""
108 W !,"IM#",?9,"DESCRIPTION"
109 W !,?32,"INVENTORY POINT"
110 W !,?3,"SETTING",?12,"DATE/TIME",?38,"USER",?49,"REASON"
111 W !,%,!
112 Q
Note: See TracBrowser for help on using the repository browser.