ACRFNEWD ;IHS/OIRM/DSD/THL,AEF - CREATE NEW DOCUMENT; [ 11/01/2006 4:15 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**14,21**;NOV 05, 2001
;;ROUTINE TO CREATE NEW DOCUMENTS
BEGIN ;EP;TO INQUIRE IF NEW DOCUMENT SHOULD BE CREATED
S DIR(0)="YO"
S DIR("A")="Sure you want to create a **"_$S('$D(ACRAMEND)#2:"NEW",1:"MODIFICATION TO THE")_"** "_$P(^ACRTXTYP(ACRTXDA,0),U)_" entry"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
I Y'=1 S ACRQUIT="" Q
Q:$D(ACRQUIT)!$D(ACROUT)!'$G(ACRFDNO)
D DOC^ACRFDOCN
W !!?10,"One moment, please. Request being generated......"
Q:$D(ACRQUIT)!$D(ACROUT)
BEGIN1 ;EP;TO CREATE NEW DOCUMENT
S X=0.00
S DIC="^ACROBL("
S DIC(0)="LZ"
S DIC("DR")=".03////"_ACRFDNO_";.04////"_ACRCANDA_";.05////"_DUZ_";.06////"_DT_";.1////"_ACRREFDA
S:'$D(ACRRR)#2 DIC("DR")=DIC("DR")_";907////"_ACRTXDA
D FILE^ACRFDIC
S (ACRDOCDA,ACRZDA)=+Y
S ACROBL=Y(0,0)
S ACRZY=Y
S X1=DT
S X2=30
D C^%DTC
S ACRDTREQ=X
S X=ACRDOC
S DIC="^ACRDOC("
S DIC(0)="LZ"
S DINUM=ACRDOCDA
S DIC("DR")=".03////"_DT_";.04////"_ACRTXDA_";.05////"_ACRDOCDA_";.06////"_ACRFDNO_";113020////"_$S(ACRTXDA'=2:"P",1:"S")_";113050////"_DT_";.12////0"
BPA I '$D(ACRRR)#2 D
.S DIC("DR")=DIC("DR")_";113110////"_ACRDTREQ
.I $G(ACRBPA) D CALLNUM
I $D(ACRCALL) D Q ; ACR*2.1*14.03 IM13538
.W !?10,"Unable to assign BPA call number, try again later" ; ACR*2.1*14.03 IM13538
.D PAUSE^ACRFWARN ; ACR*2.1*14.03 IM13538
.S ACRQUIT="" ; ACR*2.1*14.03 IM13538
S:$D(ACRRR)#2 DIC("DR")=".02////"_ACRDOC_";"_DIC("DR")_";.13////"_ACRREFDA_";113110////"_ACRDTREQ_";.14////"_ACRID
W:'$D(ACRRR)#2&($E(IOST,1,2)="C-") !?10,"Default data being processed."
D FILE^ACRFDIC
I +Y<1 D Q
.D EN3^ACRFDEL
.S ACRQUIT=""
S ACRDOCDA=+Y
N ACRS
I '$G(ACRADA),ACRFDNO D
.S ACRADA=$P(^ACRLOCB(ACRFDNO,"DT"),U,9)
.S ACRADA=$P(^ACRCAN(ACRADA,"DFLT1"),U,15)
.S ACRADA=$P(^ACRPO(ACRADA,0),U,19)
S ACRDT=^ACRSYS(ACRADA,"DT")
F ACR=1:1:16 S ACRS(ACR)=$P(ACRDT,U,ACR)
S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR="113220////"_ACRS(1)_";113290////"_ACRS(2)_";113280////"_ACRS(3)_";113250////"_ACRS(4)_";113260////"_ACRS(5)_";113240////"_ACRS(6)_";113300////"_ACRS(7)_";113320////"_ACRS(8)_";113310////"_ACRS(9)_";113340////"_ACRS(10)
S DR=DR_";113360////"_ACRS(11)_";113390////"_ACRS(12)_";113400////"_ACRS(14)_";113410////"_ACRS(15)
I $G(ACRBPA) S DR=DR_";103070////"_ACRBPAV_";.04////"_ACRBPATX_";.4////"_ACRBPAPS_";103080////"_ACRBPATO_";103010////"_$G(ACROD)_";103150////"_$G(ACRRQDD)_";103120////"_ACRBPAFO
I $D(ACRAMEND),ACRAMEND'=ACRDOCDA S DR=DR_";.02////"_$S($G(ACRDOC2)]"":ACRDOC2,1:$P(^ACRDOC(ACRAMEND,0),U,2))_";.09////"_ACRANUM_";.15////"_ACRAMEND_";130010///A"
S DR=DR_";113100////"_ACRCANDA
S ACRREF=$P(^AUTTDOCR(ACRREFDA,0),U)
I ACRREF=116 S DR=DR_";103990////"_$P($G(^ACRPO(+$P($G(^ACRCAN(ACRCANDA,"DFLT1")),U,15),"DT")),U,7)
D DIE^ACRFDIC
I ACRREF=130 D
.S DA=ACRDOCDA
.S DIE="^ACRDOC("
.S DR="130110////"_ACRS(13)_";130111////N;130112////N;130113////N;130114////N;130115////N;130116////N;130119////N;130120////N;130121////F;130122////I;130124////L;130125////N;130126////N;130127////N;130128////N;130129////N"
.S DR=DR_";130157////0;130172////"_ACRS(16)_";130010///"_$S('$D(ACRAMEND):"O",1:"A")
.D DIE^ACRFDIC
K ACRAMEND
S DA=ACRDOCDA
S DIE="^ACROBL("
S DR=".07////"_ACRSSADA_";.08////"_ACRALWNO_";.09////"_ACRAPPDA_";1////"_ACRDOCDA_";10////"_ACRTXOBJ
W:'$D(ACRRR)#2&($E(IOST,1,2)="C-") !?10,"Mandatory signatures being set."
D DIE^ACRFDIC
S ACRLBOC=$S(ACRTXOBJ:$P(^AUTTOBJC(ACRTXOBJ,0),U),1:"")
S ACRLBDA=ACRFDNO
S ACRREF=$P(^AUTTDOCR(ACRREFDA,0),U)
D SETDOC^ACRFEA1
I $G(ACRBPA) D
.W !?10,"Small Purchase Data being transferred from original BPA..."
.D BPAADD^ACRFCIS
.W "..."
D EXPDN(ACRDOCDA) ;ACR*2.1*14.01 IM12272
Q
;
AMEND ;EP;TO INDICATE IF REQUEST IS FOR MOD TO EXISTING DOCUMENT AND SELECT
;DOCUMENT TO BE MODIFIED
K ACRAMEND,ACRNOT
S DIR(0)="YO"
S DIR("B")="NO"
S DIR("A")="Is this a modification"
W !
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)!(Y'=1)
S DIC("S")="I $D(ACRFDNO) N ACRXX S ACRXX=^ACRDOC(+Y,0),ACRAPV=$G(^ACROBL(+Y,""APV"")) I '$P(ACRXX,U,15),$P(ACRXX,U,6)=ACRFDNO,$P(ACRAPV,U)=""A""!$D(^ACRDOC(+Y,31))"
;
A1 ;EP;FOR PURCHASING OFFICER TO SELECT DOCUMENT TO MODIFY
S DIC="^ACRDOC("
S DIC(0)="AEMQZ"
S DIC("A")="Document Modified: "
S D="B^C^G^J"
;Modified following line ;ACR*2.1*14.02 IM13539
;S:'$D(DIC("S"))#2 S DIC("S")="N ACRXX S ACRXX=^ACRDOC(+Y,0),ACRAPV=$G(^ACROBL(+Y,""APV"")),ACRREF=$P(ACRXX,U,13),ACRREF=$P(^AUTTDOCR(ACRREF,0),U) I ""^103^349^326^210^""[(U_ACRREF_U),'$P(ACRXX,U,15),$L($P(ACRXX,U,2))=10,$P(ACRAPV,U)=""A"""
;New line follows ;ACR*2.1*14.02 IM13539
I '$D(DIC("S")) S DIC("S")="N ACRXX S ACRXX=^ACRDOC(+Y,0),ACRAPV=$G(^ACROBL(+Y,""APV"")),ACRREF=$P(ACRXX,U,13),ACRREF=$P(^AUTTDOCR(ACRREF,0),U) I ""^103^349^326^210^""[(U_ACRREF_U),'$P(ACRXX,U,15),$L($P(ACRXX,U,2))=10,$P(ACRAPV,U)=""A"""
W !
D MIX^ACRFDIC
;S:+Y<1 ACRQUIT="" ;ACR*2.1*14.02 IM13539
;I +Y<1 D ;ACR*2.1*14.02 IM13539
;I +Y<1!($P($G(^ACROBL(+Y,"APV")),U)="A") D ;ACR*2.1*21.06 IM22547
I +Y<1!($P($G(^ACROBL(+Y,"APV")),U)'="A") D ;ACR*2.1*21.06 IM22547
.W !!,*7,"Document not found, or may not be approved" ;ACR*2.1*14.02 IM13539
.D PAUSE^ACRFWARN ;ACR*2.1*14.02 IM13539
.S ACRQUIT="" ;ACR*2.1*14.02 IM13539
Q:$D(ACRQUIT)!$D(ACROUT)
I '$$AMEND^ACRFNEW1(+Y) D Q ;ACR*2.1*14.02 IM13539
.W !!,*7,"CANNOT AMEND AN AMENDMENT" ;ACR*2.1*14.02 IM13539
.D PAUSE^ACRFWARN ;ACR*2.1*14.02 IM13539
.S ACRQUIT="" ;ACR*2.1*14.02 IM13539
S ACRAMEND=+Y
S ACRTXDA=$P(^ACRDOC(+Y,0),U,4)
S ACRREFDA=$P(^ACRDOC(+Y,0),U,13)
S:$P($G(^ACRDOC(+Y,"PO")),U,5) ACRVDA=$P(^("PO"),U,5)
S ACRREF=$P(^AUTTDOCR(ACRREFDA,0),U)
S ACRTXOBJ=$P(^ACROBL(+Y,"DT"),U,3)
S ACRREF=$S("^116^204^103^349^326^210^"[(U_ACRREF_U):116,"^130^600^"[(U_ACRREF_U):130,1:ACRREF)
S ACRREFDA=$O(^AUTTDOCR("B",ACRREF,0))
S DIR(0)="YO"
S DIR("A")="Are you certain this is the document you want to modify"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
S:Y'=1 ACRQUIT=""
Q
CALLNUM ;D CALLNUM^ACRFNEW1
S ACRCALL=$$CALLNUM^ACRFNEW1(ACRBPA) ; ACR*2.1*14.03 IM13538
Q:ACRCALL="" ; ACR*2.1*14.03 IM13538
S ACRPONUM=$E(ACRPONUM,1,8)_($S($L(ACRCALL)=1:0,1:""))_ACRCALL
K ACRCALL
G:$D(^ACRDOC("C",ACRPONUM)) CALLNUM
S DIC("DR")=DIC("DR")_";.19////"_ACRBPA_";.02////"_ACRPONUM_$S($D(^ACRDOC(ACRDOCDA,6,"B",DUZ)):";24////"_DUZ,1:"")
Q
EXPDN(ACRDOCDA) ;EP ;ACR*2.1*14.01 IM12272
;----- INSERT EXPANDED DOCUMENT NUMBER INTO FMS DOCUMENT FILE AT
; THE TIME THE DOCUMENT IS CREATED FOR TRAVEL ORDERS AND
; TRAINING REQUESTS
;
; ACRDOCDA = INTERNAL DOCUMENT NUMBER
;
N ACREXPDN,DA,DIE,DR,X,Y
S ACREXPDN=$$EXPDN^ACRFUTL(ACRDOCDA)
S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR=".011///^S X=ACREXPDN"
D ^DIE
Q
ACRFNEWD ;IHS/OIRM/DSD/THL,AEF - CREATE NEW DOCUMENT; [ 11/01/2006 4:15 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**14,21**;NOV 05, 2001
+2 ;;ROUTINE TO CREATE NEW DOCUMENTS
BEGIN ;EP;TO INQUIRE IF NEW DOCUMENT SHOULD BE CREATED
+1 SET DIR(0)="YO"
+2 SET DIR("A")="Sure you want to create a **"_$SELECT('$DATA(ACRAMEND)#2:"NEW",1:"MODIFICATION TO THE")_"** "_$PIECE(^ACRTXTYP(ACRTXDA,0),U)_" entry"
+3 SET DIR("B")="NO"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF Y'=1
SET ACRQUIT=""
QUIT
+7 IF $DATA(ACRQUIT)!$DATA(ACROUT)!'$GET(ACRFDNO)
QUIT
+8 DO DOC^ACRFDOCN
+9 WRITE !!?10,"One moment, please. Request being generated......"
+10 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
BEGIN1 ;EP;TO CREATE NEW DOCUMENT
+1 SET X=0.00
+2 SET DIC="^ACROBL("
+3 SET DIC(0)="LZ"
+4 SET DIC("DR")=".03////"_ACRFDNO_";.04////"_ACRCANDA_";.05////"_DUZ_";.06////"_DT_";.1////"_ACRREFDA
+5 IF '$DATA(ACRRR)#2
SET DIC("DR")=DIC("DR")_";907////"_ACRTXDA
+6 DO FILE^ACRFDIC
+7 SET (ACRDOCDA,ACRZDA)=+Y
+8 SET ACROBL=Y(0,0)
+9 SET ACRZY=Y
+10 SET X1=DT
+11 SET X2=30
+12 DO C^%DTC
+13 SET ACRDTREQ=X
+14 SET X=ACRDOC
+15 SET DIC="^ACRDOC("
+16 SET DIC(0)="LZ"
+17 SET DINUM=ACRDOCDA
+18 SET DIC("DR")=".03////"_DT_";.04////"_ACRTXDA_";.05////"_ACRDOCDA_";.06////"_ACRFDNO_";113020////"_$SELECT(ACRTXDA'=2:"P",1:"S")_";113050////"_DT_";.12////0"
BPA IF '$DATA(ACRRR)#2
Begin DoDot:1
+1 SET DIC("DR")=DIC("DR")_";113110////"_ACRDTREQ
+2 IF $GET(ACRBPA)
DO CALLNUM
End DoDot:1
+3 ; ACR*2.1*14.03 IM13538
IF $DATA(ACRCALL)
Begin DoDot:1
+4 ; ACR*2.1*14.03 IM13538
WRITE !?10,"Unable to assign BPA call number, try again later"
+5 ; ACR*2.1*14.03 IM13538
DO PAUSE^ACRFWARN
+6 ; ACR*2.1*14.03 IM13538
SET ACRQUIT=""
End DoDot:1
QUIT
+7 IF $DATA(ACRRR)#2
SET DIC("DR")=".02////"_ACRDOC_";"_DIC("DR")_";.13////"_ACRREFDA_";113110////"_ACRDTREQ_";.14////"_ACRID
+8 IF '$DATA(ACRRR)#2&($EXTRACT(IOST,1,2)="C-")
WRITE !?10,"Default data being processed."
+9 DO FILE^ACRFDIC
+10 IF +Y<1
Begin DoDot:1
+11 DO EN3^ACRFDEL
+12 SET ACRQUIT=""
End DoDot:1
QUIT
+13 SET ACRDOCDA=+Y
+14 NEW ACRS
+15 IF '$GET(ACRADA)
IF ACRFDNO
Begin DoDot:1
+16 SET ACRADA=$PIECE(^ACRLOCB(ACRFDNO,"DT"),U,9)
+17 SET ACRADA=$PIECE(^ACRCAN(ACRADA,"DFLT1"),U,15)
+18 SET ACRADA=$PIECE(^ACRPO(ACRADA,0),U,19)
End DoDot:1
+19 SET ACRDT=^ACRSYS(ACRADA,"DT")
+20 FOR ACR=1:1:16
SET ACRS(ACR)=$PIECE(ACRDT,U,ACR)
+21 SET DA=ACRDOCDA
+22 SET DIE="^ACRDOC("
+23 SET DR="113220////"_ACRS(1)_";113290////"_ACRS(2)_";113280////"_ACRS(3)_";113250////"_ACRS(4)_";113260////"_ACRS(5)_";113240////"_ACRS(6)_";113300////"_ACRS(7)_";113320////"_ACRS(8)_";113310////"_ACRS(9)_";113340////"_ACRS(10)
+24 SET DR=DR_";113360////"_ACRS(11)_";113390////"_ACRS(12)_";113400////"_ACRS(14)_";113410////"_ACRS(15)
+25 IF $GET(ACRBPA)
SET DR=DR_";103070////"_ACRBPAV_";.04////"_ACRBPATX_";.4////"_ACRBPAPS_";103080////"_ACRBPATO_";103010////"_$GET(ACROD)_";103150////"_$GET(ACRRQDD)_";103120////"_ACRBPAFO
+26 IF $DATA(ACRAMEND)
IF ACRAMEND'=ACRDOCDA
SET DR=DR_";.02////"_$SELECT($GET(ACRDOC2)]"":ACRDOC2,1:$PIECE(^ACRDOC(ACRAMEND,0),U,2))_";.09////"_ACRANUM_";.15////"_ACRAMEND_";130010///A"
+27 SET DR=DR_";113100////"_ACRCANDA
+28 SET ACRREF=$PIECE(^AUTTDOCR(ACRREFDA,0),U)
+29 IF ACRREF=116
SET DR=DR_";103990////"_$PIECE($GET(^ACRPO(+$PIECE($GET(^ACRCAN(ACRCANDA,"DFLT1")),U,15),"DT")),U,7)
+30 DO DIE^ACRFDIC
+31 IF ACRREF=130
Begin DoDot:1
+32 SET DA=ACRDOCDA
+33 SET DIE="^ACRDOC("
+34 SET DR="130110////"_ACRS(13)_";130111////N;130112////N;130113////N;130114////N;130115////N;130116////N;130119////N;130120////N;130121////F;130122////I;130124////L;130125////N;130126////N;130127////N;130128////N;130129////N"
+35 SET DR=DR_";130157////0;130172////"_ACRS(16)_";130010///"_$SELECT('$DATA(ACRAMEND):"O",1:"A")
+36 DO DIE^ACRFDIC
End DoDot:1
+37 KILL ACRAMEND
+38 SET DA=ACRDOCDA
+39 SET DIE="^ACROBL("
+40 SET DR=".07////"_ACRSSADA_";.08////"_ACRALWNO_";.09////"_ACRAPPDA_";1////"_ACRDOCDA_";10////"_ACRTXOBJ
+41 IF '$DATA(ACRRR)#2&($EXTRACT(IOST,1,2)="C-")
WRITE !?10,"Mandatory signatures being set."
+42 DO DIE^ACRFDIC
+43 SET ACRLBOC=$SELECT(ACRTXOBJ:$PIECE(^AUTTOBJC(ACRTXOBJ,0),U),1:"")
+44 SET ACRLBDA=ACRFDNO
+45 SET ACRREF=$PIECE(^AUTTDOCR(ACRREFDA,0),U)
+46 DO SETDOC^ACRFEA1
+47 IF $GET(ACRBPA)
Begin DoDot:1
+48 WRITE !?10,"Small Purchase Data being transferred from original BPA..."
+49 DO BPAADD^ACRFCIS
+50 WRITE "..."
End DoDot:1
+51 ;ACR*2.1*14.01 IM12272
DO EXPDN(ACRDOCDA)
+52 QUIT
+53 ;
AMEND ;EP;TO INDICATE IF REQUEST IS FOR MOD TO EXISTING DOCUMENT AND SELECT
+1 ;DOCUMENT TO BE MODIFIED
+2 KILL ACRAMEND,ACRNOT
+3 SET DIR(0)="YO"
+4 SET DIR("B")="NO"
+5 SET DIR("A")="Is this a modification"
+6 WRITE !
+7 DO DIR^ACRFDIC
+8 IF $DATA(ACRQUIT)!$DATA(ACROUT)!(Y'=1)
QUIT
+9 SET DIC("S")="I $D(ACRFDNO) N ACRXX S ACRXX=^ACRDOC(+Y,0),ACRAPV=$G(^ACROBL(+Y,""APV"")) I '$P(ACRXX,U,15),$P(ACRXX,U,6)=ACRFDNO,$P(ACRAPV,U)=""A""!$D(^ACRDOC(+Y,31))"
+10 ;
A1 ;EP;FOR PURCHASING OFFICER TO SELECT DOCUMENT TO MODIFY
+1 SET DIC="^ACRDOC("
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="Document Modified: "
+4 SET D="B^C^G^J"
+5 ;Modified following line ;ACR*2.1*14.02 IM13539
+6 ;S:'$D(DIC("S"))#2 S DIC("S")="N ACRXX S ACRXX=^ACRDOC(+Y,0),ACRAPV=$G(^ACROBL(+Y,""APV"")),ACRREF=$P(ACRXX,U,13),ACRREF=$P(^AUTTDOCR(ACRREF,0),U) I ""^103^349^326^210^""[(U_ACRREF_U),'$P(ACRXX,U,15),$L($P(ACRXX,U,2))=10,$P(ACRAPV,U)=""A"""
+7 ;New line follows ;ACR*2.1*14.02 IM13539
+8 IF '$DATA(DIC("S"))
SET DIC("S")="N ACRXX S ACRXX=^ACRDOC(+Y,0),ACRAPV=$G(^ACROBL(+Y,""APV"")),ACRREF=$P(ACRXX,U,13),ACRREF=$P(^AUTTDOCR(ACRREF,0),U) I ""^103^349^326^210^""[(U_ACRREF_U),'$P(ACRXX,U,15),$L($P(ACRXX,U,2))=10,$P(ACRAPV,U)=""A"""
+9 WRITE !
+10 DO MIX^ACRFDIC
+11 ;S:+Y<1 ACRQUIT="" ;ACR*2.1*14.02 IM13539
+12 ;I +Y<1 D ;ACR*2.1*14.02 IM13539
+13 ;I +Y<1!($P($G(^ACROBL(+Y,"APV")),U)="A") D ;ACR*2.1*21.06 IM22547
+14 ;ACR*2.1*21.06 IM22547
IF +Y<1!($PIECE($GET(^ACROBL(+Y,"APV")),U)'="A")
Begin DoDot:1
+15 ;ACR*2.1*14.02 IM13539
WRITE !!,*7,"Document not found, or may not be approved"
+16 ;ACR*2.1*14.02 IM13539
DO PAUSE^ACRFWARN
+17 ;ACR*2.1*14.02 IM13539
SET ACRQUIT=""
End DoDot:1
+18 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+19 ;ACR*2.1*14.02 IM13539
IF '$$AMEND^ACRFNEW1(+Y)
Begin DoDot:1
+20 ;ACR*2.1*14.02 IM13539
WRITE !!,*7,"CANNOT AMEND AN AMENDMENT"
+21 ;ACR*2.1*14.02 IM13539
DO PAUSE^ACRFWARN
+22 ;ACR*2.1*14.02 IM13539
SET ACRQUIT=""
End DoDot:1
QUIT
+23 SET ACRAMEND=+Y
+24 SET ACRTXDA=$PIECE(^ACRDOC(+Y,0),U,4)
+25 SET ACRREFDA=$PIECE(^ACRDOC(+Y,0),U,13)
+26 IF $PIECE($GET(^ACRDOC(+Y,"PO")),U,5)
SET ACRVDA=$PIECE(^("PO"),U,5)
+27 SET ACRREF=$PIECE(^AUTTDOCR(ACRREFDA,0),U)
+28 SET ACRTXOBJ=$PIECE(^ACROBL(+Y,"DT"),U,3)
+29 SET ACRREF=$SELECT("^116^204^103^349^326^210^"[(U_ACRREF_U):116,"^130^600^"[(U_ACRREF_U):130,1:ACRREF)
+30 SET ACRREFDA=$ORDER(^AUTTDOCR("B",ACRREF,0))
+31 SET DIR(0)="YO"
+32 SET DIR("A")="Are you certain this is the document you want to modify"
+33 SET DIR("B")="NO"
+34 WRITE !
+35 DO DIR^ACRFDIC
+36 IF Y'=1
SET ACRQUIT=""
+37 QUIT
CALLNUM ;D CALLNUM^ACRFNEW1
+1 ; ACR*2.1*14.03 IM13538
SET ACRCALL=$$CALLNUM^ACRFNEW1(ACRBPA)
+2 ; ACR*2.1*14.03 IM13538
IF ACRCALL=""
QUIT
+3 SET ACRPONUM=$EXTRACT(ACRPONUM,1,8)_($SELECT($LENGTH(ACRCALL)=1:0,1:""))_ACRCALL
+4 KILL ACRCALL
+5 IF $DATA(^ACRDOC("C",ACRPONUM))
GOTO CALLNUM
+6 SET DIC("DR")=DIC("DR")_";.19////"_ACRBPA_";.02////"_ACRPONUM_$SELECT($DATA(^ACRDOC(ACRDOCDA,6,"B",DUZ)):";24////"_DUZ,1:"")
+7 QUIT
EXPDN(ACRDOCDA) ;EP ;ACR*2.1*14.01 IM12272
+1 ;----- INSERT EXPANDED DOCUMENT NUMBER INTO FMS DOCUMENT FILE AT
+2 ; THE TIME THE DOCUMENT IS CREATED FOR TRAVEL ORDERS AND
+3 ; TRAINING REQUESTS
+4 ;
+5 ; ACRDOCDA = INTERNAL DOCUMENT NUMBER
+6 ;
+7 NEW ACREXPDN,DA,DIE,DR,X,Y
+8 SET ACREXPDN=$$EXPDN^ACRFUTL(ACRDOCDA)
+9 SET DA=ACRDOCDA
+10 SET DIE="^ACRDOC("
+11 SET DR=".011///^S X=ACREXPDN"
+12 DO ^DIE
+13 QUIT
