134 lines
5.0 KiB
Mathematica
134 lines
5.0 KiB
Mathematica
PRCPRODS ;WOIFO/CC/VAC-On-Demand Conflict Report Secondary ; 2/22/07 9:38am
|
|
;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
|
|
;Per VHA Directive 2004-038, this routine should not be modified.
|
|
;*98 Created to identify items in Secondary as ODI but not in Primary
|
|
Q
|
|
PRIM N CTR,I,ITEM,ITEMNAM,J,SECNAME,TOTREC
|
|
N LST,MGRFLG,NOW,NOWDT,PAGE,PRCPFLAG,PRI,PRIM,SCREEN,SEC,SECNAME,SRT,SORT,USER,X,Y,RECCNT,ODIFLAG,ODIFLAG2,PRINAME
|
|
N POP,ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE
|
|
D ^PRCPUSEL Q:'$G(PRCP("I"))
|
|
K ^TMP($J,"PRCPRODS")
|
|
S PAGE=1
|
|
D NOW^%DTC S NOWDT=X,Y=% D DD^%DT S NOW=Y,SCREEN=$$SCRPAUSE^PRCPUREP
|
|
K X S X(1)="The On-Demand Conflict Report shows all items that are On-Demand in the Primary and Standard in the Secondary" D DISPLAY^PRCPUX2(40,79,.X)
|
|
S CTR=0
|
|
S X="" F S X=$O(^PRCP(445,PRCP("I"),1,"AC",X)) Q:X="" S CTR=CTR+1
|
|
I +CTR=0 W !,"NO PRIMARY CROSS REFERENCES EXIST FOR THIS SECONDARY" HANG 5 Q
|
|
QUEST ; Select Sort order
|
|
S SRT=$$SRTPRMP^PRCPUX2(0)
|
|
Q:SRT=0
|
|
S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
|
|
.S ZTDESC="On Demand Conflict Report",ZTRTN="REPORT^PRCPRODS"
|
|
.S ZTSAVE("PRCP*")="",ZTSAVE("REPTYPE")="",ZTSAVE("S*")="",ZTSAVE("END*")="",ZTSAVE("NOW*")="",ZTSAVE("COMDT")="",ZTSAVE("PERCENT")="",ZTSAVE("REP")="",ZTSAVE("ZTREQ")="@"
|
|
.S ZTSAVE("S*")="",ZTSAVE("C*")=""
|
|
;
|
|
QUEST2 W !!,"Please wait. Report compiling and printing."
|
|
REPORT ;Now compile the data
|
|
S PRIM=""
|
|
S PRI="" F S PRI=$O(^PRCP(445,PRCP("I"),1,"AC",PRI)) Q:PRI="" D
|
|
.I PRIM="" S PRIM=$P(PRI,";",1)
|
|
.I PRIM'=$P(PRI,";",1) D
|
|
.. S PRIM=$P(PRI,";",1)
|
|
.S ITEM=""
|
|
.F S ITEM=$O(^PRCP(445,PRCP("I"),1,"AC",PRI,ITEM)) Q:ITEM="" D
|
|
..S ODIFLAG=$$ODITEM^PRCPUX2(PRCP("I"),ITEM)
|
|
..S ODIFLAG2=$$ODITEM^PRCPUX2(PRIM,ITEM)
|
|
..;S ITEMNAM=$P($G(^PRCP(445,PRCP("I"),1,ITEM,6)),"^",1)
|
|
..S ITEMNAM=$$DESCR^PRCPUX1(PRCP("I"),ITEM) S:ITEMNAM="" ITEMNAM=" "
|
|
..S SORT=ITEMNAM
|
|
..I SRT=2 S SORT=ITEM
|
|
..I ODIFLAG2="Y" D
|
|
...I (ODIFLAG="N")!(ODIFLAG="") D
|
|
....S ^TMP($J,"PRCPRODS",PRCP("I"),PRIM,SORT,ITEM)=ITEMNAM
|
|
RPT ;Now print the report
|
|
S PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO
|
|
S TOTREC=0
|
|
S SEC=""
|
|
F S SEC=$O(^TMP($J,"PRCPRODS",SEC)) Q:SEC="" D Q:$D(PRCPFLAG)
|
|
.S PRIM=""
|
|
.F S PRIM=$O(^TMP($J,"PRCPRODS",SEC,PRIM)) Q:PRIM="" D Q:$D(PRCPFLAG)
|
|
..S PRINAME=$P($G(^PRCP(445,PRIM,0)),"^",1)
|
|
..D:PAGE>1&SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D HEAD
|
|
..S RECCNT=0
|
|
..S SORT=""
|
|
..F S SORT=$O(^TMP($J,"PRCPRODS",SEC,PRIM,SORT)) Q:SORT="" D Q:$D(PRCPFLAG)
|
|
...S ITEM=""
|
|
...F S ITEM=$O(^TMP($J,"PRCPRODS",SEC,PRIM,SORT,ITEM)) Q:ITEM="" D Q:$D(PRCPFLAG)
|
|
....S ITEMNAM=$G(^TMP($J,"PRCPRODS",SEC,PRIM,SORT,ITEM))
|
|
....W !,ITEM,?11,ITEMNAM
|
|
....S RECCNT=RECCNT+1,TOTREC=TOTREC+1
|
|
....I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D HEAD
|
|
....I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !,?10,"<<<TASKMANAGER JOB TERMINATED BY USER >>>" Q
|
|
...I RECCNT=0 W !,"No Records Found",!
|
|
...Q
|
|
..I '$D(PRCPFLAG) D A
|
|
.Q
|
|
;
|
|
I TOTREC=0 D HEAD2 W !?27,"*** NO CONFLICTS TO PRINT ***"
|
|
I '$D(PRCPFLAG) D:SCREEN END^PRCPUREP
|
|
D ^%ZISC
|
|
D Q Q
|
|
;
|
|
A ; Print authorized users
|
|
I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D HEAD
|
|
S SECNAME=$P($G(^PRCP(445,SEC,0)),"^",1)
|
|
W !!,"AUTHORIZED ON-DEMAND USERS"
|
|
W !,"--------------------------"
|
|
W !,SECNAME,":"
|
|
S USER=0 F S USER=$O(^PRCP(445,SEC,4,USER)) Q:USER="" D Q:$D(PRCPFLAG)
|
|
.S MGRFLG=""
|
|
.I $G(^PRCP(445,SEC,9,0))'="" D
|
|
..S LST=$P($G(^PRCP(445,SEC,9,0)),"^",4)
|
|
..S J=0
|
|
..F I=1:1:LST D Q:$D(PRCPFLAG)
|
|
...S J=$O(^PRCP(445,SEC,9,J))
|
|
...I $G(^PRCP(445,SEC,9,J,0))=USER D
|
|
....I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D HEAD
|
|
....I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
|
|
....Q:$D(PRCPFLAG)
|
|
....W ?30,$E($$USER^PRCPUREP(USER),1,30),!
|
|
...Q:$D(PRCPFLAG)
|
|
..Q:$D(PRCPFLAG)
|
|
.Q:$D(PRCPFLAG)
|
|
D B
|
|
Q
|
|
B ; Display Primary authorized users
|
|
I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D HEAD
|
|
S PRINAME=$P($G(^PRCP(445,PRIM,0)),"^",1)
|
|
W !
|
|
W $E(PRINAME,1,28),":"
|
|
S USER=0 F S USER=$O(^PRCP(445,PRIM,4,USER)) Q:USER="" D Q:$D(PRCPFLAG)
|
|
.S MGRFLG=""
|
|
.I $G(^PRCP(445,PRIM,9,0))'="" D
|
|
..S LST=$P($G(^PRCP(445,PRIM,9,0)),"^",4)
|
|
..S J=0
|
|
..F I=1:1:LST D Q:$D(PRCPFLAG)
|
|
...S J=$O(^PRCP(445,PRIM,9,J))
|
|
...I $G(^PRCP(445,PRIM,9,J,0))=USER D Q:$D(PRCPFLAG)
|
|
....I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D HEAD
|
|
....I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<<TASKMANAGER JOB TERMINATED BY USER >>>" Q
|
|
....W ?30,$E($$USER^PRCPUREP(USER),1,30),!
|
|
...Q:$D(PRCPFLAG)
|
|
..Q:$D(PRCPFLAG)
|
|
.Q:$D(PRCPFLAG)
|
|
Q:$D(PRCPFLAG)
|
|
Q
|
|
;
|
|
HEAD ;Display header information
|
|
Q:$D(PRCPFLAG)
|
|
S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
|
|
S SECNAME=$P($G(^PRCP(445,SEC,0)),"^",1)
|
|
W !,"ON-DEMAND CONFLICTS IN: ",$E(SECNAME,1,24),?50,%
|
|
W !,"PRIMARY INVENTORY POINT: ",PRINAME
|
|
W !!,"IM#",?11,"DESCRIPTION"
|
|
S %="",$P(%,"-",80)="" W !,%,!
|
|
Q
|
|
HEAD2 ;Display header if no records found
|
|
S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
|
|
W !,"SECONDARY ON-DEMAND CONFLICT REPORT",?50,%
|
|
W !!,"IM#",?11,"DESCRIPTION"
|
|
S %="",$P(%,"-",80)="" W !,%,!
|
|
Q
|
|
Q K ^TMP($J,"PRCPRODS")
|
|
Q
|