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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCOSS3 1648 printed Oct 16, 2024@18:12:58 Page 2
PRCOSS3 ;WISC/DJM-SSO Server Interface to IFCAP ;7/8/94 09:03
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 QUIT
EN1 ;CALLED FROM PRCHUSER PPM OPTION MENU ENTRY ACTION.
+1 ;NOTIFY PPM THAT NEW REPETITIVE ITEM LIST ENTRIES NEED TO BE MADE INTO 2237s.
+2 NEW CONT,CP,SITE,XX,Y
+3 SET XX=0
SET CONT=""
FOR
SET XX=$ORDER(^PRCS(410.3,"AC",65,XX))
if XX'>0
QUIT
SET Y=$PIECE(^PRCS(410.3,XX,0),U)
SET SITE=+Y
SET CP=$PIECE(Y,"-",4)
if $DATA(^PRC(420,"C",DUZ,SITE,CP,DUZ))#2=1
Begin DoDot:1
+4 IF $DATA(^PRC(420,"A",DUZ,SITE,CP,1))!($DATA(^(2)))
SET CONT=1
WRITE $CHAR(7),!!!,?3,"There are new REPETITIVE ITEM LIST entries created from ISMS SSO",!,?3,"transactions ready to be generated into 2237's."
End DoDot:1
if CONT>0
QUIT
+5 QUIT
DISP ;CALLED FROM ^PRCSRIG OR EDIT^PRCSRIE1.
+1 ;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.
+2 NEW CP,HDR,HDR1,SITE,XX,Y,Y1,Y2
+3 SET XX=0
SET HDR=""
FOR
SET XX=$ORDER(^PRCS(410.3,"AC",65,XX))
if XX'>0
QUIT
SET Y=^PRCS(410.3,XX,0)
SET Y1=$PIECE(Y,U)
SET SITE=+Y1
SET CP=$PIECE(Y1,"-",4)
if $DATA(^PRC(420,"C",DUZ,SITE,CP,DUZ))#2=1
Begin DoDot:1
+4 IF $DATA(^PRC(420,"A",DUZ,SITE,CP,1))!($DATA(^(2)))
if HDR'>0
Begin DoDot:2
+5 SET HDR=1
SET HDR1="REPETITIVE ITEM LIST FROM 'SSO' TRANSACTIONS"
WRITE !!!,?(IOM-$LENGTH(HDR1)/2),HDR1,!
QUIT
End DoDot:2
SET Y2=$PIECE(Y,U,4)
WRITE !,Y1," ",$EXTRACT(Y2,4,5)_"-"_$EXTRACT(Y2,6,7)_"-"_$EXTRACT(Y2,2,3)
if $GET(^PRCS(410.3,XX,1,0))]""
WRITE ?39,"# OF ITEMS: ",$PIECE(^(0),U,4)
WRITE ?55,"TOTAL COST: ",$JUSTIFY($PIECE(Y,U,2),9,2)
End DoDot:1
+6 WRITE !
QUIT
CLOSE ;CALLED FROM ^PRCSRIG.
+1 ;REMOVES 'NEW SSO' FIELD FROM RECORD. THIS ALSO REMOVES THE 'AC'
+2 ;X-REF WHICH STOPS THE DISPLAY OF THE RECORD AS ONE TO BE GENERATED.
+3 NEW DA,DIE,DR
+4 SET DIE="^PRCS(410.3,"
SET DR="7///@"
SET DA=PRCSRID0
DO ^DIE
