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

ASURO76P.m

Go to the documentation of this file. 
  1. ASURO76P ; IHS/ITSC/LMH -PRINT RPT 76 DATA FROM ASURX(76 ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine formats and prints report 76, Analysis of Stock Issues
  1.  ; Report.
  1. PRINT ;EP;PRIMARY ENTRY POINT FOR REPORT 76
  1.  Q  ;WAR 5/21/99
  1.  I '$D(IO) D HOME^%ZIS
  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^ASURO76P",ZTDESC="SAMS RPT 76" D O^ASUUZIS
  1.  I POP S IOP=$I D ^%ZIS Q
  1.  I ASUK(ASUK("PTR"),"Q") Q
  1. PSER ;EP;FOR TASKMAN QUEUE OF PRINT
  1.  D U^ASUUZIS
  1.  S ASUV("RPT")="R76",ASUC("PG")=""
  1.  I ($D(ASUK("DT"))#10)'=1 D DATE^ASUUDATE
  1.  D P1 S (ASUX("SST"),ASUX("USR"),ASUX("ACC"))=""
  1.  F  S ASUX("SST")=$O(^XTMP("ASUR","R76",ASUX("SST"))) Q:ASUX("SST")=""  D
  1.  .F  S ASUX("USR")=$O(^XTMP("ASUR","R76",ASUX("SST"),ASUX("USR"))) Q:'ASUX("USR")  D
  1.  ..S ASUX("REQ")=ASUX("SST")_$E(ASUX("USR"),3,6)
  1.  ..F  S ASUX("ACC")=$O(^XTMP("ASUR","R76",ASUX("SST"),ASUX("USR"),ASUX("ACC"))) Q:'ASUX("ACC")  S ASUC("TR")=^(ASUX("ACC")) D
  1.  ...F ASUV("FIELD")=1:1:22 D
  1.  ....S ASUC(ASUV("FIELD"),0,ASUX("ACC"))=+$P(ASUC("TR"),U,ASUV("FIELD"))
  1.  ..D P3,HEADER,P1
  1.  D ZAP0
  1.  I ASUK("PTRSEL")]"" Q
  1.  D C^ASUUZIS
  1.  Q
  1. P1 ;EP ;
  1.  F ASUV("ACC")=1,2,3,4,5,9 D
  1.  .F ASUV("FIELD")=1:1:26 D
  1.  ..S ASUC(ASUV("FIELD"),0,ASUV("ACC"))=0
  1.  .F ASUV("FIELD")=15:1:18 D
  1.  ..S ASUC(ASUV("FIELD"),"%",ASUV("ACC"))=0
  1. PTOT ;
  1.  F ASUV("ACC")=1,2,3,4,5,9 D
  1.  .S (ASUC(8,"%",ASUV("ACC")),ASUC(10,"%",ASUV("ACC")),ASUC(12,"%",ASUV("ACC")),ASUC(14,"%",ASUV("ACC")))=0
  1.  .;FIELDS 1,23,24,25 AND 26 ARE COMPUTED RATHER THAN BEING IN THE DATABASE
  1.  .S (ASUC(1,0,ASUV("ACC")),ASUC(23,0,ASUV("ACC")),ASUC(24,0,ASUV("ACC")),ASUC(25,0,ASUV("ACC")),ASUC(26,0,ASUV("ACC")))=0
  1.  F ASUV("FIELD")=1:1:26 D
  1.  .S ASUC(ASUV("FIELD"))=0
  1.  Q
  1. ZAP0 ;EP; -CLEAN UP VARIABLES
  1.  K ASUR,ASUC,ASUV,ASURZX
  1.  Q
  1.  Q:$G(ASUX("REQ"))']""
  1.  S ASUV("SST")="",ASUV("USR")="",ASUC("PG")=ASUC("PG")+1
  1.  D:ASUC("PG")>1 PAZ^ASUURHDR
  1.  W @IOF,!?1,"REPORT #",ASUV("RPT")," ANALYSIS OF ISSUES BY ",$S(ASUV("RPT")=76:"USER",ASUV("RPT")=77:"SUB STATION",ASUV("RPT")=78:"AREA",1:"")
  1.  W ?75,"DATE: ",ASUK("DT"),?104,"PAGE: ",ASUC("PG")
  1.  W !?1,"AREA: ",ASUL(1,"AR","AP")," -",?10,ASUL(1,"AR","NM")
  1.  D SST^ASULDIRR(ASUX("SST")) ;,USR^ASULDIRR(ASUX("USR"))
  1.  I ASUV("RPT")'=78 W !?1,"SUBSTAT: ",ASUL(18,"SST")," - ",ASUL(18,"SST","NM")
  1.  D REQ^ASULDIRR(ASUX("REQ"))
  1.  I ASUV("RPT")=76 W !?1,"USER: ",ASUL(20,"REQ")," - ",ASUL(19,"USR","NM")
  1.  W !!?51,"DRUGS    MEDICAL     SUBSIST   LABORATORY    OFF/ADMIN     ALL OTHER      TOTAL"
  1.  F ASUV("FIELD")=7,8,"P8",9,10,"P10",11,12,"P12",13,14,"P14",1,25,23,24,15,"P15",16,"P16",17,"P17",18,"P18",19,20,21,22 D PRLINE
  1.  F ASUV("FIELD")=5,6,2,3 D PRVALUE
  1.  Q
  1. PRLINE ;
  1.  I ASUV("FIELD")["P" D
  1.  .S ASUV("%")=1,ASUV("FIELD")=$P(ASUV("FIELD"),"P",2),ASUV("ROUT")="PCT"
  1.  E  D
  1.  .S ASUV("ROUT")="PR"_ASUV("FIELD"),ASUV("%")=0
  1.  D @ASUV("ROUT")
  1.  F ASUV("ACC")=1:1:5,9,10 D
  1.  .S ASUV("POS")=$S(ASUV("ACC")=1:45,ASUV("ACC")=2:57,ASUV("ACC")=3:69,ASUV("ACC")=4:81,ASUV("ACC")=5:93,1:105)
  1.  .I ASUV("ACC")=10 D
  1.  ..I ASUV("%") D
  1.  ...W ?117,$J($FN(ASUC(ASUV("FIELD"),"%"),",",1),10)_" %"
  1.  ..E  D
  1.  ...W ?117,$J(ASUC(ASUV("FIELD")),10)
  1.  .E  D
  1.  ..I ASUV("%") D
  1.  ...W ?ASUV("POS"),$J($FN(ASUC(ASUV("FIELD"),"%",ASUV("ACC")),",",1),10)_" %"
  1.  ..E  D
  1.  ...W ?ASUV("POS"),$J(ASUC(ASUV("FIELD"),0,ASUV("ACC")),10)
  1.  Q
  1. PRVALUE ;
  1.  S ASUV("ROUT")="PR"_ASUV("FIELD"),ASUV("%")=0
  1.  D @ASUV("ROUT")
  1.  F ASUV("ACC")=1:1:5,9,10 D
  1.  .S ASUV("POS")=$S(ASUV("ACC")=1:45,ASUV("ACC")=2:57,ASUV("ACC")=3:69,ASUV("ACC")=4:81,ASUV("ACC")=5:93,1:105)
  1.  .I ASUV("ACC")=10 D
  1.  ..W ?117,$J($FN(ASUC(ASUV("FIELD")),",",0),10)
  1.  .E  D
  1.  ..W ?ASUV("POS"),$J($FN(ASUC(ASUV("FIELD"),0,ASUV("ACC")),",",0),10)
  1.  Q
  1. PR3 ;
  1. PR6 ;
  1. PR8 ;
  1. PR10 ;
  1. PR12 ;
  1. PR14 ;
  1. PR20 ;
  1. PR22 ;
  1. PR25 ;
  1. PR24 ;
  1.  W !?31,"YEAR-TO-DATE" Q
  1. PR7 ;
  1.  W !!?1,"SCHEDULED STOCK ISSUE REQUEST" G PR0
  1. PR11 ;
  1.  W !!?1,"UNSCHEDULED STOCK ISSUE REQUEST" G PR0
  1. PR1 ;
  1.  W !!?1,"TOTAL STOCK ISSUE REQUEST" G PR0
  1. PR19 ;
  1.  W !!?1,"DIRECT ISSUE"
  1. PR0 ;
  1.  W !?11,"NUMBER LINE ITEMS -CURRENT MONTH" Q
  1. PR9 ;
  1. PR13 ;
  1. PR21 ;
  1. PR23 ;
  1.  W !!?11,"NUMBER DOCUMENTS  -CURRENT MONTH" Q
  1. PR15 ;
  1.  W !!?1,"NUMBER LINE ITEMS WITH ZERO ISSUE YTD" Q
  1. PR16 ;
  1.  W !!?1,"NUMBER LINE ITEMS WITH PARTIAL ISSUE YTD" Q
  1. PR17 ;
  1.  W !!?1,"NUMBER LINE ITEMS BACK ORDERED YTD" Q
  1. PR18 ;
  1.  W !!?1,"NUMBER LINE ITEMS WITH QUANTITY ADJUSTED YTD" Q
  1. PR26 ;
  1.  W !!?1,"NUMBER LINE ITEMS PENDING B/O RELEASE" Q
  1. PR5 ;
  1.  W !!?1,"VALUE OF DIRECT ISSUES      -CURRENT MONTH" Q
  1. PR2 ;
  1.  W !!?1,"VALUE OF STOCK ISSUES       -CURRENT MONTH" Q
  1. PCT ;
  1.  W !?31,"PERCENT" Q
  1. P3 ;EP ;
  1.  F ASUV("ACC")=1:1:5,9 D
  1.  .S ASUC(1,0,ASUV("ACC"))=ASUC(7,0,ASUV("ACC"))+ASUC(11,0,ASUV("ACC"))
  1.  .S ASUC(23,0,ASUV("ACC"))=ASUC(9,0,ASUV("ACC"))+ASUC(13,0,ASUV("ACC"))
  1.  .S ASUC(24,0,ASUV("ACC"))=ASUC(10,0,ASUV("ACC"))+ASUC(14,0,ASUV("ACC"))
  1.  .S ASUC(24)=ASUC(24)+ASUC(24,0,ASUV("ACC"))
  1.  .S ASURZX(1)=ASUC(24,0,ASUV("ACC")),ASURZX(2)=ASUC(10,0,ASUV("ACC")) D CALC S ASUC(10,"%",ASUV("ACC"))=ASURZX(3)
  1.  .S ASURZX(1)=ASUC(24,0,ASUV("ACC")),ASURZX(2)=ASUC(14,0,ASUV("ACC")) D CALC S ASUC(14,"%",ASUV("ACC"))=ASURZX(3)
  1.  .S ASUC(25,0,ASUV("ACC"))=ASUC(8,0,ASUV("ACC"))+ASUC(12,0,ASUV("ACC"))
  1.  .S ASUC(25)=ASUC(25)+ASUC(25,0,ASUV("ACC"))
  1.  .S ASURZX(1)=ASUC(25,0,ASUV("ACC")),ASURZX(2)=ASUC(8,0,ASUV("ACC")) D CALC S ASUC(8,"%",ASUV("ACC"))=ASURZX(3)
  1.  .S ASURZX(1)=ASUC(25,0,ASUV("ACC")),ASURZX(2)=ASUC(12,0,ASUV("ACC")) D CALC S ASUC(12,"%",ASUV("ACC"))=ASURZX(3)
  1.  .S ASURZX(1)=ASUC(25,0,ASUV("ACC")),ASURZX(2)=ASUC(15,0,ASUV("ACC")) D CALC S ASUC(15,"%",ASUV("ACC"))=ASURZX(3)
  1.  .S ASURZX(1)=ASUC(25,0,ASUV("ACC")),ASURZX(2)=ASUC(16,0,ASUV("ACC")) D CALC S ASUC(16,"%",ASUV("ACC"))=ASURZX(3)
  1.  .S ASURZX(1)=ASUC(25,0,ASUV("ACC")),ASURZX(2)=ASUC(17,0,ASUV("ACC")) D CALC S ASUC(17,"%",ASUV("ACC"))=ASURZX(3)
  1.  .S ASURZX(1)=ASUC(25,0,ASUV("ACC")),ASURZX(2)=ASUC(18,0,ASUV("ACC")) D CALC S ASUC(18,"%",ASUV("ACC"))=ASURZX(3)
  1.  F ASUV("FIELD")=1:1:3,5:1:23 D
  1.  .F ASUV("ACC")=1:1:5,9 D
  1.  ..S ASUC(ASUV("FIELD"))=ASUC(ASUV("FIELD"))+ASUC(ASUV("FIELD"),0,ASUV("ACC"))
  1.  S ASURZX(1)=ASUC(24),ASURZX(2)=ASUC(10) D CALC S ASUC(10,"%")=ASURZX(3)
  1.  S ASURZX(1)=ASUC(24),ASURZX(2)=ASUC(14) D CALC S ASUC(14,"%")=ASURZX(3)
  1.  S ASURZX(1)=ASUC(25),ASURZX(2)=ASUC(16) D CALC S ASUC(16,"%")=ASURZX(3)
  1.  S ASURZX(1)=ASUC(25),ASURZX(2)=ASUC(18) D CALC S ASUC(18,"%")=ASURZX(3)
  1.  S ASURZX(1)=ASUC(25),ASURZX(2)=ASUC(8) D CALC S ASUC(8,"%")=ASURZX(3)
  1.  S ASURZX(1)=ASUC(25),ASURZX(2)=ASUC(12) D CALC S ASUC(12,"%")=ASURZX(3)
  1.  S ASURZX(1)=ASUC(25),ASURZX(2)=ASUC(15) D CALC S ASUC(15,"%")=ASURZX(3)
  1.  S ASURZX(1)=ASUC(25),ASURZX(2)=ASUC(17) D CALC S ASUC(17,"%")=ASURZX(3)
  1.  Q
  1. CALC ;
  1.  I ASURZX(1)'>0 S ASURZX(3)=0 Q
  1.  S ASURZX(3)=(ASURZX(2)/ASURZX(1))*100
  1.  Q