PRCPUDPT ;WISC/RFJ-distribution point selection ;10 Sep 93
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
TO(INVPT) ; select the distr pt which invpt distributes stock TO
; return da; 0 no item selected; ^ for ^ entered or timeout
I '$D(^PRCP(445,+INVPT,0)) Q ""
N %,C,DA,DIC,DISYS,DTOUT,DUOUT,I,PRCPPRIV,X,Y
S:'$D(^PRCP(445,INVPT,2,0)) ^(0)="^445.03PA^^"
S DIC="^PRCP(445,"_INVPT_",2,",DIC(0)="QEAM",DIC("W")="I $P($G(^PRCP(445,Y,0)),U,2)=""Y"" W ?60,""KEEP PERPETUAL INV""",DA=INVPT,PRCPPRIV=1
W ! D ^DIC
Q $S($G(DUOUT):"^",$G(DTOUT):"^",Y<1:0,1:+Y)
;
;
FROM(DISTRPT) ; select the inventory pt which distrpt receives stock FROM
; return da; 0 no item selected; ^ for ^ entered or timeout
I '$D(^PRCP(445,+DISTRPT,0)) Q 0
N %,DIC,DTOUT,DUOUT,PRCPPRIV,TYPE,X,Y
S TYPE=$P(^PRCP(445,DISTRPT,0),"^",3)
S DIC="^PRCP(445,",DIC(0)="QEAM",DIC("S")="I $D(^PRCP(445,+Y,2,DISTRPT)),$P(^PRCP(445,+Y,0),U,3)="_$S(TYPE="P":"""W""",TYPE="S":"""P""",1:"""""")
S DIC("A")="Select "_$S(TYPE="P":"WAREHOUSE",TYPE="S":"PRIMARY",1:"")_" Inventory Distribution Point: ",PRCPPRIV=1
W ! D ^DIC
Q $S($G(DUOUT):"^",$G(DTOUT):"^",Y<1:0,1:+Y)
;
;
FROMCHEK(DISTRPT,SELECT) ; check to see if distrpt is stocked by none
; or one inventory points
; pass select=1 to ask for selection if stocked by more than one
; return da if stocked by one, 0 otherwise
; set variable prcpfone=1 if only stocked by one inventory pt
; set variable prcpfnon=1 if not stocked by any inventory pts
K PRCPFONE,PRCPFNON
N %,DA,X
S X=0 F %=0:1 S X=$O(^PRCP(445,"AB",+DISTRPT,X)) Q:'X S DA=X
I '% S PRCPFNON=1 Q 0
I %=1 S PRCPFONE=1 Q DA
I 'SELECT Q 0
Q $$FROM(DISTRPT)
;
;
SPD(DISTRPT,SELECT) ; lookup and return only spd inventory point
; distrpt=secondary invpt stocked by spd
; select =ask for selection if set to 1
N SPD
S SPD=+$O(^PRCP(445,"ASPEC","S",0))
I '$D(^PRCP(445,SPD,2,+DISTRPT,0)) S SPD=""
I SPD="",SELECT Q $$FROMCHEK(DISTRPT,1)
I SPD="" Q 0
Q SPD
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPUDPT 2094 printed Dec 13, 2024@02:16:07 Page 2
PRCPUDPT ;WISC/RFJ-distribution point selection ;10 Sep 93
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
TO(INVPT) ; select the distr pt which invpt distributes stock TO
+1 ; return da; 0 no item selected; ^ for ^ entered or timeout
+2 IF '$DATA(^PRCP(445,+INVPT,0))
QUIT ""
+3 NEW %,C,DA,DIC,DISYS,DTOUT,DUOUT,I,PRCPPRIV,X,Y
+4 if '$DATA(^PRCP(445,INVPT,2,0))
SET ^(0)="^445.03PA^^"
+5 SET DIC="^PRCP(445,"_INVPT_",2,"
SET DIC(0)="QEAM"
SET DIC("W")="I $P($G(^PRCP(445,Y,0)),U,2)=""Y"" W ?60,""KEEP PERPETUAL INV"""
SET DA=INVPT
SET PRCPPRIV=1
+6 WRITE !
DO ^DIC
+7 QUIT $SELECT($GET(DUOUT):"^",$GET(DTOUT):"^",Y<1:0,1:+Y)
+8 ;
+9 ;
FROM(DISTRPT) ; select the inventory pt which distrpt receives stock FROM
+1 ; return da; 0 no item selected; ^ for ^ entered or timeout
+2 IF '$DATA(^PRCP(445,+DISTRPT,0))
QUIT 0
+3 NEW %,DIC,DTOUT,DUOUT,PRCPPRIV,TYPE,X,Y
+4 SET TYPE=$PIECE(^PRCP(445,DISTRPT,0),"^",3)
+5 SET DIC="^PRCP(445,"
SET DIC(0)="QEAM"
SET DIC("S")="I $D(^PRCP(445,+Y,2,DISTRPT)),$P(^PRCP(445,+Y,0),U,3)="_$SELECT(TYPE="P":"""W""",TYPE="S":"""P""",1:"""""")
+6 SET DIC("A")="Select "_$SELECT(TYPE="P":"WAREHOUSE",TYPE="S":"PRIMARY",1:"")_" Inventory Distribution Point: "
SET PRCPPRIV=1
+7 WRITE !
DO ^DIC
+8 QUIT $SELECT($GET(DUOUT):"^",$GET(DTOUT):"^",Y<1:0,1:+Y)
+9 ;
+10 ;
FROMCHEK(DISTRPT,SELECT) ; check to see if distrpt is stocked by none
+1 ; or one inventory points
+2 ; pass select=1 to ask for selection if stocked by more than one
+3 ; return da if stocked by one, 0 otherwise
+4 ; set variable prcpfone=1 if only stocked by one inventory pt
+5 ; set variable prcpfnon=1 if not stocked by any inventory pts
+6 KILL PRCPFONE,PRCPFNON
+7 NEW %,DA,X
+8 SET X=0
FOR %=0:1
SET X=$ORDER(^PRCP(445,"AB",+DISTRPT,X))
if 'X
QUIT
SET DA=X
+9 IF '%
SET PRCPFNON=1
QUIT 0
+10 IF %=1
SET PRCPFONE=1
QUIT DA
+11 IF 'SELECT
QUIT 0
+12 QUIT $$FROM(DISTRPT)
+13 ;
+14 ;
SPD(DISTRPT,SELECT) ; lookup and return only spd inventory point
+1 ; distrpt=secondary invpt stocked by spd
+2 ; select =ask for selection if set to 1
+3 NEW SPD
+4 SET SPD=+$ORDER(^PRCP(445,"ASPEC","S",0))
+5 IF '$DATA(^PRCP(445,SPD,2,+DISTRPT,0))
SET SPD=""
+6 IF SPD=""
IF SELECT
QUIT $$FROMCHEK(DISTRPT,1)
+7 IF SPD=""
QUIT 0
+8 QUIT SPD
