source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCOSS3.m@ 1150

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

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1PRCOSS3 ;WISC/DJM-SSO Server Interface to IFCAP ;7/8/94 09:03
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5EN1 ;CALLED FROM PRCHUSER PPM OPTION MENU ENTRY ACTION.
6 ;NOTIFY PPM THAT NEW REPETITIVE ITEM LIST ENTRIES NEED TO BE MADE INTO 2237s.
7 N CONT,CP,SITE,XX,Y
8 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
9 .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."
10 Q
11DISP ;CALLED FROM ^PRCSRIG OR EDIT^PRCSRIE1.
12 ;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.
13 N CP,HDR,HDR1,SITE,XX,Y,Y1,Y2
14 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
15 .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)
16 ..S HDR=1,HDR1="REPETITIVE ITEM LIST FROM 'SSO' TRANSACTIONS" W !!!,?(IOM-$L(HDR1)/2),HDR1,! Q
17 W ! Q
18CLOSE ;CALLED FROM ^PRCSRIG.
19 ;REMOVES 'NEW SSO' FIELD FROM RECORD. THIS ALSO REMOVES THE 'AC'
20 ;X-REF WHICH STOPS THE DISPLAY OF THE RECORD AS ONE TO BE GENERATED.
21 N DA,DIE,DR
22 S DIE="^PRCS(410.3,",DR="7///@",DA=PRCSRID0 D ^DIE
Note: See TracBrowser for help on using the repository browser.