23 lines
1.6 KiB
Mathematica
23 lines
1.6 KiB
Mathematica
PRCOSS3 ;WISC/DJM-SSO Server Interface to IFCAP ;7/8/94 09:03
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
EN1 ;CALLED FROM PRCHUSER PPM OPTION MENU ENTRY ACTION.
|
|
;NOTIFY PPM THAT NEW REPETITIVE ITEM LIST ENTRIES NEED TO BE MADE INTO 2237s.
|
|
N CONT,CP,SITE,XX,Y
|
|
S XX=0,CONT="" F S XX=$O(^PRCS(410.3,"AC",65,XX)) Q:XX'>0 S Y=$P(^PRCS(410.3,XX,0),U),SITE=+Y,CP=$P(Y,"-",4) D:$D(^PRC(420,"C",DUZ,SITE,CP,DUZ))#2=1 Q:CONT>0
|
|
.I $D(^PRC(420,"A",DUZ,SITE,CP,1))!($D(^(2))) S CONT=1 W $C(7),!!!,?3,"There are new REPETITIVE ITEM LIST entries created from ISMS SSO",!,?3,"transactions ready to be generated into 2237's."
|
|
Q
|
|
DISP ;CALLED FROM ^PRCSRIG OR EDIT^PRCSRIE1.
|
|
;DISPLAY ALL REPETITIVE ITEM LISTS THAT THE USER IS A CONTROL POINT OFFICIAL OR CLERK FOR THE SUPPLY FUND WAREHOUSE SITE AND SUPPLY FUND CONTROL POINT.
|
|
N CP,HDR,HDR1,SITE,XX,Y,Y1,Y2
|
|
S XX=0,HDR="" F S XX=$O(^PRCS(410.3,"AC",65,XX)) Q:XX'>0 S Y=^PRCS(410.3,XX,0),Y1=$P(Y,U),SITE=+Y1,CP=$P(Y1,"-",4) D:$D(^PRC(420,"C",DUZ,SITE,CP,DUZ))#2=1
|
|
.I $D(^PRC(420,"A",DUZ,SITE,CP,1))!($D(^(2))) D:HDR'>0 S Y2=$P(Y,U,4) W !,Y1," ",$E(Y2,4,5)_"-"_$E(Y2,6,7)_"-"_$E(Y2,2,3) W:$G(^PRCS(410.3,XX,1,0))]"" ?39,"# OF ITEMS: ",$P(^(0),U,4) W ?55,"TOTAL COST: ",$J($P(Y,U,2),9,2)
|
|
..S HDR=1,HDR1="REPETITIVE ITEM LIST FROM 'SSO' TRANSACTIONS" W !!!,?(IOM-$L(HDR1)/2),HDR1,! Q
|
|
W ! Q
|
|
CLOSE ;CALLED FROM ^PRCSRIG.
|
|
;REMOVES 'NEW SSO' FIELD FROM RECORD. THIS ALSO REMOVES THE 'AC'
|
|
;X-REF WHICH STOPS THE DISPLAY OF THE RECORD AS ONE TO BE GENERATED.
|
|
N DA,DIE,DR
|
|
S DIE="^PRCS(410.3,",DR="7///@",DA=PRCSRID0 D ^DIE
|