- 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