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

ACRFEA42.m

Go to the documentation of this file. 
  1. ACRFEA42 ;IHS/OIRM/DSD/THL,AEF - EDIT FINANCIAL DATA - CON'T;  [ 03/28/2007   9:44 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**22**;NOV 05, 2001
  1.  ;;UTILITY ROUTINE WITH MULTIPLE ENRY POINTS FOR VARIOUS DOCUMENT
  1.  ;;EDITING AND PROCESSING FUNCTIONS
  1. PR ;EP;TO PRINT DOCUMENT DURING DATA ENTRY/EDIT
  1.  I ACRENTRY["OBL"!(ACRENTRY="PO"),'$D(ACRSS6),'$D(ACROUT) D
  1.  .S ACRTXDA=$P(ACROBLAP,U,4)
  1.  .I ACRTXDA=11 D  Q:$D(ACROUT)
  1.  ..S DIR("A")="Include Purchase Order Terms and Conditions?  "
  1.  ..D OUT^ACRFEA2
  1.  ..Q:$D(ACROUT)!$D(ACRQUIT)
  1.  ..S:ACRY=1 ACRPOTC=""
  1.  .D PRINT^ACRFSHIP
  1.  .D PSC^ACRFPO1:ACRREFX=103!(ACRREFX=349)!(ACRREFX=326)
  1.  .Q:$D(ACROUT)
  1.  .K ACRQUIT
  1.  .S (ACRPRT,ACRREQST)=""
  1.  .I $D(ACRREV),ACRREF=103!(ACRREF=349)!(ACRREF=326)!(ACRREF=210) D
  1.  ..S ACRREF=116
  1.  ..S ACRREFDA=$O(^AUTTDOCR("B",ACRREF,0))
  1.  .N ACRREV
  1.  .S ACRREFX=$S(ACRENTRY'="PO":ACRREF,1:ACRREFX)
  1.  .D REQ^ACRFQ
  1.  .K ACRPRT,ACRREQST
  1.  K ACRQUIT
  1.  Q
  1. NJ ;EP;EDIT NARRATIVE OR JUSTIFICATION
  1.  I ACRREF=148 D COURSE^ACRFSS3 Q
  1.  I "^103^349^326^116^204^210^"[(U_ACRREFX_U),'$D(ACRDIE)!($G(ACRDR)="") S ACRDIE="^ACROBL(",ACRDR="[ACR REQUEST INFO]"
  1.  D SCREEN^ACRFAU
  1.  D:'$D(ACRSCREN) DISP
  1.  N ACRI
  1.  I '$D(ACRZDA)#2,$D(ACRDOCDA)#2 S ACRZDA=ACRDOCDA
  1.  S:'$D(ACRENTRY)#2 ACRENTRY=""
  1.  I $D(ACRSCREN) D EDIE1^ACRFEA2 Q
  1.  D EDIE^ACRFEA2
  1.  Q
  1. QD ;EP;EDIT QUANTITY DISCOUNT INFO
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRDOC("
  1.  S DR="[ACR QUANTITY DISCOUNT]"
  1.  D DIE^ACRFDIC
  1.  Q
  1. AP ;EP;SEND DOCUMENT FOR APPROVAL
  1.  I '$D(ACRPRCS),'$D(ACRREV),$D(^ACRSS("C",ACRDOCDA)) D APPROVE^ACRFEA21
  1.  K ACRQUIT,ACRPRT,ACROUT
  1.  Q
  1. ASUM ;EP;TO PRINT ACCOUNT SUMMARY
  1.  S ACRENTR1="LOCBAMT"
  1.  S ACRDISDX=""
  1.  S ACRGREF="^ACRLOCB"
  1.  S ACRY="DEPARTMENT",DA=$P(ACRDOC0,U,6)
  1.  W !!?5,"ACCOUNT SUMMARY YEAR-TO-DATE:"
  1.  W !,"----------------------------------"
  1.  D EN^ACRFDTP2
  1.  D SUBSET^ACRFDTP2
  1.  N ACRX
  1.  F ACRX=ACR0,ACR2,ACR16,ACR5,ACR17 W @ACRX
  1.  I $E(IOST,1,2)="C-",$D(ACRREV) D PAUSE^ACRFWARN
  1.  Q
  1. CR ;EP;CHANGE TYPE OF REQUEST
  1.  S DIR("A")="    Change Type of Request? "
  1.  D OUT^ACRFEA2
  1.  Q:$D(ACROUT)!$D(ACRQUIT)
  1.  Q:ACRY'=1
  1. CR1 S DA=ACRDOCDA,DR="907      Type of Request"
  1.  S DIE="^ACROBL("
  1.  D DIE^ACRFDIC
  1.  S ACRTXDA=$P(ACROBLAP,U,4)
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRDOC("
  1.  S DR=".04////"_ACRTXDA_";.07////"_ACRTXDA
  1.  D DIE^ACRFDIC
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACROBL("
  1.  S DR="907////"_ACRTXDA
  1.  D DIE^ACRFDIC
  1.  Q
  1. BP ;EP;
  1.  D BAPPEND^ACRFBOIL
  1.  S DIR("A")="Add Boiler Plate Statement? "
  1.  D OUT^ACRFEA2
  1.  Q:$D(ACROUT)!$D(ACRQUIT)
  1.  Q:ACRY'=1
  1. BP1 D DOCBOIL^ACRFBOIL
  1.  Q
  1. RV ;EP;TO ENTER REQUESTED VENDOR DATA
  1.  F  D RV2 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  K ACRQUIT
  1.  Q
  1. RV2 ;S DIR("A")="Enter/Edit Requested Vendor? "          ;ACR*2.1*22.11l
  1.  ;D ADD^ACRFVLK                                       ;ACR*2.1*22.11l
  1.  ;Q:$D(ACRQUIT)                                       ;ACR*2.1*22.11l
  1.  ;Q:$D(ACROUT)                                        ;ACR*2.1*22.11l
  1.  W !
  1.  ;I $P(^ACRDOC(ACRDOCDA,0),U,4)=30,'$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5) S ACRY=1  ;ACR*2.1*22.11l
  1.  ;E  D OUT^ACRFEA2                             ;ACR*2.1*22.11l
  1.  ;Q:$D(ACROUT)!$D(ACRQUIT)                     ;ACR*2.1*22.11l
  1.  ;Q:ACRY'=1                                    ;ACR*2.1*22.11l
  1. RV1 ;EP;TO ENTER REQUESTED VENDOR DATA ;HEAVILY MODIFIED TO ALLOW SELECTION ONLY;ACR*2.1*22.11l 
  1.  ;THE CODE BELOW WILL CHECK TO SEE IF THE VENDOR IS ACTIVE
  1.  ;AND WILL NOT ALLOW USER TO CHOOSE AN INACTIVE VENDOR
  1.  D FINDVND                                     ; ACR*2.1*22.11l
  1.  Q:ACRQUIT=1                                   ; ACR*2.1*22.11l
  1.  ;
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRDOC("
  1.  S DR=$S(ACRREF'=148:"103070",1:"148181")   ;CONTRACTOR OR TRAINING PAY FIELDS
  1.  ;S DR=DR_"///"_ACRVND                      ; ACR*2.1*22.11l
  1.  S DR=DR_"////"_+ACRVND                     ;STUFF POINTER; ACR*2.1*22.11l
  1.  ;W !!?21,"|==============================|"
  1.  D DIE^ACRFDIC
  1.  D DISP^ACRFVLK                           ; ACR*2.1*22.11l
  1.  S ACRQUIT=""                             ; ACR*2.1*22.11l
  1.  S ACRDOC0=^ACRDOC(ACRDOCDA,0)            ;REFRESH VARIABLE ACR*2.1*22.11l
  1.  I ACRREF'=148,$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5) Q
  1.  I ACRREF=148,+$G(^ACRDOC(ACRDOCDA,"TRNG3")) Q
  1.  I $P(^ACRDOC(ACRDOCDA,0),U,4)=30,'$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5) D  Q
  1.  .W !!,"You must enter a vendor from the STANDARD Vendor list"
  1.  .W !,"before the OBLIGATE/PAY transaction can be completed."
  1.  .D PAUSE^ACRFWARN
  1.  ;.G RV1                                  ;ACR*2.1*22.11l
  1.  ;S DA=ACRDOCDA                           ;ACR*2.1*22.11l
  1.  ;S DIE="^ACRDOC("                        ;ACR*2.1*22.11l
  1.  ;S DR="[ACR TMP VENDOR DATA]"            ;ACR*2.1*22.11l
  1.  ;D DDS^ACRFDIC                           ;ACR*2.1*22.11l
  1.  Q:'$D(ACRSCREN)
  1.  K ACRSCREN
  1.  W !!,"You did not select a Vendor from the Standard Vendor table."
  1.  W !,"You may enter data on the requested Vendor."
  1.  W !
  1.  D DIE^ACRFDIC
  1.  Q
  1. DISP ;EP;TO DISPLAY FINANCIAL ACCOUNT DATA
  1.  W @IOF
  1.  W ?20,"Current data:"
  1.  W !
  1.  N DXS,DIP,DC,DN
  1.  I $D(ACRREF),ACRREF=130!(ACRREF=600) S ACRRTN="^ACRTVL"
  1.  S D0=$S($D(ACRZDA):ACRZDA,1:ACRDOCDA)
  1.  D:$G(ACRRTN)]"" @ACRRTN
  1.  Q
  1. ATTACH ;EP;TO INDICATE NUMBER OF ATTACHMENTS
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRDOC("
  1.  S DR="13T;S:X<1 Y=""@1"";13.1;@1"
  1.  W !
  1.  D DIE^ACRFDIC
  1.  Q
  1. RS ;EP;TO REVIEW STATUS OF DOCUMENT
  1.  S D0=ACRDOCDA
  1.  D SETDOC^ACRFEA1
  1.  S:'$D(ACRREFX) ACRREFX=ACRREF
  1.  S ACRCSI=""
  1.  D ^ACRFPAPV
  1.  K ACRCSI
  1.  Q
  1. DOCSTAT ;EP;TO EDIT THE STATUS OF THE DOCUMENT IN PROCUREMENT PROCESSING
  1.  W !!,"Describe below the current status of this document in procurement."
  1.  W !
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRDOC("
  1.  S DR=1201
  1.  D DIE^ACRFDIC
  1.  Q
  1. PDOCSTAT ;EP;TO PRINT DOCUMENT STATUS REPORT
  1.  Q:'$D(ACRDOCDA)
  1.  Q:'ACRDOCDA!'$D(^ACRDOC(+ACRDOCDA,12,1))
  1.  W !!,"Procurement status report:"
  1.  N DXS,DIP,DC,DN
  1.  S D0=ACRDOCDA
  1.  D ^ACRPDS
  1.  Q
  1. FINDVND ; Ask / Lookup Vendor               ;ACR*2.1*22.11l NEW SUBROUTINE
  1.  W:$D(IOF) @IOF
  1.  K DD,DO,X,Y,DIC,DA,DR,DINUM,D,DLAYGO
  1.  S ACRQUIT=0
  1.  S DIC="^AUTTVNDR("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Which Vendor? "
  1.  S ACRVND=$$VENDOR^ACRFUFMU(ACRDOCDA)
  1.  S DIC("B")=$S(ACRVND>0:ACRVND,1:"")     ;SET DEFAULT TO CURRENT VENDOR
  1.  S DIC("S")="I '$$IDATE^ACRFUFMU(+Y)"    ;DO NOT ALLOW SELECTION OF INACTIVE
  1.  D ^DIC
  1.  I +Y<1 S ACRQUIT=1 Q
  1.  S ACRVND=Y
  1.  S ACRVND(0)=Y(0)
  1.  Q