- 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
