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

ASURM83P.m

Go to the documentation of this file. 
  1. ASURM83P ; IHS/ITSC/LMH -RPT 83 INVOICE SUMMARY ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine formats and prints report 83 Invoice Summary 
  1.  ;Report.
  1.  I '$D(DUZ(2)) W !,"Report must be run from Kernel option" Q
  1.  I '$D(IO) D HOME^%ZIS
  1.  D:'$D(U) ^XBKVAR
  1.  D:'$D(ASUK("DT","FM")) DATE^ASUUDATE
  1.  I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST
  1.  S ASUC("LN")=IOSL+1,(ASUC("PG"),ASUF("BK"))=0,ASUF("HDR")=1
  1.  D P0 Q:$D(DUOUT)  Q:$D(DTOUT)
  1.  S ASUX("AO MO")=$P(^XTMP("ASUR","R83",0),U,2),ASUX("AO DT")=$P(^XTMP("ASUR","R83",0),U)
  1.  S ASUK("PTRSEL")=$G(ASUK("PTRSEL"))
  1.  I ASUK("PTRSEL")']"" D
  1.  .S ZTRTN="PSER^ASURM83P",ZTDESC="SAMS RPT 83" D O^ASUUZIS
  1.  .I POP S IOP=$I D ^%ZIS
  1.  I ASUK(ASUK("PTR"),"Q") Q
  1. PSER ;EP;FOR TASKMAN QUEUE OF PRINT
  1.  D U^ASUUZIS
  1.  S ASUV("RPT")="R83",ASUQ("HDR")="HDR^ASURM83P"
  1.  D ^ASUUDATA I ASUX("NDTA") G KIL
  1.  S ASUT="R83",ASUT(ASUT,"PT","SST")=0
  1.  S (ASUX("LINE"),ASUV("VOU"))=""
  1.  S (ASUC("VAL"),ASUC("TRANS"),ASUC("VOU"),ASUC("USR"),ASUC("SSA"),ASUC("SST"),ASUC("AR"))=0
  1.  F ASUC("TR")=0:1 S ASUT(ASUT,"PT","SST")=$O(^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST")))  Q:ASUT(ASUT,"PT","SST")=""  D  Q:$D(DUOUT)
  1.  .S ASUX("AR")=$E(ASUT(ASUT,"PT","SST"),1,2)
  1.  .D SST^ASULDIRR(ASUT(ASUT,"PT","SST"))
  1.  .S ASUT(ASUT,"PT","SSA")=""
  1.  .F  S ASUT(ASUT,"PT","SSA")=$O(^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"))) Q:ASUT(ASUT,"PT","SSA")=""  D  Q:$D(DUOUT)
  1.  ..D SSA^ASULDIRR(ASUT(ASUT,"PT","SSA"))
  1.  ..S ASUT(ASUT,"PT","USR")=""
  1.  ..F  S ASUT(ASUT,"PT","USR")=$O(^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"),ASUT(ASUT,"PT","USR"))) Q:ASUT(ASUT,"PT","USR")=""  D P1
  1.  ..S ASUC("LN")=ASUC("LN")+2
  1.  ..D:ASUC("LN")>(IOSL-2) HEADER Q:$D(DUOUT)
  1.  ..W !?8,"TOTAL FOR SUB SUB ACTIVITY ",ASUL(17,"SSA")," ",ASUL(17,"SSA","NM"),?69,$J($FN(ASUC("USR"),",",2),10),!
  1.  ..S ASUC("SSA")=$G(ASUC("SSA"))+ASUC("USR"),ASUC("USR")=0
  1.  ..S ASUC("LN")=61,ASUF("HDR")=1
  1.  .W !!?5,"TOTAL FOR FACILITY ",ASUL(18,"SST")," ",ASUL(18,"SST","NM"),?69,$J($FN(ASUC("SSA"),",",2),10),!
  1.  .S ASUF("HDR")=1
  1.  .S ASUC("SST")=$G(ASUC("SST"))+ASUC("SSA"),ASUC("SSA")=0
  1.  .S ASUC("LN")=ASUC("LN")+3
  1.  I ASUC("LN")>(IOSL-2) D HEADER Q:$D(DUOUT)
  1.  W !!!?2,"TOTAL FOR AREA ",ASUL(1,"AR","AP")," ",ASUL(1,"AR","NM"),?69,$J($FN(ASUC("SST"),",",2),10),!
  1. KIL ;
  1.  K ASUC,ASUF,ASUT,ASUV,ASUX
  1.  F X=3:1:22 K ASUL(X) ;Clear Table Lookup fields
  1.  K DIC,DA,X,Y
  1.  D PAZ^ASUURHDR
  1.  I ASUK("PTRSEL")]"" W @IOF Q
  1.  D C^ASUUZIS
  1.  Q
  1. P0 ;
  1.  D:'$D(ASUK("DT","FM")) DATE^ASUUDATE
  1.  S ASUHDA=0,ASUX("AR")=ASUL(1,"AR","AP")
  1.  S ASUV("R83DT")=ASUK("DT","FM")
  1.  S ASUP("SEL83")=$G(ASUP("SEL83"))
  1.  I ASUX("AR")']"" S ^XTMP("ASUR","R83",1)="NONE" G EXIT
  1.  I ASUP("SEL83") D  ;MENU SELECTED
  1.  .D CMPT
  1.  E  D
  1.  .I $E($G(IOST),1,2)="C-",ION'["HFS" D
  1.  ..K DIR S DIR(0)="Y",DIR("A")="Do you want to re-print the most recent Report 83"
  1.  ..D ^DIR K DIR Q:$D(DUOUT)  Q:$D(DTOUT)
  1.  .E  D
  1.  ..S Y=1
  1.  .I Y D  ;
  1.  ..I $L($O(^XTMP("ASUR","R83","")))>0 Q
  1.  ..S X=$P(^ASUSITE(1,0),U,8)
  1.  ..I X]"" D
  1.  ...S ASUV("R83DT")=$P(^ASUSITE(1,0),U,8)
  1.  ..E  D
  1.  ...S X=""
  1.  ...F  S X=$O(^ASUH("AX",X)) Q:X=""  S ASUV("R83DT")=X
  1.  ..D CMPT
  1.  .E  D
  1.  ..S DIR(0)="POA^ASUML(",DIR("A")="Enter the beginning date of the month to report " D ^DIR K DIR
  1.  ..Q:$D(DUOUT)  Q:$D(DTOUT)  Q:X']""  Q:Y<0
  1.  ..S ASUV("XLGMO")=+Y
  1.  ..I $P(^ASUML(ASUV("XLGMO"),1,0),U,3)=1 D
  1.  ...S ASUV("R83DT")=$P(^ASUML(ASUV("XLGMO"),1,1,0),U)
  1.  ..E  D
  1.  ...W !!,"The month you have choosen had more than one Extract Process.  One was likely"
  1.  ...W !,"not for local update, ie. it was for DDPS processing only.  You must now"
  1.  ...W !,"indicate which Extract Process's records should be included on the report:",!!
  1.  ...F Y=1:1 S X=$G(^ASUML(ASUV("XLGMO"),1,Y,0)) Q:X=""  D
  1.  ....W !?5,Y,?10,"DATE: ",$P(X,U)
  1.  ....W !
  1.  ...K DIR S DIR(0)="N:1:Y:0",DIR("A")="SELECT EXTRACT NUMBER (1-"_Y D ^DIR
  1.  ...S ASUV("R83DT")=$P($G(^ASUML(ASUV("XLGMO"),1,+Y,0)),U)
  1.  ..S X=$O(^ASUH("AX",ASUV("R83DT"),""))
  1.  ..I X']"" D  Q
  1.  ...W !!,"NO REPORT 83 DATA FOR ",$S($D(Y(0)):Y(0),1:"SELECTED MONTH")
  1.  ...S DUOUT=1
  1.  ..K ^XTMP("ASUR","R83") S ^XTMP("ASUR","R83",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
  1.  ..D CMPT
  1. EXIT ;
  1.  Q
  1. P1 ;
  1.  F X=19,20,22 K ASUL(X)
  1.  D REQ^ASULDIRR(ASUT(ASUT,"PT","USR"))
  1.  ;LOGIC TO CAUSE PAGE BRK FOR DENTAL OR OEH FOR OKLAHOMA
  1.  I ASUX("AR")=50 I ASUL(19,"USR","NM")["DEN"!(ASUL(19,"USR","NM")["OEH") S ASUF("HDR")=1
  1.  S ASUT(ASUT,"VOU")=""
  1.  F  S ASUT(ASUT,"VOU")=$O(^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"),ASUT(ASUT,"PT","USR"),ASUT(ASUT,"VOU"))) Q:ASUT(ASUT,"VOU")=""  D  Q:$D(DUOUT)
  1.  .S ASUT("TRCD")=""
  1.  .F  S ASUT("TRCD")=$O(^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"),ASUT(ASUT,"PT","USR"),ASUT(ASUT,"VOU"),ASUT("TRCD"))) Q:ASUT("TRCD")=""  D  Q:$D(DUOUT)
  1.  ..S ASUX("LINE")=""
  1.  ..F  S ASUX("LINE")=$O(^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"),ASUT(ASUT,"PT","USR"),ASUT(ASUT,"VOU"),ASUT("TRCD"),ASUX("LINE"))) Q:ASUX("LINE")=""  D  Q:$D(DUOUT)
  1.  ...I ASUF("HDR")!(ASUC("LN")>(IOSL-2)) D HEADER Q:$D(DUOUT)
  1.  ...S ASUX(1)=^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"),ASUT(ASUT,"PT","USR"),ASUT(ASUT,"VOU"),ASUT("TRCD"),ASUX("LINE"))
  1.  ...S ASUT(ASUT,"CAN")=$P(ASUX(1),U),ASUT(ASUT,"VAL")=$P(ASUX(1),U,2)
  1.  ...I $E(ASUT("TRCD"),2)?1A S ASUT(ASUT,"VAL")=ASUT(ASUT,"VAL")*-1
  1.  ...S ASUV("VAL")=$FN(ASUT(ASUT,"VAL"),"+",2)
  1.  ...S ASUC("VAL")=ASUC("VAL")+ASUV("VAL")
  1.  ..W !,ASUL(17,"SSA"),?3,ASUL(17,"SSA","NM"),?27,ASUT(ASUT,"CAN"),?35,ASUL(20,"REQ"),?39,ASUL(19,"USR","NM")
  1.  ..W ?55,ASUT(ASUT,"VOU")
  1.  ..W ?66,ASUT("TRCD"),?69,$J($FN(ASUC("VAL"),",",2),10)
  1.  ..S ASUC("LN")=ASUC("LN")+1
  1.  ..S ASUC("VOU")=ASUC("VOU")+ASUC("VAL"),ASUC("VAL")=0
  1.  .W ! S ASUC("LN")=ASUC("LN")+1
  1.  W !?11,"TOTAL FOR USER ",?35,ASUL(20,"REQ"),?39,ASUL(19,"USR","NM"),?69,$J($FN(ASUC("VOU"),",",2),10),!
  1.  S ASUC("USR")=ASUC("USR")+ASUC("VOU"),ASUC("VOU")=0
  1.  S ASUF("HDR")=0
  1.  S ASUC("PG")=$G(ASUC("PG"))+1 D:ASUC("PG")>1 PAZ^ASUURHDR Q:$D(DUOUT)  W @IOF
  1.  W "REPORT #83 MONTHLY INVOICE SUMMARY REPORT",?51,"DATE: ",$G(ASUK("DT")),?69,"PAGE :",$J(ASUC("PG"),5)
  1.  W !!,"CHARGED TO: AREA : ",?19,ASUL(1,"AR","AP")," ",$G(ASUL(1,"AR","NM"))
  1.  D:'$D(ASUL(18,"SST")) SST^ASULDIRR(ASUT(ASUT,"PT","SST"))
  1.  W !?13,"FAC : ",ASUL(18,"SST")," ",ASUL(18,"SST","NM")
  1.  W ?45,"AS OF MONTH: ",$G(ASUX("AO MO"))
  1.  W !!,"SUB",?55,"INVOICE"
  1.  W !,"SUB",?35,"USER",?55,"VOUCHER",?66,"P/"
  1.  W !,"ACT-NAME",?27,"CAN",?35,"CODE-NAME",?55,"NUMBER",?67,"C",?74,"VALUE",!
  1.  S ASUC("LN")=8
  1. HDR ;
  1.  Q
  1. CMPT ;EP ;COMPUTE EXTRACTS
  1.  K ^XTMP("ASUR","R83") S ASUT="ISS"
  1.  S ^XTMP("ASUR","R83",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
  1.  F ASUC("TR")=1:1 S ASUHDA=$O(^ASUH("AX",ASUV("R83DT"),$G(ASUHDA))) Q:ASUHDA=""  Q:ASUHDA'?1N.N  D
  1.  .;S $P(^ASUH(ASUHDA,0),U,5)=ASUK("DT","FM")
  1.  .S ASUT("TRCD")=$P(^ASUH(ASUHDA,1),U) Q:$E(ASUT("TRCD"))'=3
  1.  .Q:"3132333K3L"'[ASUT("TRCD")
  1.  .D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']""
  1.  .Q:$E(ASUT(ASUT,"CAN"),2,3)'=ASUL(1,"AR","AP")
  1.  .I ASUT(ASUT,"PT","SST")']"" D
  1.  ..D SST^ASULDIRR(ASUT(ASUT,"SST"))
  1.  ..S ASUT(ASUT,"PT","SST")=ASUL(18,"SST","E#")
  1.  .I ASUT(ASUT,"PT","USR")']"" D
  1.  ..D USR^ASULDIRR(ASUT(ASUT,"USR"))
  1.  ..S ASUT(ASUT,"PT","USR")=ASUL(19,"USR","E#")
  1.  .I ASUT(ASUT,"PT","SST")']"" D
  1.  ..D SSA^ASULDIRR(ASUT(ASUT,"SSA"))
  1.  ..S ASUT(ASUT,"PT","SSA")=ASUL(17,"SSA","E#")
  1.  .S ^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"),ASUT(ASUT,"PT","USR"),ASUT(ASUT,"VOU"),ASUT("TRCD"),ASUC("TR"))=ASUT(ASUT,"CAN")_U_ASUT(ASUT,"VAL")
  1.  K ASUT(ASUT)
  1.  S ^XTMP("ASUR","R83",0)=ASUK("DT","FM")_U_ASUK("DT","MONTH")
  1.  Q