ACRFSHI1 ;IHS/OIRM/DSD/THL,AEF - SHIPPING INSTRUCTIONS - CON'T; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;TO REVIEW AND EDIT SHIPPING INSTRUCTIONS
ITEMS ;EP - LIST BY ITEM NUMBER ITEMS TO BE SHIPPED
F D IC Q:$D(ACRQUIT)
K ACRQUIT,ACRQUAN,ACRSSI,ACRSS
Q
IDISP ;EP;DISPLAY ITEMS FOR EACH SHIPPING LOCATION
W !
D IARRAY
S ACRSSIDA=0
F S ACRSSIDA=$O(^ACRSI(ACRSIDA,1,ACRSSIDA)) Q:'ACRSSIDA I $D(^ACRSI(ACRSIDA,1,ACRSSIDA,0)) S ACRSSI=^(0) D
.S ACRI=0
.F S ACRI=$O(ACRSS(ACRI)) Q:'ACRI I +ACRSS(ACRI)=+ACRSSI D
..S ACRSSI(ACRI)=ACRSSIDA
..S ACRIMAX=ACRI
..S ACRQUAN(+ACRSSI)=$G(ACRQUAN(+ACRSSI))+$P(ACRSSI,U,2)
..S ACRQUAN(+ACRSSI,ACRSIDA)=$G(ACRQUAN(+ACRSSI,ACRSIDA))+$P(ACRSSI,U,2)
..W !?9,"Item: ",$J(ACRI,6)
..W ?25,"Quantity: ",$J($P(ACRSSI,U,2),6)
..D P
Q
IARRAY ;EP - SET DOCUMENT ITEM ARRAY
K ACRSS
S (ACRJ,ACRSSDA)=0
F S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA D
.S ACRSSDT=$G(^ACRSS(ACRSSDA,"DT"))
.S ACRJ=ACRJ+1
.S ACRSS(ACRJ)=ACRSSDA_U_+ACRSSDT
.S ACRSS("ACRSS",ACRSSDA)=ACRJ_U_+ACRSSDT
Q
IC ;EP;TO CHOOSE ITEM(S) TO ADD OR EDIT CTION
S DIR(0)="SO^1:ADD ITEM for this SHIPPING location"_$S($D(^ACRSI(ACRSIDA,1)):";2:EDIT ITEM for this SHIPPPING location;3:DELETE ITEM from this SHIPPING location",1:"")
W !
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)!'$G(Y)
I Y=1 D IADD Q
I Y=2 D IEDIT Q
I Y=3 D IDELETE Q
Q
IADD D ITEM^ACRFSHIP
Q:$D(ACRQUIT)!$D(ACROUT)
Q:'+$G(ACRITEMS)
F ACRJ=1:1 S ACRX=$P(ACRITEMS,",",ACRJ) Q:ACRX="" I '$D(^ACRSI(ACRSIDA,1,"B",ACRSS(ACRX))) D I1
Q
I1 S:'$D(^ACRSI(ACRSIDA,1,0)) ^ACRSI(ACRSIDA,1,0)="^9003010.01P"
S DA(1)=ACRSIDA
S DIC="^ACRSI("_ACRSIDA_",1,"
S DIC(0)="L"
S X=+ACRSS(ACRX)
D FILE^ACRFDIC
S ACRSSIDA=+Y
S:'$D(ACRIMAX) ACRIMAX=1
S ACRSSI=^ACRSI(ACRSIDA,1,ACRSSIDA,0)
D IQUAN
Q
IEDIT ;EDIT EXISTING SHIPPING INSTRUTIONS
S:'$D(ACRIMAX) ACRIMAX=1
I ACRIMAX=1 S ACRX=1
E D ICHOOSE
Q:$D(ACRQUIT)!$D(ACROUT)
F ACRI=1:1 S Y=$P(ACRX,",",ACRI) Q:'Y!'$D(ACRSSI(+Y))!$D(ACRQUIT)!$D(ACROUT) D IE
Q
IDELETE ;
S DA(1)=ACRSIDA
S DA=ACRSSIDA
S DIK="^ACRSI("_ACRSIDA_","
D DIK^ACRFDIC
Q
ICHOOSE ;CHOOSE ITEM TO BE EDITED
I ACRIMAX=1 S ACRX=1 Q
S DIR(0)="LO^1:"_ACRIMAX
S DIR("A")="Which Item(s)"
W !
D DIR^ACRFDIC
I +Y<1 S ACRQUIT="" Q
S ACRX=Y
Q
IE ;LOOP THROUGH ITEMS
S (ACRSSIDA,DA)=ACRSSI(+Y)
S ACRSSI=^ACRSI(ACRSIDA,1,ACRSSIDA,0)
S X=$P(ACRSS("ACRSS",+ACRSSI),U,2)
S Y=ACRQUAN(+ACRSSI)
I X-Y<0 D
.W !!,X," of this item ",$S(X>1:"were",1:"was")," ordered."
.W !,Y,$S(+Y>1:" is",1:" are")," already marked for shipment."
.W !!,"Make sure you do not request shipment for more than you ordered."
.D PAUSE^ACRFWARN
D IQUAN
Q
IQUAN ;SET QUANTITIY TO BE SHIPPED
W !!,"TOTAL QUANTITY ORDRD..: ",$P(ACRSS("ACRSS",+ACRSSI),U,2)
W !,"TOTAL MARKED SHIPPED..: ",+$G(ACRQUAN(+ACRSSI))
W !,"TOTAL TO THIS LOCATION: ",+$G(ACRQUAN(+ACRSSI,ACRSIDA))
S DA(1)=ACRSIDA
S DA=ACRSSIDA
S DR="1T"
S DIE="^ACRSI("_ACRSIDA_",1,"
D DIE^ACRFDIC
Q
P ;SCREEN CONTROL
Q:IOSL-6>$Y
I $E(IOST,1,2)="P-" D HEAD^ACRFSHIP,DISP^ACRFSHIP
I $E(IOST,1,2)="C-" D PAUSE^ACRFWARN
Q
QUAN ;CALCULATE QUANTITY MARKED AS SHIP
N ACRSIDA
S ACRSIDA=0
F S ACRSIDA=$O(^ACRSI("B",ACRDOCDA,ACRSIDA)) Q:'ACRSIDA D
.N ACRSSIDA
.S ACRSSIDA=0
.F S ACRSSIDA=$O(^ACRSI(ACRSIDA,1,ACRSSIDA)) Q:'ACRSSIDA D
..I $D(^ACRSI(ACRSIDA,1,ACRSSIDA,0)) S ACRSSDA=+^(0),ACRQUAN=$P(^(0),U,2) D:ACRSSDA
...S ACRQUAN(ACRSSDA)=$G(ACRQUAN(ACRSSDA))+ACRQUAN
Q
ACRFSHI1 ;IHS/OIRM/DSD/THL,AEF - SHIPPING INSTRUCTIONS - CON'T; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;TO REVIEW AND EDIT SHIPPING INSTRUCTIONS
ITEMS ;EP - LIST BY ITEM NUMBER ITEMS TO BE SHIPPED
+1 FOR
DO IC
IF $DATA(ACRQUIT)
QUIT
+2 KILL ACRQUIT,ACRQUAN,ACRSSI,ACRSS
+3 QUIT
IDISP ;EP;DISPLAY ITEMS FOR EACH SHIPPING LOCATION
+1 WRITE !
+2 DO IARRAY
+3 SET ACRSSIDA=0
+4 FOR
SET ACRSSIDA=$ORDER(^ACRSI(ACRSIDA,1,ACRSSIDA))
IF 'ACRSSIDA
QUIT
IF $DATA(^ACRSI(ACRSIDA,1,ACRSSIDA,0))
SET ACRSSI=^(0)
Begin DoDot:1
+5 SET ACRI=0
+6 FOR
SET ACRI=$ORDER(ACRSS(ACRI))
IF 'ACRI
QUIT
IF +ACRSS(ACRI)=+ACRSSI
Begin DoDot:2
+7 SET ACRSSI(ACRI)=ACRSSIDA
+8 SET ACRIMAX=ACRI
+9 SET ACRQUAN(+ACRSSI)=$GET(ACRQUAN(+ACRSSI))+$PIECE(ACRSSI,U,2)
+10 SET ACRQUAN(+ACRSSI,ACRSIDA)=$GET(ACRQUAN(+ACRSSI,ACRSIDA))+$PIECE(ACRSSI,U,2)
+11 WRITE !?9,"Item: ",$JUSTIFY(ACRI,6)
+12 WRITE ?25,"Quantity: ",$JUSTIFY($PIECE(ACRSSI,U,2),6)
+13 DO P
End DoDot:2
End DoDot:1
+14 QUIT
IARRAY ;EP - SET DOCUMENT ITEM ARRAY
+1 KILL ACRSS
+2 SET (ACRJ,ACRSSDA)=0
+3 FOR
SET ACRSSDA=$ORDER(^ACRSS("J",ACRDOCDA,ACRSSDA))
IF 'ACRSSDA
QUIT
Begin DoDot:1
+4 SET ACRSSDT=$GET(^ACRSS(ACRSSDA,"DT"))
+5 SET ACRJ=ACRJ+1
+6 SET ACRSS(ACRJ)=ACRSSDA_U_+ACRSSDT
+7 SET ACRSS("ACRSS",ACRSSDA)=ACRJ_U_+ACRSSDT
End DoDot:1
+8 QUIT
IC ;EP;TO CHOOSE ITEM(S) TO ADD OR EDIT CTION
+1 SET DIR(0)="SO^1:ADD ITEM for this SHIPPING location"_$SELECT($DATA(^ACRSI(ACRSIDA,1)):";2:EDIT ITEM for this SHIPPPING location;3:DELETE ITEM from this SHIPPING location",1:"")
+2 WRITE !
+3 DO DIR^ACRFDIC
+4 IF $DATA(ACRQUIT)!$DATA(ACROUT)!'$GET(Y)
QUIT
+5 IF Y=1
DO IADD
QUIT
+6 IF Y=2
DO IEDIT
QUIT
+7 IF Y=3
DO IDELETE
QUIT
+8 QUIT
IADD DO ITEM^ACRFSHIP
+1 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 IF '+$GET(ACRITEMS)
QUIT
+3 FOR ACRJ=1:1
SET ACRX=$PIECE(ACRITEMS,",",ACRJ)
IF ACRX=""
QUIT
IF '$DATA(^ACRSI(ACRSIDA,1,"B",ACRSS(ACRX)))
DO I1
+4 QUIT
I1 IF '$DATA(^ACRSI(ACRSIDA,1,0))
SET ^ACRSI(ACRSIDA,1,0)="^9003010.01P"
+1 SET DA(1)=ACRSIDA
+2 SET DIC="^ACRSI("_ACRSIDA_",1,"
+3 SET DIC(0)="L"
+4 SET X=+ACRSS(ACRX)
+5 DO FILE^ACRFDIC
+6 SET ACRSSIDA=+Y
+7 IF '$DATA(ACRIMAX)
SET ACRIMAX=1
+8 SET ACRSSI=^ACRSI(ACRSIDA,1,ACRSSIDA,0)
+9 DO IQUAN
+10 QUIT
IEDIT ;EDIT EXISTING SHIPPING INSTRUTIONS
+1 IF '$DATA(ACRIMAX)
SET ACRIMAX=1
+2 IF ACRIMAX=1
SET ACRX=1
+3 IF '$TEST
DO ICHOOSE
+4 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+5 FOR ACRI=1:1
SET Y=$PIECE(ACRX,",",ACRI)
IF 'Y!'$DATA(ACRSSI(+Y))!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
DO IE
+6 QUIT
IDELETE ;
+1 SET DA(1)=ACRSIDA
+2 SET DA=ACRSSIDA
+3 SET DIK="^ACRSI("_ACRSIDA_","
+4 DO DIK^ACRFDIC
+5 QUIT
ICHOOSE ;CHOOSE ITEM TO BE EDITED
+1 IF ACRIMAX=1
SET ACRX=1
QUIT
+2 SET DIR(0)="LO^1:"_ACRIMAX
+3 SET DIR("A")="Which Item(s)"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF +Y<1
SET ACRQUIT=""
QUIT
+7 SET ACRX=Y
+8 QUIT
IE ;LOOP THROUGH ITEMS
+1 SET (ACRSSIDA,DA)=ACRSSI(+Y)
+2 SET ACRSSI=^ACRSI(ACRSIDA,1,ACRSSIDA,0)
+3 SET X=$PIECE(ACRSS("ACRSS",+ACRSSI),U,2)
+4 SET Y=ACRQUAN(+ACRSSI)
+5 IF X-Y<0
Begin DoDot:1
+6 WRITE !!,X," of this item ",$SELECT(X>1:"were",1:"was")," ordered."
+7 WRITE !,Y,$SELECT(+Y>1:" is",1:" are")," already marked for shipment."
+8 WRITE !!,"Make sure you do not request shipment for more than you ordered."
+9 DO PAUSE^ACRFWARN
End DoDot:1
+10 DO IQUAN
+11 QUIT
IQUAN ;SET QUANTITIY TO BE SHIPPED
+1 WRITE !!,"TOTAL QUANTITY ORDRD..: ",$PIECE(ACRSS("ACRSS",+ACRSSI),U,2)
+2 WRITE !,"TOTAL MARKED SHIPPED..: ",+$GET(ACRQUAN(+ACRSSI))
+3 WRITE !,"TOTAL TO THIS LOCATION: ",+$GET(ACRQUAN(+ACRSSI,ACRSIDA))
+4 SET DA(1)=ACRSIDA
+5 SET DA=ACRSSIDA
+6 SET DR="1T"
+7 SET DIE="^ACRSI("_ACRSIDA_",1,"
+8 DO DIE^ACRFDIC
+9 QUIT
P ;SCREEN CONTROL
+1 IF IOSL-6>$Y
QUIT
+2 IF $EXTRACT(IOST,1,2)="P-"
DO HEAD^ACRFSHIP
DO DISP^ACRFSHIP
+3 IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^ACRFWARN
+4 QUIT
QUAN ;CALCULATE QUANTITY MARKED AS SHIP
+1 NEW ACRSIDA
+2 SET ACRSIDA=0
+3 FOR
SET ACRSIDA=$ORDER(^ACRSI("B",ACRDOCDA,ACRSIDA))
IF 'ACRSIDA
QUIT
Begin DoDot:1
+4 NEW ACRSSIDA
+5 SET ACRSSIDA=0
+6 FOR
SET ACRSSIDA=$ORDER(^ACRSI(ACRSIDA,1,ACRSSIDA))
IF 'ACRSSIDA
QUIT
Begin DoDot:2
+7 IF $DATA(^ACRSI(ACRSIDA,1,ACRSSIDA,0))
SET ACRSSDA=+^(0)
SET ACRQUAN=$PIECE(^(0),U,2)
IF ACRSSDA
Begin DoDot:3
+8 SET ACRQUAN(ACRSSDA)=$GET(ACRQUAN(ACRSSDA))+ACRQUAN
End DoDot:3
End DoDot:2
End DoDot:1
+9 QUIT
