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

ACRFUFM2.m

Go to the documentation of this file. 
  1. ACRFUFM2 ;IHS/OIRM/DSD/AEF - UTILITY STANDALONE TO FIND OPEN DOCUMENTS FOR UFMS [ 12/26/2006   9:44 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGMT SYSTEM;**22**;NOV 05, 2001
  1.  ;
  1.  ;This routine loops through the FMS Document file looking for
  1.  ;approved non-Credit Card and non-BPA Purchase Orders that do
  1.  ;not have a Final Receiving Report or a Final Invoice
  1.  ;Also checks for Cancelled
  1.  ;
  1. EN(ACRBDAT) ;----- MAIN ENTRY POINT
  1.  ;
  1.  ;ENTERS WITH BEGIN SEARCH DATE IN DT FORMAT
  1.  ;         IF DATE=NULL, ROUTINE SETS DEFAULT TO FY 2005,06+
  1.  I ACRBDAT="" S ACRBDAT=3041000
  1.  D ^XBKVAR
  1.  D HOME^%ZIS
  1.  K ^TMP("ACROPEN")
  1.  K ^TMP("ACROVEN")
  1.  K ^TMP("ACRAVEN")
  1.  D LOOP(ACRBDAT)
  1.  Q
  1. LOOP(ACRBDAT) ;----- LOOP THROUGH FMS DOCUMENT FILE AND SET TMP FILE
  1.  ;              USE DOCUMENT DATE "DT" CROSS-REFERENCE
  1.  ;
  1.  N ACRCNT,ACRDOCDA,ACRDOC0,ACRREQ,ACRCNC,ACRRTYP,ACRREF
  1.  N ACRAVEN,ACROVEN,ACROPEN,ACRTMP
  1.  S (ACRAVEN,ACROVEN,ACRODOC)=0
  1.  F  S ACRBDAT=$O(^ACRDOC("DT",ACRBDAT)) Q:'ACRBDAT  D
  1.  .S ACRDOCDA=0
  1.  .F  S ACRDOCDA=$O(^ACRDOC("DT",ACRBDAT,ACRDOCDA)) Q:'ACRDOCDA  D
  1.  ..S ACRDOC0=$G(^ACRDOC(ACRDOCDA,0))
  1.  ..S ACRREQ=$P(ACRDOC0,U)
  1.  ..Q:ACRREQ']""
  1.  ..S ACRDOC=$P(ACRDOC0,U,2)
  1.  ..S ACRVND=$P($$VENDOR(ACRDOCDA),U)
  1.  ..I ACRVND]"",ACRVND'="NO VENDOR",ACRRTYP'["TRAVEL" D
  1.  ...S ACRTMP=$$VEND(ACRVND)
  1.  ...I '$D(^TMP("ACRAVEN",$J,ACRVND)) S ACRAVEN=ACRAVEN+1  ;COUNT ACTIVE VENDORS
  1.  ...S ^TMP("ACRAVEN",$J,ACRVND)=ACRBDAT_U_ACRTMP     ;CAPTURE ALL VENDORS
  1.  ..S ACRAPV=$G(^ACROBL(ACRDOCDA,"APV"))
  1.  ..S ACRCNC=$$CANCEL(ACRDOC0,ACRAPV)
  1.  ..Q:ACRCNC="CANCEL"                       ;DON'T WANT CANCELLED
  1.  ..S ACRRTYP=$$REQTP^ACRFSSU(ACRDOCDA)     ;GET REQUEST TYPE
  1.  ..S ACRREF=$$REF^ACRFUTL(ACRDOCDA)        ;GET EXTERNAL REFERENCE CODE
  1.  ..Q:ACRREF=130                            ;TRAVEL ORDER
  1.  ..Q:ACRREF=116                            ;REQUISITION
  1.  ..I ACRVND,ACRREF=148!(ACRRTYP["TRAINING") D  Q
  1.  ...S ACRDOC=ACRREQ
  1.  ...D REST(ACRDOCDA,ACRDOC,ACRAPV,ACRVND)
  1.  ..I ACRREF=600!(ACRREF=602)!(ACRRTYP["TRAVEL") D TRAVEL(ACRDOCDA) Q  ;TREAT TRAVEL VOUCHER/ADVANCE LATER
  1.  ..D REST(ACRDOCDA,ACRDOC,ACRAPV,ACRVND)    ;EVERYTHING ELSE SHOULD BE SOME KIND OF PURCHASE ORDER
  1.  S ^TMP("ACRAVEN",$J,"ALL CURRENT VENDORS")=ACRAVEN
  1.  S ^TMP("ACROVEN",$J,"ALL OPEN DOC VENDORS")=ACROVEN
  1.  S ^TMP("ACROPEN",$J,"ALL OPEN DOCUMENTS")=ACRODOC
  1.  Q
  1. REST(ACRDOCDA,ACRDOC,ACRAPV,ACRVND) ;SCREEN THE REST
  1.  N ACRTMP
  1.  I ACRDOC="" Q                            ;ONLY WANT PURCHASE ORDERS
  1.  I $E(ACRDOC,9,10)="BP" Q                 ;DON'T WANT ORIGINAL BPA'S
  1.  S ACROPEN=$$OPEN(ACRAPV)
  1.  Q:ACROPEN="CLOSED"                        ;NOT OPEN
  1.  S ACRTMP=ACRCNC_U_ACRBDAT_U_ACRDOCDA_U_ACRREQ_U_ACRDOC_U_ACRVND_U
  1.  S ACRTMP=ACRTMP_$P(ACRRTYP,U,2)_U_ACRREF
  1.  I ACRREF=148 D  Q
  1.  .S ^TMP("ACRTRNG",$J,ACRVND)=ACRBDAT_U_$$VEND(ACRVND)
  1.  I '$D(^TMP("ACROPEN",$J,ACRVND)) S ACRODOC=ACRODOC+1
  1.  S ^TMP("ACROPEN",$J,ACROPEN,ACRDOCDA)=ACRTMP
  1.  S ^TMP("ACROPEN",$J,ACROPEN)=$G(^TMP("ACROPEN",$J,ACROPEN))+1
  1.  ;NOW CAPTURE OPEN DOCUMENT VENDORS WITH MOST RECENT DATE
  1.  D
  1.  .I ACRVND["NO VENDOR" S ACRVND=ACRVND_ACRDOCDA,ACRTMP="" Q
  1.  .S ACRTMP=$$VEND(ACRVND)
  1.  I '$D(^TMP("ACROVEN",$J,ACRVND)) S ACROVEN=ACROVEN+1
  1.  S ^TMP("ACROVEN",$J,ACRVND)=ACRBDAT_U_ACRTMP
  1.  Q
  1.  ;
  1. CANCEL(X,Z) ;
  1.  ; ENTERS WITH X=ACRDOC0
  1.  ;             Z=ACRAPV (FMS REQUEST, "APV" NODE)
  1.  N Z1,Z3
  1.  S Z1=$P(Z,U)
  1.  S Z3=$P(Z,U,3)
  1.  S Z8=$P(Z,U,8)
  1.  I Z1="A",Z3="A",Z8="A" Q "APPROVED"   ;DOCUMENT APPROVED
  1.  ;
  1.  I Z1="C"!(Z1="D") Q "CANCEL"          ;REQUISITION CANCELLED OR DISAPPROVED
  1.  I Z3="C"!(Z3="D") Q "CANCEL"          ;REQ AUTH CANCELLED OR DISAPPROVED
  1.  I Z8="D" Q "CANCEL"                   ;PO AUTH CANCELLED OR DISAPPROVED
  1.  I Z1="" Q "NO REQ APP CODE"           ;PO WITH NO REQ APPROVAL
  1.  I Z3="" Q "NO REQ AUTH CODE"           ;PO AUTH NOT CODED
  1.  I Z8="" Q "NO PO AUTH CODE"
  1.  Q "UNKNOWN IF APPROVED"                           ;APPROVED
  1.  ;
  1. OPEN(ACRAPV) ;
  1.  ;(#909) FINAL RECEIVING REPORT [6S] ^
  1.  ;       '1' FOR FINAL;
  1.  ;       '2' FOR PARTIAL;
  1.  ;(#912) FINAL INVOICE [9S] ^
  1.  ;       '1' FOR FINAL;
  1.  ;       '2' FOR PARTIAL;
  1.  ;       '3' FOR PENDING;
  1.  N Z6,Z9
  1.  S Z6=$P(ACRAPV,U,6)
  1.  S Z9=$P(ACRAPV,U,9)
  1.  I Z9=1!(Z6=1) Q "CLOSED"             ;FINAL INVOICE OR RECEIVING REPORT
  1.  ;I Z6=1,Z9'=1 Q "FINAL INVOICE ONLY"
  1.  I Z6=2!(Z9=2) Q "P"                   ;PARTIAL RECEIVING REPORT
  1.  I Z6="",Z9="" Q "O"                   ;OPEN DOCUMENT
  1.  Q "QUESTIONABLE "_Z6_"-"_Z9
  1.  ;
  1. WRITE(JOB) ;EP; WRITE FLAT FILE
  1.  N ACRA,ACRB,ACRC,ACRD
  1.  S:JOB="" JOB=$J
  1.  S ACRA=0
  1.  F  S ACRA=$O(^TMP("ACROPEN",JOB,ACRA)) Q:ACRA=""  D
  1.  .W !,ACRA_" -- ",^TMP("ACROPEN",JOB,ACRA)              ;TOTAL FOR TYPE
  1.  .S ACRB=0
  1.  .F  S ACRB=$O(^TMP("ACROPEN",JOB,ACRA,ACRB)) Q:ACRB=""  D
  1.  ..W !,ACRA_U_^TMP("ACROPEN",JOB,ACRA,ACRB)
  1.  Q
  1. WRITEV(JOB) ;EP; WRITE TO FLAT FILE
  1.  N ACRA
  1.  S:JOB="" JOB=$J
  1.  F I="ACRAVEN","ACROVEN" D
  1.  .S ACRA=0
  1.  .F  S ACRA=$O(^TMP(I,JOB,ACRA)) Q:ACRA=""  D
  1.  ..W !,ACRA_U_^TMP(I,JOB,ACRA)
  1.  Q
  1. VEND(ACRV) ;
  1.  N ACRO
  1.  I ACRV="" Q ""
  1.  S ACR0=^AUTTVNDR(+ACRV,0)
  1.  S ACRP1=$P(ACR0,U)               ;VENDOR NAME
  1.  S ACRP5=$P(ACR0,U,5)             ;DATE INACTIVATED
  1.  S ACRP7=$P(ACR0,U,7)             ;DUNS
  1.  S ACRP13=$P($G(^AUTTVNDR(+ACRV,11)),U,13)        ;EIN + SUFFIX
  1.  Q ACRP1_U_ACRP5_U_ACRP7_U_ACRP13
  1.  ;
  1. VENDOR(ACR) ;EP; FIND VENDOR FROM PO,TRAINING OR TRAVEL (SSN FROM NEW PERSON)
  1.  N ACRV
  1.  S ACRRTYP=$$REQTP^ACRFSSU(ACR)     ;GET REQUEST TYPE
  1.  I ACRRTYP["TRAVEL" Q $$TRAVEL(ACR)
  1.  S ACRV=$P($G(^ACRDOC(ACR,"PO")),U,5)
  1.  S:ACRV=-1 ACRV=""
  1.  I ACRV="",ACRRTYP["TRAINING" D
  1.  .S ACRV=$P($G(^ACRDOC(ACR,"TRNG3")),U) ;GET VENDOR FROM TRAINING NODE
  1.  I ACRV="" S ACRV="NO VENDOR^"
  1.  Q ACRV
  1. TRAVEL(ACR) ;TRAVEL VOUCHER OR ADVANCE
  1.  S ACRDUZ=$P($G(^ACRDOC(ACR,"TO")),U,9)
  1.  I ACRDUZ="" Q "NO TRAVELER^NO SSN"
  1.  S ACRV=$P($G(^VA(200,+ACRDUZ,1)),U,9)
  1.  I ACRV="" Q ACRDUZ_"^NO SSN"
  1.  Q ACRV=ACRDUZ_U_2_ACRV      ;TURN SSN INTO INDIV VENDOR NUMBER