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