ACRFPVN ;IHS/OIRM/DSD/THL,AEF - PROPERTY VOUCHER NUMBER MANAGEMENT; [ 07/20/2006 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**20**;NOV 05, 2001
;;ROUTINE FOR PROPERTY VOUCHER NUMBER MANAGEMENT
CREATE ;
S:'$D(^ACRPO(ACRPODA,40,0))#2 ^ACRPO(ACRPODA,40,0)="^9002199.441P"
I '$D(^ACRPO(ACRPODA,40,ACRLCDA,0))#2 S DA(1)=ACRPODA,(X,DINUM)=ACRLCDA,DIC="^ACRPO("_ACRPODA_",40,",DIC(0)="L" D FILE^ACRFDIC
S:'$D(^ACRPO(ACRPODA,40,ACRLCDA,1,0))#2 ^ACRPO(ACRPODA,40,ACRLCDA,1,0)="^9002199.4411"
I '$D(^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,0))#2 S DA(2)=ACRPODA,DA(1)=ACRLCDA,(X,DINUM)=ACRFY,DIC="^ACRPO("_ACRPODA_",40,"_ACRLCDA_",1,",DIC(0)="L" D FILE^ACRFDIC D
.S:'$D(^ACRPO(ACRPODA,40,ACRLCDA,1,"B",ACRFY)) ^ACRPO(ACRPODA,40,ACRLCDA,1,"B",ACRFY,ACRFY)=""
S:'$D(^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,1,0))#2 ^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,1,0)="^9002199.4419"
I '$D(^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,1,ACRMONTH,0))#2 D
.S DA(3)=ACRPODA,DA(2)=ACRLCDA,DA(1)=ACRFY,(X,DINUM)=ACRMONTH,DIC="^ACRPO("_ACRPODA_",40,"_ACRLCDA_",1,"_ACRFY_",1,",DIC("DR")=".02////8000",DIC(0)="L" D FILE^ACRFDIC
Q
SET ;EP;TO SET THE PROPERTY VOUCHER SERIAL NUMBER FOR A NEW RECEIVING REPORT
I '$D(ACRPODA) S ACRPODA=$P(^ACRDOC(ACRDOCDA,0),U,8)
Q:'ACRPODA
Q:'$D(^ACRPO(ACRPODA,0))#2
I '$D(^ACRPO(ACRPODA,40,0))#2 D CREATE
I '$D(^ACRPO(ACRPODA,40,ACRLCDA,1,0))#2 D CREATE
I '$D(^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,1,0))#2 D CREATE
I '$D(^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,1,ACRMONTH,0))#2 D CREATE
;L +^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,1,ACRMONTH,0):4 ;ACR*2.1*20.05 IM17144
;G:'$T SET ;ACR*2.1*20.05 IM17144
L +^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,1,ACRMONTH,0):4 I '$T D G SET ;ACR*2.1*20.05 IM17144
.W !,"Purchasing Office file in use by other user" ;ACR*2.1*20.05 IM17144
.W !!,"If you get this message more than 5 times, " ;ACR*2.1*20.05 IM17144
.W !,"Please notify the site manager" ;ACR*2.1*20.05 IM17144
.H 5 ;ACR*2.1*20.05 IM17144
.Q ;ACR*2.1*20.05 IM17144
PVN1 S ACRPVN=$P(^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,1,ACRMONTH,0),U,2)+1,$P(^(0),U,2)=ACRPVN
I $D(^ACRDOC("PVN",($P(^AUTTLCOD(ACRLCDA,0),U)_"-"_ACRFY_"-"_$S(ACRMONTH<10:0,1:"")_ACRMONTH_"-"_ACRPVN))) G PVN1
L -^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,1,ACRMONTH,0):0
;PVNCHK ;EP; ;ACR*2.1*20.05 IM17144
;S ACRPVN=$P(^AUTTLCOD(ACRLCDA,0),U)_"-"_ACRFY_"-"_$S(ACRMONTH<10:0,1:"")_ACRMONTH_"-"_$S($G(ACRPVN)]"":ACRPVN,1:"XXXX") ;ACR*2.1*20.05 IM17144
;Q ;ACR*2.1*20.05 IM17144
S ACRPVN=$$PVNCHK(ACRLCDA,ACRFY,ACRMONTH,ACRPVN) ;ACR*2.1*20.05 IM17144
Q
PVNCHK(W,X,Y,Z) ;EP; EXTRINSIC FUNCTION ;ACR*2.1*20.05 IM17144
; ENTERS WITH W - LOCATION CODE IEN
; X - FISCAL YEAR
; Y - MONTH
; Z - PROPERTY VOUCHER SEQUENCE NUMBER, IF KNOWN
; RETURNS PROPERTY VOUCHER NUMBER
;
N ACRSTR
S ACRSTR=$P(^AUTTLCOD(W,0),U)
S ACRSTR=ACRSTR_"-"_X
S ACRSTR=ACRSTR_"-"_$S(Y<10:0,1:"")_Y
S ACRSTR=ACRSTR_"-"_$S($G(Z)]"":Z,1:"XXXX")
Q ACRSTR
ACRFPVN ;IHS/OIRM/DSD/THL,AEF - PROPERTY VOUCHER NUMBER MANAGEMENT; [ 07/20/2006 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**20**;NOV 05, 2001
+2 ;;ROUTINE FOR PROPERTY VOUCHER NUMBER MANAGEMENT
CREATE ;
+1 IF '$DATA(^ACRPO(ACRPODA,40,0))#2
SET ^ACRPO(ACRPODA,40,0)="^9002199.441P"
+2 IF '$DATA(^ACRPO(ACRPODA,40,ACRLCDA,0))#2
SET DA(1)=ACRPODA
SET (X,DINUM)=ACRLCDA
SET DIC="^ACRPO("_ACRPODA_",40,"
SET DIC(0)="L"
DO FILE^ACRFDIC
+3 IF '$DATA(^ACRPO(ACRPODA,40,ACRLCDA,1,0))#2
SET ^ACRPO(ACRPODA,40,ACRLCDA,1,0)="^9002199.4411"
+4 IF '$DATA(^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,0))#2
SET DA(2)=ACRPODA
SET DA(1)=ACRLCDA
SET (X,DINUM)=ACRFY
SET DIC="^ACRPO("_ACRPODA_",40,"_ACRLCDA_",1,"
SET DIC(0)="L"
DO FILE^ACRFDIC
Begin DoDot:1
+5 IF '$DATA(^ACRPO(ACRPODA,40,ACRLCDA,1,"B",ACRFY))
SET ^ACRPO(ACRPODA,40,ACRLCDA,1,"B",ACRFY,ACRFY)=""
End DoDot:1
+6 IF '$DATA(^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,1,0))#2
SET ^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,1,0)="^9002199.4419"
+7 IF '$DATA(^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,1,ACRMONTH,0))#2
Begin DoDot:1
+8 SET DA(3)=ACRPODA
SET DA(2)=ACRLCDA
SET DA(1)=ACRFY
SET (X,DINUM)=ACRMONTH
SET DIC="^ACRPO("_ACRPODA_",40,"_ACRLCDA_",1,"_ACRFY_",1,"
SET DIC("DR")=".02////8000"
SET DIC(0)="L"
DO FILE^ACRFDIC
End DoDot:1
+9 QUIT
SET ;EP;TO SET THE PROPERTY VOUCHER SERIAL NUMBER FOR A NEW RECEIVING REPORT
+1 IF '$DATA(ACRPODA)
SET ACRPODA=$PIECE(^ACRDOC(ACRDOCDA,0),U,8)
+2 IF 'ACRPODA
QUIT
+3 IF '$DATA(^ACRPO(ACRPODA,0))#2
QUIT
+4 IF '$DATA(^ACRPO(ACRPODA,40,0))#2
DO CREATE
+5 IF '$DATA(^ACRPO(ACRPODA,40,ACRLCDA,1,0))#2
DO CREATE
+6 IF '$DATA(^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,1,0))#2
DO CREATE
+7 IF '$DATA(^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,1,ACRMONTH,0))#2
DO CREATE
+8 ;L +^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,1,ACRMONTH,0):4 ;ACR*2.1*20.05 IM17144
+9 ;G:'$T SET ;ACR*2.1*20.05 IM17144
+10 ;ACR*2.1*20.05 IM17144
LOCK +^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,1,ACRMONTH,0):4
IF '$TEST
Begin DoDot:1
+11 ;ACR*2.1*20.05 IM17144
WRITE !,"Purchasing Office file in use by other user"
+12 ;ACR*2.1*20.05 IM17144
WRITE !!,"If you get this message more than 5 times, "
+13 ;ACR*2.1*20.05 IM17144
WRITE !,"Please notify the site manager"
+14 ;ACR*2.1*20.05 IM17144
HANG 5
+15 ;ACR*2.1*20.05 IM17144
QUIT
End DoDot:1
GOTO SET
PVN1 SET ACRPVN=$PIECE(^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,1,ACRMONTH,0),U,2)+1
SET $PIECE(^(0),U,2)=ACRPVN
+1 IF $DATA(^ACRDOC("PVN",($PIECE(^AUTTLCOD(ACRLCDA,0),U)_"-"_ACRFY_"-"_$SELECT(ACRMONTH<10:0,1:"")_ACRMONTH_"-"_ACRPVN)))
GOTO PVN1
+2 LOCK -^ACRPO(ACRPODA,40,ACRLCDA,1,ACRFY,1,ACRMONTH,0):0
+3 ;PVNCHK ;EP; ;ACR*2.1*20.05 IM17144
+4 ;S ACRPVN=$P(^AUTTLCOD(ACRLCDA,0),U)_"-"_ACRFY_"-"_$S(ACRMONTH<10:0,1:"")_ACRMONTH_"-"_$S($G(ACRPVN)]"":ACRPVN,1:"XXXX") ;ACR*2.1*20.05 IM17144
+5 ;Q ;ACR*2.1*20.05 IM17144
+6 ;ACR*2.1*20.05 IM17144
SET ACRPVN=$$PVNCHK(ACRLCDA,ACRFY,ACRMONTH,ACRPVN)
+7 QUIT
PVNCHK(W,X,Y,Z) ;EP; EXTRINSIC FUNCTION ;ACR*2.1*20.05 IM17144
+1 ; ENTERS WITH W - LOCATION CODE IEN
+2 ; X - FISCAL YEAR
+3 ; Y - MONTH
+4 ; Z - PROPERTY VOUCHER SEQUENCE NUMBER, IF KNOWN
+5 ; RETURNS PROPERTY VOUCHER NUMBER
+6 ;
+7 NEW ACRSTR
+8 SET ACRSTR=$PIECE(^AUTTLCOD(W,0),U)
+9 SET ACRSTR=ACRSTR_"-"_X
+10 SET ACRSTR=ACRSTR_"-"_$SELECT(Y<10:0,1:"")_Y
+11 SET ACRSTR=ACRSTR_"-"_$SELECT($GET(Z)]"":Z,1:"XXXX")
+12 QUIT ACRSTR
