- 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 Feb 18, 2025@23:38:36 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