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

ASURO26P.m

Go to the documentation of this file. 
  1. ASURO26P ; IHS/ITSC/LMH -PRE-PRINTED ISSUE BOOK-STOCK ;   
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine formats and prints report 26, Pre-Printed Issue Book -
  1.  ;Stock Issues Request Report.
  1.  D INIT
  1.  S ASUK("PTR")="I/B",%ZIS("A")="Select Printer for Issue Book: " D ^ASUUZIS Q:POP  ; JDH quit to %ZIS Q:$D(DUOUT)  Q:$D(DTOUT)
  1.  D SELMONTH Q:$D(DUOUT)  Q:$D(DTOUT)
  1.  I ASUK("I/B","Q")=1 D  Q
  1.  .S XBRP="PSER^ASURO26P",XBRC="^ASURO260",XBRX="^ASUROUKIL" D Q^ASUUZIS K ASUK
  1.  D ^ASURO260 ;SORT AND EXTRACT DFNS
  1.  D O^ASUUZIS G PSER
  1. PRINT ;EP ;TO RE-CREATE REPORT FROM PREVIOUSLY SELECTED RECORDS
  1.  D INIT
  1.  D:'$D(DT) ^XBKVAR
  1.  I '$D(DUZ(2)) W !,"Report must be run from Kernel option" Q
  1.  I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST
  1.  S ASUK("PTRSEL")=$G(ASUK("PTRSEL")) I ASUK("PTRSEL")]"" G PSER
  1.  S ZTRTN="PSER^ASURO26P",ZTDESC="SAMS RPT 26" D O^ASUUZIS
  1.  I POP S IOP=$I D ^%ZIS Q
  1.  I ASUK(ASUK("PTR"),"Q") G K
  1. PSER ;EP;FOR TASKMAN QUEUE OF PRINT
  1.  K ASUX
  1.  D U^ASUUZIS
  1.  S ASUK("AS OF")=$P($G(^XTMP("ASUR","R26",0)),U,3)
  1.  S ASUX("STA")=$O(^XTMP("ASUR","R26",0))
  1.  I ASUX("STA")']""!(ASUK("AS OF")']"") D  G K
  1.  .W @IOF,!!,"NO ISSUE BOOK DATA FOR YOUR SELECTION"
  1.  D:'$D(ASULMN) MOTBL
  1.  S (ASUC("LN"),ASUC("PG"))=0,ASUC("LI")=""
  1.  S ASUX("USR")=""  ;LMH 3/9/00
  1.  I '$D(ASUX("STA")) S ASUX("STA")=$G(ASUL(2,"STA","E#"))
  1.  Q:ASUX("STA")']""  D  Q:$D(DUOUT)
  1.  .;*LMH* 3/9/00 F  S ASUX("USR")=$O(^XTMP("ASUR","R26",ASUX("STA"),$G(ASUX("USR")))) Q:ASUX("USR")']""  D  Q:$D(DUOUT)
  1.  .F  S ASUX("USR")=$O(^XTMP("ASUR","R26",ASUX("STA"),ASUX("USR"))) Q:ASUX("USR")']""  D  Q:$D(DUOUT)  ;LMH - above $G was not re-setting user below.
  1.  ..S ASUMY("USR")=ASUX("USR")
  1.  ..S ASUC("PG")=0
  1.  ..F  S ASUX("ACC")=$O(^XTMP("ASUR","R26",ASUX("STA"),ASUX("USR"),$G(ASUX("ACC")))) Q:ASUX("ACC")']""  D  Q:$D(DUOUT)
  1.  ...F  S ASUX("SLCCAT")=$O(^XTMP("ASUR","R26",ASUX("STA"),ASUX("USR"),ASUX("ACC"),$G(ASUX("SLCCAT")))) Q:ASUX("SLCCAT")']""  D  Q:$D(DUOUT)
  1.  ....S ASUF("PGBK")=2
  1.  ....F  S ASUX("IDX")=$O(^XTMP("ASUR","R26",ASUX("STA"),ASUX("USR"),ASUX("ACC"),ASUX("SLCCAT"),$G(ASUX("IDX")))) Q:ASUX("IDX")']""  D INDEX  Q:$D(DUOUT)
  1.  ....W !,"TOTAL LINE ITEMS: ",$J($FN(ASUC("LI"),","),10)
  1.  ....S ASUC("LI")=0
  1.  ...K ASUL(20),ASUL(18)         ;WAR 4/19/2000 - added ASUL(18)
  1.  D CLS^ASUUHDG
  1. K ;
  1.  K %DT,ASU,ASUC,ASUF,ASUV,ASUX,ASUMX,ASUMB,ASUMS
  1.  K ASULMN,ASULMO,ASUQ("MO"),X,X1,X2,X3,X4
  1.  F X=3:1:22 K ASUL(X) ;Clear Table Lookup fields
  1.  D PAZ^ASUURHDR I $G(ASUK("PTRSEL"))]"" W @IOF Q
  1.  D C^ASUUZIS
  1.  Q
  1. INDEX ;
  1.  S ASUC("LI")=ASUC("LI")+1
  1.  S ASUX(0)=^XTMP("ASUR","R26",ASUX("STA"),ASUX("USR"),ASUX("ACC"),ASUX("SLCCAT"),ASUX("IDX"))
  1.  S ASUMS("E#","STA")=$P(ASUX(0),U,2)
  1.  S (ASUMX("E#","IDX"),ASUMS("E#","IDX"))=$P(ASUX(0),U)
  1.  ;S ASUMK("E#","STA")=ASUX("STA")       ;LMH
  1.  S ASUMK("E#","STA")=ASUL(2,"STA","E#") ;LMH   4/13/00
  1.  S ASUMK("E#","REQ")=ASUX("USR")
  1.  D READ^ASUMXDIO,REQ^ASULDIRR(ASUMK("E#","REQ"))
  1.  G:ASUMX("CAT")']"" UNKNOWN
  1.  S ASUL(7,"CAT","E#")=$O(^ASUL(7,"B",ASUMX("CAT"),"")) G:ASUL(7,"CAT","E#")']"" UNKNOWN
  1.  S ASUL(7,"SOBJ","E#")=$O(^ASUL(7,"D",ASUMX("SOBJ"),ASUL(7,"CAT","E#"),"")) G:ASUL(7,"SOBJ","E#")']"" UNKNOWN
  1.  S ASUK("CAT NM")=$P(^ASUL(7,ASUL(7,"CAT","E#"),1,ASUL(7,"SOBJ","E#"),0),U,3) G READMST
  1. UNKNOWN ;
  1.  S ASUK("CAT NM")="UNKNOWN CATEGORY"
  1. READMST ;
  1.  S ASUMK("E#","IDX")=ASUMX("E#","IDX")
  1.  D ^ASUMSTRD,READ^ASUMKBIO
  1.  D:ASUF("PGBK")>1 HDPG Q:$D(DUOUT)
  1.  D:ASUF("PGBK") HEADER Q:$D(DUOUT)
  1.  S (ASUC("TOT","ISS"),ASUC("P6MO","QTY"),ASUC("P6MO","DOC"),ASUC("TOT","DOC"),ASUF("SESNL"))=0
  1.  F ASUU(17)=0:1:11 D
  1.  .S ASUQ("MO")=ASUK("AS OF")+ASUU(17)
  1.  .S:ASUQ("MO")>12 ASUQ("MO")=ASUQ("MO")-12
  1.  .S ASULMO(ASUU(17)+1)=ASUQ("MO")
  1.  .I ASUU(17)>5 D
  1.  ..S ASUC("P6MO","QTY")=ASUC("P6MO","QTY")+ASUMK(ASUQ("MO"),"QTY")
  1.  ..S ASUC("P6MO","DOC")=ASUC("P6MO","DOC")+ASUMK(ASUQ("MO"),"DOC")
  1.  .S ASUC("TOT","ISS")=ASUC("TOT","ISS")+ASUMK(ASUQ("MO"),"QTY")
  1.  .S ASUC("TOT","DOC")=ASUC("TOT","DOC")+ASUMK(ASUQ("MO"),"DOC")
  1.  I ASUC("TOT","ISS")=0,+ASUMK("ULQTY")'>0 Q
  1.  W !,$E(ASUMX("IDX"),1,5),".",$E(ASUMX("IDX"),6,6)
  1.  W ?10,ASUMS("SLC")
  1.  W ?13,$E(ASUMX("DESC"),1,30)
  1.  W ?47,ASUMX("AR U/I")
  1.  I ASUMK("ULQTY")?1N.N D
  1.  .W ?52,ASUMK("ULQTY"),"**"
  1.  E  D
  1.  .S Y=$E(ASUMS("ESTB"),1,3)+1700
  1.  .S Y=ASUK("DT","YEAR")-Y
  1.  .S X=$E(ASUMS("ESTB"),4,5)
  1.  .S X=ASUK("DT","MO")-X
  1.  .S ASUV("MOLD")=(Y*12)+X
  1.  .K X,Y
  1.  .S:ASUV("MOLD")>6 ASUV("MOLD")=6
  1.  .S ASUV("ULVQTY")=$FN(ASUC("P6MO","QTY")/ASUV("MOLD"),"",0)
  1.  .I ASUMS("EOQ","TP")="Q" D
  1.  ..S ASUF("SESNL")=1
  1.  .S ASUV("ULVQTY")=$FN(ASUV("ULVQTY")*ASUL(20,"ULVQ FCTR"),"",0)
  1.  .W ?52,$J($FN(ASUV("ULVQTY"),"-",0),7)
  1.  I ASUMS("QTY","O/H")=0!(ASUMS("QTY","O/H")="") D
  1.  .S ASUV("CST/U")=ASUMS("LPP")
  1.  E  D
  1.  .S ASUV("CST/U")=$FN((ASUMS("VAL","O/H")/ASUMS("QTY","O/H")),"",2)
  1.  W ?58,$J($FN(ASUV("CST/U"),",",2),8)
  1.  W ?65,$J($FN(ASUC("P6MO","QTY"),",",0),6)
  1.  W ?74,ASUC("P6MO","DOC")
  1.  W !?13,$E(ASUMX("DESC"),31,60)
  1.  I ASUF("SESNL") W ?51,"SEASONAL ITEM" S ASUF("SESNL")=0
  1.  W !
  1.  F ASUU(17)=1:1:6 D
  1.  .S ASUU(18)=ASULMO(ASUU(17))
  1.  .W $E(ASULMN(ASUU(18)))," PYIQ "
  1.  .W $J($FN(ASUMK(ASUU(18),"QTY"),",",0),5)," "
  1.  W !
  1.  F ASUU(17)=1:1:6 D
  1.  .S ASUU(18)=ASULMO(ASUU(17))
  1.  .W $E(ASULMN(ASUU(18)),2,2)," Q-OH.....  "
  1.  W !
  1.  F ASUU(17)=1:1:6 D
  1.  .S ASUU(18)=ASULMO(ASUU(17))
  1.  .W $E(ASULMN(ASUU(18)),3,3)," ORDQ.....  "
  1.  W !!
  1.  S ASUC("LN")=ASUC("LN")+6 D:ASUC("LN")>(IOSL-2) HEADER Q:$D(DUOUT)
  1.  Q
  1. INIT ;
  1.  D:$G(ASUK("DT","FM"))']"" DATE^ASUUDATE
  1.  D:$G(ASUL(1,"AR","AP"))']"" SETAREA^ASULARST
  1.  I '$D(IO) D HOME^%ZIS
  1.  Q
  1. SELMONTH ;
  1.  S ASULMN(1)="JANUARY",ASULMN(2)="FEBRUARY",ASULMN(3)="MARCH"
  1.  S ASULMN(4)="APRIL",ASULMN(5)="MAY",ASULMN(6)="JUNE"
  1.  S ASULMN(7)="JULY",ASULMN(8)="AUGUST",ASULMN(9)="SEPTEMBER"
  1.  S ASULMN(10)="OCTOBER",ASULMN(11)="NOVEMBER",ASULMN(12)="DECEMBER"
  1.  S ASUK("AS OF")="",ASUV("COL")=1 W !,"Select one of the following:",!!
  1.  F ASUK("AS OF")=1:1:12 D
  1.  .W ?ASUV("COL"),ASUK("AS OF"),": ",ASULMN(ASUK("AS OF"))
  1.  .S ASUV("COL")=$S(ASUV("COL")=61:1,1:ASUV("COL")+20)
  1.  .W:ASUV("COL")=1 !
  1.  W !
  1.  S DIR(0)="N:1,12,0",DIR("A")="Select Month Issue Book to begin with "
  1.  S DIR("?")="Select a number from 1 -12",DIR("B")=+$E(ASUK("DT","FM"),4,5)+1 S:DIR("B")=13 DIR("B")=1
  1.  D ^DIR K DIR Q:$D(DIRUT)  Q:$D(DTOUT)  Q:$D(DUOUT)
  1.  S ASUK("AS OF")=X
  1.  K ^XTMP("ASUR","R26")
  1.  S ^XTMP("ASUR","R26",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")_U_$G(ASUK("AS OF"))
  1.  ;S ^XTMP("ASUR","R26",0)=$G(ASUK("AS OF"))
  1.  D SETAREA^ASULARST
  1.  K ASUF("QU")
  1.  S ASUF("BK")=0
  1.  F ASUU(10)=1:1:3 W !,ASUU(10),"  ",$P($T(@ASUU(10)),";",3)
  1.  S DIR(0)="L^1:3:0^S ASUV(""RP26"")=Y",DIR("A")="ENTER SELECTION "
  1.  W ! D ^DIR
  1.  ;W X
  1.  S:X["^" ASUF("QU")=1
  1.  Q:$D(ASUF("QU"))
  1.  K ASUU("SST")
  1.  D SST^ASURO26A I $D(ASUF("QU")) K ASUF("QU") Q
  1.  D USR^ASURO26A I $D(ASUF("QU")) K ASUF("QU") Q
  1.  Q
  1. 1 ;;ISSUE BOOK -ALPHA SEQ BY SUB STATION AND USER
  1. 2 ;;ISSUE BOOK -ALPHA SEQ BY CATEGORY
  1. 3 ;;ISSUE BOOK -INDEX SEQ
  1.  S ASUC("PG")=ASUC("PG")+1,ASUC("LN")=7,ASUF("PGBK")=0
  1.  D:ASUC("PG")>1 PAZ^ASUURHDR Q:$D(DUOUT)  W @IOF
  1.  S X=ASUL(1,"AR","AP") D AREA^ASULARST
  1.  S X1=ASUMS("E#","STA") D STAT^ASULARST
  1.  W !?1,"REPORT #26 PREPRINTED ISSUE BOOK -STOCK ISSUE REQUEST",?70,"PAGE: ",ASUC("PG")
  1.  W !?1,"AREA: ",ASUL(1,"AR","AP"),?10,ASUL(1,"AR","NM"),?33,"STATION: ",ASUL(2,"STA","CD"),?45,ASUL(2,"STA","NM")
  1.  W !?1,"SUBSTATION: ",ASUMK("SST")," ",ASUMK("SST","NM"),?33,"USER CODE: ",$E(ASUMY("USR"),6,7)_$E(ASUMY("USR"),9)  ;**LMH**3/9/00," ",ASUMK("USR","NM")
  1.  W:$P(ASUX("SLCCAT"),"*")="R" ?63," SLC : REFRIGERATE"
  1.  W:$P(ASUX("SLCCAT"),"*")="H" ?63," SLC : HAZARDOUS"
  1.  W:$P(ASUX("SLCCAT"),"*")="Z" ?63," SLC : ALL OTHERS"
  1.  W !?5,"ACCOUNT : ",$S(ASUX("ACC")=1:"PHARMACY",ASUX("ACC")=3:"SUBSISTENCE",1:"ALL OTHER")
  1.  W:$P(ASUX("SLCCAT"),"*",2)]"" ?37," CATEGORY : ",ASUMX("CAT")," -",ASUK("CAT NM")
  1.  W !!?3,"INDEX  S",?54,"USER",?61,"UNIT  PREV 6-MOS"
  1.  W !?2,"NUMBER  L  DESCRIPTION",?47,"UI",?53,"LEVEL",?61,"COST    QTY  DOC",!
  1.  Q
  1. HDPG ;EP; -COVER PAGE FOR EACH CATEGORY
  1.  D PAZ^ASUURHDR
  1.  D CLS^ASUUHDG
  1.  S X=ASUL(1,"AR","AP") D AREA^ASULARST S X1=ASUMS("STA") D STAT^ASULARST
  1.  W !?1,"REPORT #26 RECORD OF RECEIPT FOR SUPPLIES (HEW-394C -USE WITH 394A)"
  1.  W !?1,"AREA: ",ASUL(1,"AR","AP"),?10,ASUL(1,"AR","NM"),?33,"STATION: ",ASUL(2,"STA","CD"),?46,ASUL(2,"STA","NM")
  1.  W !?1,"SUBSTATION: ",ASUMK("SST")," ",ASUMK("SST","NM"),?33,"USER CODE: ",$E(ASUMY("USR"),6,7)_$E(ASUMY("USR"),9)    ; ** LMH ** 3/9/00 ," ",ASUMK("USR","NM")
  1.  W:$P(ASUX("SLCCAT"),"*")="R" ?63," SLC : REFRIGERATE"
  1.  W:$P(ASUX("SLCCAT"),"*")="H" ?63," SLC : HAZARDOUS"
  1.  W:$P(ASUX("SLCCAT"),"*")="Z" ?63," SLC : ALL OTHERS"
  1.  W !?5,"ACCOUNT : ",$S(ASUX("ACC")=1:"PHARMACY",ASUX("ACC")=3:"SUBSISTENCE",1:"ALL OTHER")
  1.  W:$P(ASUX("SLCCAT"),"*",2)]"" ?37," CATEGORY : ",ASUMX("CAT")," -",ASUK("CAT NM")
  1.  W !!?1,"SUPPLIES FOR",!?1,"THE MONTH OF",?17,"REQUESTED BY",?37,"ISSUED BY",?57,"RECIEVED BY **"
  1.  F ASUU(19)=0:1:5 S ASUV("ASOF")=ASUK("AS OF")+ASUU(19) S:ASUV("ASOF")>12 ASUV("ASOF")=ASUV("ASOF")-12 D PRTMOS
  1.  K ASUV("ASOF"),ASUU(19)
  1.  Q
  1. PRTMOS ;
  1.  W !!!!!?1,ASULMN(ASUV("ASOF")),!?17,"(SIGNATURE & DATE)",?37,"(SIGNATURE & DATE)",?57,"(SIGNATURE & DATE)",!?7,"VOUCHER NUMBER: ",?37,"VOUCHER DATE"
  1.  Q
  1. SELAOMO ;
  1.  D MOTBL
  1.  S ASUK("AS OF")="",ASUV("COL")=1 W !,"Select one of the following:",!!
  1.  F ASUK("AS OF")=1:1:12 D
  1.  .W ?ASUV("COL"),ASUK("AS OF"),": ",ASULMN(ASUK("AS OF"))
  1.  .S ASUV("COL")=$S(ASUV("COL")=61:1,1:ASUV("COL")+20)
  1.  .W:ASUV("COL")=1 !
  1.  W !
  1.  S DIR(0)="N:1,12,0",DIR("A")="Select Month Issue Book to begin with "
  1.  S DIR("?")="Select a number from 1 -12",DIR("B")=+$E(DT,4,5)+1 S:DIR("B")=13 DIR("B")=1
  1.  D ^DIR K DIR Q:$D(DIRUT)
  1.  S ASUK("AS OF")=X
  1.  Q
  1. MOTBL ;
  1.  S ASULMN(1)="JANUARY",ASULMN(2)="FEBRUARY",ASULMN(3)="MARCH"
  1.  S ASULMN(4)="APRIL",ASULMN(5)="MAY",ASULMN(6)="JUNE"
  1.  S ASULMN(7)="JULY",ASULMN(8)="AUGUST",ASULMN(9)="SEPTEMBER"
  1.  S ASULMN(10)="OCTOBER",ASULMN(11)="NOVEMBER",ASULMN(12)="DECEMBER"
  1.  Q