Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFSHI1

ACRFSHI1.m

Go to the documentation of this file.
  1. 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
  1. ;;TO REVIEW AND EDIT SHIPPING INSTRUCTIONS
  1. ITEMS ;EP - LIST BY ITEM NUMBER ITEMS TO BE SHIPPED
  1. F D IC Q:$D(ACRQUIT)
  1. K ACRQUIT,ACRQUAN,ACRSSI,ACRSS
  1. Q
  1. IDISP ;EP;DISPLAY ITEMS FOR EACH SHIPPING LOCATION
  1. W !
  1. D IARRAY
  1. S ACRSSIDA=0
  1. F S ACRSSIDA=$O(^ACRSI(ACRSIDA,1,ACRSSIDA)) Q:'ACRSSIDA I $D(^ACRSI(ACRSIDA,1,ACRSSIDA,0)) S ACRSSI=^(0) D
  1. .S ACRI=0
  1. .F S ACRI=$O(ACRSS(ACRI)) Q:'ACRI I +ACRSS(ACRI)=+ACRSSI D
  1. ..S ACRSSI(ACRI)=ACRSSIDA
  1. ..S ACRIMAX=ACRI
  1. ..S ACRQUAN(+ACRSSI)=$G(ACRQUAN(+ACRSSI))+$P(ACRSSI,U,2)
  1. ..S ACRQUAN(+ACRSSI,ACRSIDA)=$G(ACRQUAN(+ACRSSI,ACRSIDA))+$P(ACRSSI,U,2)
  1. ..W !?9,"Item: ",$J(ACRI,6)
  1. ..W ?25,"Quantity: ",$J($P(ACRSSI,U,2),6)
  1. ..D P
  1. Q
  1. IARRAY ;EP - SET DOCUMENT ITEM ARRAY
  1. K ACRSS
  1. S (ACRJ,ACRSSDA)=0
  1. F S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA D
  1. .S ACRSSDT=$G(^ACRSS(ACRSSDA,"DT"))
  1. .S ACRJ=ACRJ+1
  1. .S ACRSS(ACRJ)=ACRSSDA_U_+ACRSSDT
  1. .S ACRSS("ACRSS",ACRSSDA)=ACRJ_U_+ACRSSDT
  1. Q
  1. IC ;EP;TO CHOOSE ITEM(S) TO ADD OR EDIT CTION
  1. 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:"")
  1. W !
  1. D DIR^ACRFDIC
  1. Q:$D(ACRQUIT)!$D(ACROUT)!'$G(Y)
  1. I Y=1 D IADD Q
  1. I Y=2 D IEDIT Q
  1. I Y=3 D IDELETE Q
  1. Q
  1. IADD D ITEM^ACRFSHIP
  1. Q:$D(ACRQUIT)!$D(ACROUT)
  1. Q:'+$G(ACRITEMS)
  1. F ACRJ=1:1 S ACRX=$P(ACRITEMS,",",ACRJ) Q:ACRX="" I '$D(^ACRSI(ACRSIDA,1,"B",ACRSS(ACRX))) D I1
  1. Q
  1. I1 S:'$D(^ACRSI(ACRSIDA,1,0)) ^ACRSI(ACRSIDA,1,0)="^9003010.01P"
  1. S DA(1)=ACRSIDA
  1. S DIC="^ACRSI("_ACRSIDA_",1,"
  1. S DIC(0)="L"
  1. S X=+ACRSS(ACRX)
  1. D FILE^ACRFDIC
  1. S ACRSSIDA=+Y
  1. S:'$D(ACRIMAX) ACRIMAX=1
  1. S ACRSSI=^ACRSI(ACRSIDA,1,ACRSSIDA,0)
  1. D IQUAN
  1. Q
  1. IEDIT ;EDIT EXISTING SHIPPING INSTRUTIONS
  1. S:'$D(ACRIMAX) ACRIMAX=1
  1. I ACRIMAX=1 S ACRX=1
  1. E D ICHOOSE
  1. Q:$D(ACRQUIT)!$D(ACROUT)
  1. F ACRI=1:1 S Y=$P(ACRX,",",ACRI) Q:'Y!'$D(ACRSSI(+Y))!$D(ACRQUIT)!$D(ACROUT) D IE
  1. Q
  1. IDELETE ;
  1. S DA(1)=ACRSIDA
  1. S DA=ACRSSIDA
  1. S DIK="^ACRSI("_ACRSIDA_","
  1. D DIK^ACRFDIC
  1. Q
  1. ICHOOSE ;CHOOSE ITEM TO BE EDITED
  1. I ACRIMAX=1 S ACRX=1 Q
  1. S DIR(0)="LO^1:"_ACRIMAX
  1. S DIR("A")="Which Item(s)"
  1. W !
  1. D DIR^ACRFDIC
  1. I +Y<1 S ACRQUIT="" Q
  1. S ACRX=Y
  1. Q
  1. IE ;LOOP THROUGH ITEMS
  1. S (ACRSSIDA,DA)=ACRSSI(+Y)
  1. S ACRSSI=^ACRSI(ACRSIDA,1,ACRSSIDA,0)
  1. S X=$P(ACRSS("ACRSS",+ACRSSI),U,2)
  1. S Y=ACRQUAN(+ACRSSI)
  1. I X-Y<0 D
  1. .W !!,X," of this item ",$S(X>1:"were",1:"was")," ordered."
  1. .W !,Y,$S(+Y>1:" is",1:" are")," already marked for shipment."
  1. .W !!,"Make sure you do not request shipment for more than you ordered."
  1. .D PAUSE^ACRFWARN
  1. D IQUAN
  1. Q
  1. IQUAN ;SET QUANTITIY TO BE SHIPPED
  1. W !!,"TOTAL QUANTITY ORDRD..: ",$P(ACRSS("ACRSS",+ACRSSI),U,2)
  1. W !,"TOTAL MARKED SHIPPED..: ",+$G(ACRQUAN(+ACRSSI))
  1. W !,"TOTAL TO THIS LOCATION: ",+$G(ACRQUAN(+ACRSSI,ACRSIDA))
  1. S DA(1)=ACRSIDA
  1. S DA=ACRSSIDA
  1. S DR="1T"
  1. S DIE="^ACRSI("_ACRSIDA_",1,"
  1. D DIE^ACRFDIC
  1. Q
  1. P ;SCREEN CONTROL
  1. Q:IOSL-6>$Y
  1. I $E(IOST,1,2)="P-" D HEAD^ACRFSHIP,DISP^ACRFSHIP
  1. I $E(IOST,1,2)="C-" D PAUSE^ACRFWARN
  1. Q
  1. QUAN ;CALCULATE QUANTITY MARKED AS SHIP
  1. N ACRSIDA
  1. S ACRSIDA=0
  1. F S ACRSIDA=$O(^ACRSI("B",ACRDOCDA,ACRSIDA)) Q:'ACRSIDA D
  1. .N ACRSSIDA
  1. .S ACRSSIDA=0
  1. .F S ACRSSIDA=$O(^ACRSI(ACRSIDA,1,ACRSSIDA)) Q:'ACRSSIDA D
  1. ..I $D(^ACRSI(ACRSIDA,1,ACRSSIDA,0)) S ACRSSDA=+^(0),ACRQUAN=$P(^(0),U,2) D:ACRSSDA
  1. ...S ACRQUAN(ACRSSDA)=$G(ACRQUAN(ACRSSDA))+ACRQUAN
  1. Q