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

ACRFPOL.m

Go to the documentation of this file.
  1. ACRFPOL ;IHS/OIRM/DSD/THL,AEF - PURCHASE ORDER LOG; [ 09/23/2005 9:44 AM ]
  1. ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
  1. EN D EXIT
  1. D EN1
  1. EXIT K ACROUT,ACRQUIT,ACRDA,ACRPODA,ACRFY,^TMP("ACRPOL",$J),ACRPA,ACRPAX,ACRBEG,ACRBEGIN,ACREND,ACRDOCDA,ACRDOC0,ACRDOC,ACRSORT,ACRSSTOT,ACRTOT,ACRRTN,ACRV,ACRDOCX,ACRCANCL
  1. Q
  1. EN1 ;
  1. D OFFICE^ACRFPA
  1. Q:'+$G(ACRDA)
  1. S ACRPODA=ACRDA
  1. W !
  1. D DATES^ACRFDATE
  1. Q:'$D(ACRBEGIN)
  1. D PA
  1. Q:$D(ACRQUIT)!$D(ACROUT)
  1. D SORT
  1. Q:$D(ACRQUIT)!$D(ACROUT)
  1. D CANCEL
  1. Q:$D(ACRQUIT)!$D(ACROUT)
  1. D ZIS
  1. Q
  1. ZIS S ACRRTN="LOG^ACRFPOL"
  1. S ZTDESC="PURCHASE ORDER LOG"
  1. D ^ACRFZIS
  1. Q
  1. LOG ;EP;TO PRINT PURCHASE ORDER LOG
  1. S ACRBEG=ACRBEGIN
  1. F S ACRBEG=$O(^ACRDOC("S",ACRBEG)) Q:'ACRBEG!(ACRBEG>ACREND) D
  1. .S ACRDOCDA=0
  1. .F S ACRDOCDA=$O(^ACRDOC("S",ACRBEG,ACRDOCDA)) Q:'ACRDOCDA D
  1. ..S ACRDOC0=^ACRDOC(ACRDOCDA,0)
  1. ..Q:$E($P(ACRDOC0,U,2),1,8)'?8N
  1. ..Q:ACRPODA'=$P(ACRDOC0,U,8)
  1. ..I $D(ACRCANCL),$P(ACRDOC0,U,14)'["CANCEL" Q
  1. ..I ACRPA(1),ACRPA(1)'=+$G(^ACRDOC(ACRDOCDA,"PA")) Q
  1. ..I ACRPA(1)="EACH" D
  1. ...S ACRPA=+$G(^ACRDOC(ACRDOCDA,"PA"))
  1. ...;S:ACRPA ACRPA=$P(^VA(200,ACRPA,0),U) ;ACR*2.1*19.02 IM16848
  1. ...S:ACRPA ACRPA=$$NAME2^ACRFUTL1(ACRPA) ;ACR*2.1*19.02 IM16848
  1. ..S ACRDOC=$S(ACRSORT=1:$P(ACRDOC0,U,2),ACRSORT=2:$P(ACRDOC0,U),1:+$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5))
  1. ..I ACRSORT=3 D
  1. ...S ACRDOC=$P($G(^AUTTVNDR(+ACRDOC,0)),U)
  1. ...S:ACRDOC="" ACRDOC="NOT STATED"
  1. ..I ACRPA]"",ACRDOC]"",ACRDOCDA]"" S ^TMP("ACRPOL",$J,ACRPA,ACRDOC,ACRDOCDA)=""
  1. Q:'$D(^TMP("ACRPOL",$J))
  1. D HEAD
  1. S (ACRPAX,ACRPA)=""
  1. F S ACRPA=$O(^TMP("ACRPOL",$J,ACRPA)) Q:ACRPA=""!$D(ACROUT)!$D(ACRQUIT) D
  1. .I ACRPAX'=ACRPA D
  1. ..W !?10,"PURCHASING AGENT: ",$S($L(ACRPA)>1:ACRPA,1:"NOT STATED")
  1. ..S ACRPAX=ACRPA
  1. ..S ACRJ=0
  1. .S (ACRDOCX,ACRDOC)=""
  1. .F S ACRDOC=$O(^TMP("ACRPOL",$J,ACRPA,ACRDOC)) Q:ACRDOC=""!$D(ACROUT)!$D(ACRQUIT) D DISPLAY
  1. .W !?15,"Total PURCHASE ORDERS: ",ACRJ
  1. D PAUSE^ACRFWARN
  1. Q
  1. DISPLAY ;DIPLAY EACH PO
  1. I ACRSORT=3 D
  1. .I ACRDOCX]"",ACRDOCX'=ACRDOC D I 1
  1. ..W !?66,"-------------"
  1. ..W !?50,"VENDOR TOTAL: ",?66,$J($FN(ACRV(ACRDOCX),"P,",2),13)
  1. ..W $$DASH^ACRFMENU
  1. ..K ACRV(ACRDOC)
  1. ..S ACRDOCX=ACRDOC
  1. .E S ACRDOCX=ACRDOC
  1. S ACRJ=ACRJ+1
  1. S ACRDOCDA=0
  1. F S ACRDOCDA=$O(^TMP("ACRPOL",$J,ACRPA,ACRDOC,ACRDOCDA)) Q:'ACRDOCDA!$D(ACROUT)!$D(ACRQUIT) D
  1. .K DXS,DIP,DC,DN,D0
  1. .S D0=ACRDOCDA
  1. .S N(1)=""
  1. .D ^ACRPOL
  1. .I $Y+4>IOSL D
  1. ..D PAUSE^ACRFWARN
  1. ..D:'$D(ACRQUIT) HEAD
  1. Q
  1. PA ;EP;
  1. S DIR(0)="SO^1:DO NOT Print by Purchasing Agent;2:Print for ALL Purchasing Agents;3:Print for ONE Purchasing Agent"
  1. W !
  1. D DIR^ACRFDIC
  1. Q:$D(ACRQUIT)!$D(ACROUT)
  1. I Y=1 D Q
  1. .S ACRPA(1)="ALL"
  1. .S ACRPA="ALL"
  1. I Y=2 S ACRPA(1)="EACH" Q
  1. S DIC="^ACRPA("
  1. S DIC("A")="Which PURCHASING AGENT: "
  1. S DIC(0)="AEMQZ"
  1. W !
  1. D DIC^ACRFDIC
  1. Q:$D(ACRQUIT)!$D(ACROUT)
  1. S (ACRPA,ACRPA(1))=+Y
  1. ;S:$D(^VA(200,+ACRPA,0)) ACRPA=$P(^(0),U) ;ACR*2.1*19.02 IM16848
  1. S:$D(^VA(200,+ACRPA,0)) ACRPA=$$NAME2^ACRFUTL1(+ACRPA) ;ACR*2.1*19.02 IM16848
  1. Q
  1. SORT ;SET THE LIST SEQUENCE BY PO OR REQ NUMBER
  1. S DIR(0)="SO^1:List by PO Number;2:List by Requisition Number;3:List by Vendor"
  1. S DIR("A")="Which sequence"
  1. S DIR("B")=1
  1. W !
  1. D DIR^ACRFDIC
  1. Q:$D(ACROUT)!$D(ACRQUIT)!($G(Y)<1)
  1. S ACRSORT=+Y
  1. Q
  1. W @IOF
  1. W !?10,"PURCHASE ORDER LOG"
  1. W ?55,"REPORT DATE: "
  1. S Y=DT
  1. X ^DD("DD")
  1. W Y
  1. W !?10,"ORDERS FROM: "
  1. S Y=ACRBEGIN
  1. X ^DD("DD")
  1. W Y
  1. S ACRI=$G(ACRI)+1
  1. W ?55,"PAGE.......: ",ACRI
  1. W !?10,"ORDERS TO..: "
  1. S Y=ACREND
  1. X ^DD("DD")
  1. W Y
  1. W:ACRI=1 !?10,"('*' indicates CANCELLED Purchase Orders)"
  1. W !?34,"DATE OF"
  1. W !,"PO NUMBER"
  1. W ?15,"REQUISITION NO."
  1. W ?34,"ORDER"
  1. W ?44,"CONTRACTOR"
  1. W ?66,"AMOUNT"
  1. W !,"-------------"
  1. W ?15,"---------------"
  1. W ?34,"--------"
  1. W ?44,"--------------------"
  1. W ?66,"-------------"
  1. Q
  1. SSTOT ;EP;TO CALCULATE AND PRINT THE PO TOTAL ON THE PO LOG LISTING
  1. N ACR
  1. S ACRSSTOT=0
  1. S ACR=ACRDOCDA
  1. D SSTOT^ACRFWARN
  1. W:$G(ACRSSTOT) $J($FN(ACRSSTOT,"P,",2),13)
  1. I ACRSORT=3 S ACRV(ACRDOC)=$G(ACRV(ACRDOC))+ACRSSTOT
  1. Q
  1. CANCEL ;PRINT CANCELLED PO'S ONLY
  1. K ACRCANCL
  1. S DIR(0)="YO"
  1. S DIR("A")="Print CANCELLED PO's only"
  1. S DIR("B")="NO"
  1. W !
  1. D DIR^ACRFDIC
  1. I +Y=1 S ACRCANCL=""
  1. Q