PRCPUTIL.m

PRCPUTIL ;(WIRMFO)/DXH,DGL - GIP utilities ; 10.7.99

 ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 Q

 ;

QTY ; utility to maintain the quantities for selected Inventory Points

 ;  as they are replenished via receipts against a Purchase Order

 ;  line item which they are sharing with other Inventory Points

 ;  PRC*5*197

 ;       da(3)=>p.o.

 ;       da(2)=>item

 ;       da(1)=>date received

 ;       da=>inventory point

 N QTY,PRCP,PRCPDA

 S PRCP("IP")=$P(^PRC(442,DA(3),2,DA(2),3,DA(1),1,DA,0),U)

 S (QTY,PRCPDA)=0 F  S PRCPDA=$O(^PRC(442,DA(3),2,DA(2),3,PRCPDA)) Q:'PRCPDA  S PRCP("DT")=$O(^(PRCPDA,1,"B",PRCP("IP"),0)) D:PRCP("DT")

 . S QTY=QTY+$P(^PRC(442,DA(3),2,DA(2),3,PRCPDA,1,PRCP("DT"),0),U,2)

 S PRCP("LP")=$O(^PRC(442,DA(3),2,DA(2),5,"B",PRCP("IP"),0)) S:PRCP("LP") $P(^PRC(442,DA(3),2,DA(2),5,PRCP("LP"),0),U,4)=QTY

 Q

 ;

DISPIP(FCPDA) ; display inv pts for FCP

 I '$D(^PRC(420,+$G(PRC("SITE")),1,+FCPDA,7,0)) Q

 N I

 S I=0

 F  S I=$O(^PRC(420,"AF",+$G(PRC("SITE")),+FCPDA,I)) Q:'I   W !,?10,$P($G(^PRCP(445,I,0)),U,1)

 Q

 ;

DISPFCP(IP) ; display FCP for inv pt

 Q:'$O(^PRC(420,"AE",+PRC("SITE"),IP,0))

 N FCP

 S (FCP,CNT)=0

 W !!,"To make a change, first select the existing control point and 'unlink' it.",!,"Then select a new one if you want to."

 W !!,"Current selection:"

 F  S FCP=$O(^PRC(420,"AE",+PRC("SITE"),IP,FCP)) Q:'FCP  W:CNT ! W ?20,$P($G(^PRC(420,+PRC("SITE"),1,FCP,0)),U) S CNT=CNT+1

 Q

 ;

 ;PRCPUTIL

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCPUTIL   1519     printed  Apr 09, 2024@21:19:54                                                                                                                                                                                                    Page 2

PRCPUTIL  ;(WIRMFO)/DXH,DGL - GIP utilities ; 10.7.99

 +1       ;;5.1;IFCAP;;Oct 20, 2000

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        QUIT 

 +4       ;

QTY       ; utility to maintain the quantities for selected Inventory Points

 +1       ;  as they are replenished via receipts against a Purchase Order

 +2       ;  line item which they are sharing with other Inventory Points

 +3       ;  PRC*5*197

 +4       ;       da(3)=>p.o.

 +5       ;       da(2)=>item

 +6       ;       da(1)=>date received

 +7       ;       da=>inventory point

 +8        NEW QTY,PRCP,PRCPDA

 +9        SET PRCP("IP")=$PIECE(^PRC(442,DA(3),2,DA(2),3,DA(1),1,DA,0),U)

 +10       SET (QTY,PRCPDA)=0

           FOR 

               SET PRCPDA=$ORDER(^PRC(442,DA(3),2,DA(2),3,PRCPDA))

               if 'PRCPDA

                   QUIT 

               SET PRCP("DT")=$ORDER(^(PRCPDA,1,"B",PRCP("IP"),0))

               if PRCP("DT")

                   Begin DoDot:1

 +11                   SET QTY=QTY+$PIECE(^PRC(442,DA(3),2,DA(2),3,PRCPDA,1,PRCP("DT"),0),U,2)

                   End DoDot:1

 +12       SET PRCP("LP")=$ORDER(^PRC(442,DA(3),2,DA(2),5,"B",PRCP("IP"),0))

           if PRCP("LP")

               SET $PIECE(^PRC(442,DA(3),2,DA(2),5,PRCP("LP"),0),U,4)=QTY

 +13       QUIT 

 +14      ;

DISPIP(FCPDA) ; display inv pts for FCP

 +1        IF '$DATA(^PRC(420,+$GET(PRC("SITE")),1,+FCPDA,7,0))

               QUIT 

 +2        NEW I

 +3        SET I=0

 +4        FOR 

               SET I=$ORDER(^PRC(420,"AF",+$GET(PRC("SITE")),+FCPDA,I))

               if 'I

                   QUIT 

               WRITE !,?10,$PIECE($GET(^PRCP(445,I,0)),U,1)

 +5        QUIT 

 +6       ;

DISPFCP(IP) ; display FCP for inv pt

 +1        if '$ORDER(^PRC(420,"AE",+PRC("SITE"),IP,0))

               QUIT 

 +2        NEW FCP

 +3        SET (FCP,CNT)=0

 +4        WRITE !!,"To make a change, first select the existing control point and 'unlink' it.",!,"Then select a new one if you want to."

 +5        WRITE !!,"Current selection:"

 +6        FOR 

               SET FCP=$ORDER(^PRC(420,"AE",+PRC("SITE"),IP,FCP))

               if 'FCP

                   QUIT 

               if CNT

                   WRITE !

               WRITE ?20,$PIECE($GET(^PRC(420,+PRC("SITE"),1,FCP,0)),U)

               SET CNT=CNT+1

 +7        QUIT 

 +8       ;

 +9       ;PRCPUTIL