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

ASUMDIRA.m

Go to the documentation of this file. 
  1. ASUMDIRA ; IHS/ITSC/LMH -DIRECT ADD RECORD ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine is a utility which provides entry points to verify and
  1.  ;assign internal entry numbers and add new entries into SAMS Station
  1.  ;(in ^ASUMS) and Index (in ^ASUMX) Master files and the Sub Station
  1.  ;table (in ^ASUL(18)).
  1. DIS(X) ;EP ; ADD NEW RECORD STATION MASTER
  1.  ;Error conditions passed back in 'Y'
  1.  ;  -1 : Failed IEN edit
  1.  ;  -2 : IEN not for Area signed into KERNEL with (DUZ 2)
  1.  I $G(X)']"" S X=$G(ASUL(2,"STA","E#"))
  1.  I $L(X)=3 S X=ASUL(1,"AR","AP")_X
  1.  I $L(X)=2 S X=ASUL(1,"AR","AP")_"0"_X
  1.  I $E(X,1,2)'=ASUL(1,"AR","AP") S Y=-2 Q  ;Not for Area Signed on as
  1.  I X'?5N S Y=-1 Q  ;Failed IEN edit
  1.  S ^ASUMS(X,0)=X_U_$E(X,1,2)
  1.  S ^ASUMS(X,1,0)="^9002031.02PA^"
  1.  ;Add one to the count of Stations
  1.  S $P(^ASUMS(0),U,4)=$P(^ASUMS(0),U,4)+1
  1.  ;Set last station updated piece
  1.  S $P(^ASUMS(0),U,3)=X
  1.  S DA=X,DIK="^ASUMS(" D IX^DIK K DIK,DA
  1.  S Y=+X
  1.  Q
  1. SST(X) ;EP ; ADD NEW RECORD SUB STATION
  1.  ;Error conditions passed back in 'Y'
  1.  ;  -1 : Failed IEN edit
  1.  ;  -2 : IEN not for Area signed into KERNEL with (DUZ 2)
  1.  I $L(X)=3 S X=ASUL(1,"AR","AP")_X
  1.  I $L(X)=2 S X=ASUL(1,"AR","AP")_"0"_X
  1.  I $E(X,1,2)'=ASUL(1,"AR","AP") S Y=-2 Q  ;Not for Area Signed on as
  1.  I X'?5N S Y=-1 Q  ;Failed IEN edit
  1.  I $G(X(1))="" S Y=-3 Q
  1.  S ^ASUL(18,X,0)=X(1)_U_$E(X,1,2)
  1.  S ^ASUL(18,X,1)=$E(X,4,5)
  1.  ;Add one to the count of Sub Stations
  1.  S $P(^ASUL(18,0),U,4)=$P(^ASUL(18,0),U,4)+1
  1.  ;Set last sub station updated piece
  1.  S $P(^ASUL(18,0),U,3)=X
  1.  S DA=X,DIK="^ASUL(18," D IX^DIK K DIK,DA
  1.  Q
  1. DISX(X) ;EP ; ADD NEW RECORD STATION MASTER
  1.  ;Error conditions passed back in 'Y'
  1.  ;  -1 : Failed IEN edit
  1.  ;  -2 : IEN not for Area signed into KERNEL with (DUZ 2)
  1.  ;  -3 : No Index Master found for Index # add requested for
  1.  ;  -4 : Station Index master already on file
  1.  ;  -7 : Station IEN Index to be added to not in ASUMS variable
  1.  ;  -9 : Index # requested was assigned to a deleted item not yet
  1.  ;        available for re-use
  1.  I '$D(ASUMS("E#","STA")) S ASUMS("E#","STA")=$G(ASUL(2,"STA","E#"))
  1.  I $L(X)=6 S X=ASUL(1,"AR","AP")_X
  1.  I $E(X,1,2)'=ASUL(1,"AR","AP") S Y=-2 Q  ;Not for Area Signed on as
  1.  I X'?8N S Y=-1 Q  ;Failed IEN edit
  1.  I '$D(^ASUMX(X,0)) S Y=-3 Q  ;No Index master
  1.  I $P(^ASUMX(X,0),U)']"" S Y=-8 Q  ;Deleted Index master
  1.  I $D(^ASUMS(ASUMS("E#","STA"),1,X,0)) D  Q:Y<0
  1.  .I $P(^ASUMS(ASUMS("E#","STA"),1,X,0),U)[999999 D  ;Deleted Station Index
  1.  ..I ASUK("DT","YRMO")-$P(^ASUMS(ASUMS("E#","STA"),1,X,0),U,2)<300 S Y=-9
  1.  ..E  K ^ASUMS(ASUMS("E#","STA"),1,X)
  1.  .E  S Y=-4 ;Station Index master already on file
  1.  S ASUMS("E#","IDX")=X
  1.  S ^ASUMS(ASUMS("E#","STA"),1,X,0)=X,^ASUMS(ASUMS("E#","STA"),1,X,1,0)="^9002031.232A^12^12",^ASUMS(ASUMS("E#","STA"),1,X,2)=""
  1.  F V=0:1:12 S ^ASUMS(ASUMS("E#","STA"),1,X,1,V,0)=V
  1.  ;Add one to the count of index records for this Station
  1.  S $P(^ASUMS(ASUMS("E#","STA"),1,0),U,4)=$P(^ASUMS(ASUMS("E#","STA"),1,0),U,4)+1
  1.  ;Set last index updated piece
  1.  S $P(^ASUMS(ASUMS("E#","STA"),1,0),U,3)=X
  1.  S DA=X,DA(1)=ASUMS("E#","STA"),DIK="^ASUMS(DA(1),1," D IX^DIK K DIK,DA
  1.  Q
  1. DIX(Z) ;EP ; ADD NEW RECORD INDEX MASTER
  1.  ;Error conditions passed back in 'Y'
  1.  ;  -1 : Failed IEN edit
  1.  ;  -2 : IEN not for Area signed into KERNEL with (DUZ 2)
  1.  N X
  1.  S X=$G(Z(Z,"PT","IDX"))
  1.  I X="" D
  1.  .S X=Z(Z,"AR")_Z(Z,"IDX")
  1.  ;S X=Z(Z,"IDX") S:X']"" X=Z(Z,"PT","IDX")
  1.  ;I $L(X)=6 S X=ASUL(1,"AR","AP")_X
  1.  I $E(X,1,2)'=ASUL(1,"AR","AP") S Y=-2 Q
  1.  I X'?8N S Y=-1 Q
  1.  S ^ASUMX(X,0)=Z(Z,"IDX")_U_Z(Z,"DESC")_U_Z(Z,"BCD")_U_Z(Z,"AR U/I")_U_Z(Z,"NSN")_U_Z(Z,"ACC")_U_Z(Z,"SOBJ")_U_Z(Z,"CAT")_U_Z(Z,"DTS")_U_U_Z(Z,"AR")
  1.  S ^ASUMX(X,2)=U_U_U_U_Z(Z,"PT","ACC")_U_Z(Z,"PT","SOBJ")_U_Z(Z,"PT","CAT")
  1.  ;Add one to the count of index records
  1.  S $P(^ASUMX(0),U,4)=$P(^ASUMX(0),U,4)+1
  1.  ;Set last index updated piece
  1.  S $P(^ASUMX(0),U,3)=X
  1.  S DA=X,DIK="^ASUMX(" D IX^DIK K DIK,DA
  1.  Q