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

ASURO260.m

Go to the documentation of this file. 
  1. ASURO260 ; IHS/ITSC/LMH -S.A.M.S. REPORT 26 SORT ;   
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine sorts report 26 extracts into proper sequence so that the
  1.  ;report can be formatted and printed.
  1.  ;WAR 4/20/2000 - Made several changes. See original code in DEV or ask
  1.  ;                Lucy Harmon or myself for hard copy.
  1.  S ASUNW(4)=ASUV("RP26")
  1.  S X=$O(ASUU("SST","")) Q:X']""
  1.  S (ASUMK("E#","STA"),ASUX("STA"))=ASUL(2,"STA","E#")  ;WAR  4/20/2000
  1.  S (ASUXSST,ASUX("SST"))=0
  1.  I X="*ALL*" D  ;WAR 4/19/2000 Note:this is SUBstations not Stations.
  1.  .F  S ASUXSST=$O(^ASUMK(ASUX("STA"),1,ASUXSST)) Q:ASUXSST=""  D
  1.  ..S ASUX("SST")=$E(ASUXSST,1,5)
  1.  ..D USER
  1.  E  D
  1.  .F  S ASUX("SST")=$O(ASUU("SST",ASUX("SST"))) Q:ASUX("SST")=""  D
  1.  ..D USER
  1.  K ASUMK,ASUMX,ASUMS,ASUC,ASUU,ASUC,ASUX
  1.  Q
  1. USER ;
  1.  S ASUX("USR")=ASUX("SST")_"0000"
  1.  S X=$O(ASUU("USR","")) Q:X']""
  1.  I X="*ALL*" D
  1.  .;WAR 4/19/2000 added IF statement to D ASURO261 
  1.  .F  S ASUX("USR")=$O(^ASUMK(ASUMK("E#","STA"),1,ASUX("USR"))) Q:ASUX("USR")'?1N.N  D
  1.  ..I $E(ASUX("USR"),1,5)=$E(ASUX("SST"),1,5)  D ASURO261
  1.  E  D
  1.  .;WAR 4/21/2000 added next line - data entry person choose 'SELECTED
  1.  .;            USERS', but did not succeed in entering a valid USER code
  1.  .I $D(ASUU("USR",ASUX("SST"))) D
  1.  ..F  S ASUX("USR")=$O(ASUU("USR",ASUX("SST"),ASUX("USR"))) Q:ASUX("USR")=""  D
  1.  ...D ASURO261
  1.  Q
  1. ASURO261 ;
  1.  S ASUMK("E#","REQ")=ASUX("USR")
  1.  S ASUMK("E#","IDX")=0
  1.  ;LMH changed next line 4/2000
  1.  F ASUC("IDX")=1:1 S ASUMK("E#","IDX")=$O(^ASUMK(ASUMK("E#","STA"),1,ASUMK("E#","REQ"),1,ASUMK("E#","IDX"))) Q:((ASUMK("E#","IDX")'?1N.N)!(ASUMK("E#","IDX")[999999)!(ASUMK("E#","REQ")'=ASUX("USR")))  D
  1.  .Q:$G(^ASUMX(ASUMK("E#","IDX"),0))=""         ;LMH 4/2000
  1.  .Q:$P(^ASUMX(ASUMK("E#","IDX"),0),U)[999999
  1.  .W:ASUC("IDX")#20=0 "."
  1.  .S ASUMS("E#","STA")=$G(ASUL(1,"AR","STA1"))
  1.  .S:ASUMS("E#","STA")']"" ASUMS("E#","STA")=ASUMK("E#","STA")
  1.  .D DIS^ASUMDIRM(ASUMS("E#","STA")) I Y<0 D
  1.  ..S ASUMS("E#","STA")=$O(^ASUMS("C",ASUMK("E#","IDX"),""))
  1.  .I '$D(^ASUMS("C",ASUMK("E#","IDX"),ASUMS("E#","STA"))) D
  1.  ..S ASUMS("E#","STA")=$O(^ASUMS("C",ASUMK("E#","IDX"),""))
  1.  .I ASUMS("E#","STA")']"" D  Q
  1.  ..;W *7,!,"*** ERROR *** -Unable to find Station for Index # ",$E(ASUMK("E#","IDX"),3,8)," for to Sub Station ",$E(ASUMK("E#","STA"),3,5) LMH 4/24/2000
  1.  .S ASUMS(2)=^ASUMS(ASUMS("E#","STA"),1,ASUMK("E#","IDX"),2)
  1.  .S ASUMX(0)=^ASUMX(ASUMK("E#","IDX"),0)
  1.  .S ASUMS("EOQ","TP")=$P(ASUMS(2),U,5)
  1.  .S ASUMS("SLC")=$P(ASUMS(2),U)
  1.  .S ASUMX("ACC")=$P(ASUMX(0),U,6)
  1.  .S ASUMX("CAT")=$P(ASUMX(0),U,8)
  1.  .S ASUMX("DESC")=$P(ASUMX(0),U,2)
  1.  .I ASUMS("EOQ","TP")="Y" Q
  1.  .I ASUMX("ACC")=1,ASUMX("CAT")="R" Q
  1.  .I ASUMX("ACC")=1,ASUMX("CAT")="N" Q
  1.  .S ASUX("ACCG")=$S(ASUMX("ACC")=1:1,ASUMX("ACC")=3:3,1:4)
  1.  .I ASUMS("SLC")="H" D
  1.  ..S ASUX("SLC")="H*"
  1.  .E  D
  1.  ..I ASUMS("SLC")="R" D
  1.  ...S ASUX("SLC")="R*"
  1.  ..E  D
  1.  ...S ASUX("SLC")="Z*"
  1.  .I +ASUV("RP26")=2 S ASUX("SLC")=ASUX("SLC")_ASUMX("CAT")
  1.  .S ASUX("IDX")=$S(+ASUV("RP26")=3:ASUMK("E#","IDX"),1:ASUMX("DESC")_$E(ASUMK("E#","IDX"),3,8))
  1.  .;S ^XTMP("ASUR","R26",ASUX("SST"),ASUX("USR"),ASUX("ACCG"),ASUX("SLC"),ASUX("IDX"))=ASUMK("E#","IDX")_U_ASUMS("E#","STA")     ;LMH 
  1.  .S ^XTMP("ASUR","R26",ASUMS("E#","STA"),ASUX("USR"),ASUX("ACCG"),ASUX("SLC"),ASUX("IDX"))=ASUMK("E#","IDX")_U_ASUMK("E#","STA")
  1.  .K X
  1.  Q