ACRFDUP ;IHS/OIRM/DSD/THL,AEF - DUPLICATE A DOCUMENT; [ 09/23/2005 3:23 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,19**;NOV 05, 2001
;;
EN ;EP;TO DUPLICATE A DOCUMENT
F D EN1 Q:$D(ACRQUIT)
EXIT K ACRQUIT,ACRNOT,ACRTDA,ACRTNAM,ACRTDDA,ACRDNAM
Q
EN1 W @IOF
W !?20,"DOCUMENT DUPLICATION UTILITY"
D DOC
Q:$D(ACRQUIT)
S ACRDUPJ=0
F D EN2 Q:$D(ACRQUIT)
K ACRQUIT,ACRDUPJ
Q
EN2 W !!
I "^130^600^148^"[(U_ACRREF_U) D TRAVELER Q:$D(ACRQUIT)
D DEPT
Q:$D(ACRQUIT)!$D(ACROUT)
I "^116^204^103^349^326^210^"[(U_ACRREF_U) D BOIL
I "^130^600^148^"[(U_ACRREF_U) D AL
Q:$D(ACRQUIT)!$D(ACROUT)
D SURE
Q:$D(ACRQUIT)
S ACRNOT=""
S ACRREF=$S("^116^204^103^349^326^210^"[(U_ACRREF_U):116,ACRREF=130!(ACRREF=600):130,1:ACRREF)
S ACRREFDA=$O(^AUTTDOCR("B",ACRREF,0))
D EN1^ACRFAUTO
W !!,"The new document is now being created. You can use the 'ER' function"
W !,"to access and edit it under DEPARTMENT ACCOUNT ID NO.: ",ACRTDDA
I +$G(ACRBOIL) D
.D:"^116^204^103^349^326^210^"[(U_ACRREF_U) B
.D:"^130^600^148^"[(U_ACRREF_U) A(.ACRBOIL,ACROBL2)
D PAUSE^ACRFWARN
Q
DEPT S ACRDIC="ACRLOCB"
D CHOOSE^ACRFDTP4
Q:$D(ACRQUIT)!$D(ACROUT)
S DIC="^ACRLOCB("
S DIC("A")=ACRDIC("A")
S DIC(0)=ACRDIC(0)
S DIC("DR")="",D=ACRD
S DIC("S")="I $D(^ACRLOCB(""SEC"",DUZ,+Y))"
D IX^ACRFDIC
I +Y<1 S ACRQUIT="" Q
S (ACRFDNO,ACRLBDA,ACRTDDA,ACRZDA)=+Y
SETDEP ;EP;TO SET DEPARTMENT ACCOUNT INFORMATION
I '$D(ACRLBDA)#2 S ACRQUIT="" Q
I '$D(ACRFDNO)#2 S ACRQUIT="" Q
I '$D(^ACRLOCB(ACRLBDA,0))#2 S ACRQUIT="" Q
N X,Y
S X=^ACRLOCB(ACRLBDA,0)
S Y=^ACRLOCB(ACRLBDA,"DT")
S ACRFY=+Y
S ACRCANDA=$P(Y,U,9)
S ACRAPPDA=$P(X,U,2)
S ACRALWDA=$P(X,U,3)
S ACRALWDA=$P(X,U,4)
S ACRDPTDA=$P(X,U,5)
S ACRDNAM=$P(^AUTTPRG(ACRDPTDA,0),U)
S ACRCAN=$P(^AUTTCAN(ACRCANDA,0),U)
Q
TRAVELER S DIC="^ACRAU("
S DIC(0)="AEMQZ"
I ACRREF'=148 S DIC("A")="Name of "_$S(ACRDUPJ>0:"NEXT TRAVELER.:",1:"TRAVELER......: ")
E S DIC("A")="Name of "_$S(ACRDUPJ>0:"NEXT ATTENDEE.:",1:"ATTENDEE......: ")
D DIC^ACRFDIC
Q:$D(ACRQUIT)
I '+Y S ACRQUIT="" Q
I '$D(^VA(200,+Y,0))#2 S ACRQUIT="" Q
S ACRTDA=+Y
N X
;S X=$P(^VA(200,+Y,0),U) ;ACR*2.1*19.02 IM16848
S X=$$NAME2^ACRFUTL1(+Y) ;ACR*2.1*19.02 IM16848
S X=$P($P(X,",",2)," ")_" "_$P(X,",")
S ACRTNAM=X
Q
SURE W !!,"You have chosen to duplicate DOCUMENT NO.: ",ACRDOC
I "^130^600^148^"[(U_ACRREF_U) D
.W !,"The ",$S(ACRREF'=148:"TRAVELER",1:"ATTENDEE")," for the new document is.....: ",ACRTNAM
W !,"You have chosen to create the"
W !,"NEW DOCUMENT in DEPARTMENT ACCOUNT ID NO.: ",ACRLBDA
W ?$X+2,ACRDNAM
W !?43,"FY: ",ACRFY
W ?$X+2,"CAN: ",ACRCAN
S DIR(0)="YO"
S DIR("A",1)="Are you certain this information is correct"
S DIR("A")="and you want to proceed with this duplication"
S DIR("B")="NO"
W !!
D DIR^ACRFDIC
I $G(Y)'=1 S ACRQUIT="" Q
S ACRDUPJ=ACRDUPJ+1
Q
DOC S DIC="^ACRDOC("
S DIC(0)="AEMNQZ"
S DIC("A")="Duplicate DOCUMENT NO.: "
S DIC("S")="I $P($G(^ACROBL(+Y,""APV"")),U)'=""D"",'$P($G(^ACRDOC(+Y,0)),U,15),'$P($G(^(0)),U,19)" ;ACR*2.1*3.32
W !!!
D DIC^ACRFDIC
Q:$D(ACRQUIT)
I '+Y S ACRQUIT="" Q
I '$D(^ACRDOC(+Y,0)) S ACRQUIT="" Q
S ACRDOCDA=+Y
D SETDOC^ACRFEA1
I '$G(ACRREFDA) S ACRQUIT="" Q
S:ACRREF=600 ACRREF=130
S:"^103^349^326^210^"[(U_ACRREF_U) ACRREF=116
S (ACRREF,ACRREFX)=$P(^AUTTDOCR(ACRREFDA,0),U)
Q
BOIL ;DETERMINE IF BOILER PLATE STATEMENTS SHOULD BE DUPLICATED
Q:'$D(^ACRDOCBP("C",ACRDOCDA))
N J,X,Y
W !!,"The following BOILER PLATE statements are on file for this document."
W !!?10,"NO.",?15,"Type of Boiler Plate"
W !?10,"---",?15,"------------------------------"
S X=0
F S X=$O(^ACRDOCBP("C",ACRDOCDA,X)) Q:'X D
.S J=$G(J)+1
.S J(J)=X
.S Y=^ACRDOCBP(X,0)
.W !?10,$J(J,3),?15,$P($G(^ACRBP(+Y,0)),U)
S DIR(0)="LO^1:"_+J
S DIR("A")="Duplicate which statement(s)"
W !
D DIR^ACRFDIC
I '+ACRY K ACRQUIT Q
S ACRBOIL=ACRY
F J=1:1 S ACRX=$P(ACRBOIL,",",J) Q:'ACRX!('$G(J(+ACRX))) S ACRBOIL(ACRX)=J(ACRX)
Q
B N ACRX
F J=1:1 S ACRX=$P(ACRBOIL,",",J) Q:'ACRX!('$G(ACRBOIL(+ACRX))) D
.S ACRX=ACRBOIL(ACRX)
.S X=+$G(^ACRDOCBP(ACRX,0))
.Q:'X
.S DIC="^ACRDOCBP("
.S DIC(0)="L"
.S DIC("DR")=".02////"_ACROBL2
.D FILE^ACRFDIC
.S ACRBPDA=+Y
.S %X="^ACRDOCBP("_ACRX_",1,"
.S %Y="^ACRDOCBP("_ACRBPDA_",1,"
.D %XY^%RCR
.S DA=ACRBPDA
.S DIK="^ACRDOCBP("
.D IX1^ACRFDIC
K ACRBOIL,ACRBPDA
Q
AL ;DETERMINE IF AIRLINE RESERVATIONS SHOULD BE DUPLICATED
Q:'$D(^ACRAL("E",ACRDOCDA))
N J,X,Y
W !!,"The following AIRLINE RESERVATIONS are on file for this document."
D DISPLAY^ACRFSS5
S X=0
F S X=$O(^ACRAL("E",ACRDOCDA,X)) Q:'X D
.S J=$G(J)+1
.S J(J)=X
S DIR(0)="LO^1:"_+J
S DIR("A")="Duplicate which reservation(s)"
W !
D DIR^ACRFDIC
I '+ACRY K ACRQUIT Q
S ACRBOIL=ACRY
F J=1:1 S ACRX=$P(ACRBOIL,",",J) Q:'ACRX!('$G(J(+ACRX))) S ACRBOIL(ACRX)=J(ACRX)
Q
A(ACRBOIL,ACROBL2) ;
;----- DUPLICATES AIRLINE RESERVATIONS
;
; INPUT:
; ACRBOIL = ARRAY CONTAINING FLIGHT IENS FROM FMS AIRLINE
; INFORMATION FILE BEING DUPLICATED
; ACROBL2 = DUPLICATE DOCUMENT IEN
;
N ACRDATA,ACRX,DD,DIC,DO,FLD,J,X
F J=1:1 S ACRX=$P(ACRBOIL,",",J) Q:'ACRX!('$G(ACRBOIL(+ACRX))) D
.S ACRX=ACRBOIL(ACRX)
.S X=+$G(^ACRAL(ACRX,0))
.Q:'X
.S DIC="^ACRAL("
.S DIC(0)="L"
.S DIC("DR")=".02////"_(ACROBL2)_";.03////"_ACROBL2
.S ACRDATA=$G(^ACRAL(ACRX,"DT"))
.F FLD=1:1:11 D
..S DIC("DR")=DIC("DR")_";"_FLD_"///"_$P(ACRDATA,U,FLD)
.D FILE^DICN
Q
ACRFDUP ;IHS/OIRM/DSD/THL,AEF - DUPLICATE A DOCUMENT; [ 09/23/2005 3:23 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,19**;NOV 05, 2001
+2 ;;
EN ;EP;TO DUPLICATE A DOCUMENT
+1 FOR
DO EN1
IF $DATA(ACRQUIT)
QUIT
EXIT KILL ACRQUIT,ACRNOT,ACRTDA,ACRTNAM,ACRTDDA,ACRDNAM
+1 QUIT
EN1 WRITE @IOF
+1 WRITE !?20,"DOCUMENT DUPLICATION UTILITY"
+2 DO DOC
+3 IF $DATA(ACRQUIT)
QUIT
+4 SET ACRDUPJ=0
+5 FOR
DO EN2
IF $DATA(ACRQUIT)
QUIT
+6 KILL ACRQUIT,ACRDUPJ
+7 QUIT
EN2 WRITE !!
+1 IF "^130^600^148^"[(U_ACRREF_U)
DO TRAVELER
IF $DATA(ACRQUIT)
QUIT
+2 DO DEPT
+3 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+4 IF "^116^204^103^349^326^210^"[(U_ACRREF_U)
DO BOIL
+5 IF "^130^600^148^"[(U_ACRREF_U)
DO AL
+6 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+7 DO SURE
+8 IF $DATA(ACRQUIT)
QUIT
+9 SET ACRNOT=""
+10 SET ACRREF=$SELECT("^116^204^103^349^326^210^"[(U_ACRREF_U):116,ACRREF=130!(ACRREF=600):130,1:ACRREF)
+11 SET ACRREFDA=$ORDER(^AUTTDOCR("B",ACRREF,0))
+12 DO EN1^ACRFAUTO
+13 WRITE !!,"The new document is now being created. You can use the 'ER' function"
+14 WRITE !,"to access and edit it under DEPARTMENT ACCOUNT ID NO.: ",ACRTDDA
+15 IF +$GET(ACRBOIL)
Begin DoDot:1
+16 IF "^116^204^103^349^326^210^"[(U_ACRREF_U)
DO B
+17 IF "^130^600^148^"[(U_ACRREF_U)
DO A(.ACRBOIL,ACROBL2)
End DoDot:1
+18 DO PAUSE^ACRFWARN
+19 QUIT
DEPT SET ACRDIC="ACRLOCB"
+1 DO CHOOSE^ACRFDTP4
+2 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+3 SET DIC="^ACRLOCB("
+4 SET DIC("A")=ACRDIC("A")
+5 SET DIC(0)=ACRDIC(0)
+6 SET DIC("DR")=""
SET D=ACRD
+7 SET DIC("S")="I $D(^ACRLOCB(""SEC"",DUZ,+Y))"
+8 DO IX^ACRFDIC
+9 IF +Y<1
SET ACRQUIT=""
QUIT
+10 SET (ACRFDNO,ACRLBDA,ACRTDDA,ACRZDA)=+Y
SETDEP ;EP;TO SET DEPARTMENT ACCOUNT INFORMATION
+1 IF '$DATA(ACRLBDA)#2
SET ACRQUIT=""
QUIT
+2 IF '$DATA(ACRFDNO)#2
SET ACRQUIT=""
QUIT
+3 IF '$DATA(^ACRLOCB(ACRLBDA,0))#2
SET ACRQUIT=""
QUIT
+4 NEW X,Y
+5 SET X=^ACRLOCB(ACRLBDA,0)
+6 SET Y=^ACRLOCB(ACRLBDA,"DT")
+7 SET ACRFY=+Y
+8 SET ACRCANDA=$PIECE(Y,U,9)
+9 SET ACRAPPDA=$PIECE(X,U,2)
+10 SET ACRALWDA=$PIECE(X,U,3)
+11 SET ACRALWDA=$PIECE(X,U,4)
+12 SET ACRDPTDA=$PIECE(X,U,5)
+13 SET ACRDNAM=$PIECE(^AUTTPRG(ACRDPTDA,0),U)
+14 SET ACRCAN=$PIECE(^AUTTCAN(ACRCANDA,0),U)
+15 QUIT
TRAVELER SET DIC="^ACRAU("
+1 SET DIC(0)="AEMQZ"
+2 IF ACRREF'=148
SET DIC("A")="Name of "_$SELECT(ACRDUPJ>0:"NEXT TRAVELER.:",1:"TRAVELER......: ")
+3 IF '$TEST
SET DIC("A")="Name of "_$SELECT(ACRDUPJ>0:"NEXT ATTENDEE.:",1:"ATTENDEE......: ")
+4 DO DIC^ACRFDIC
+5 IF $DATA(ACRQUIT)
QUIT
+6 IF '+Y
SET ACRQUIT=""
QUIT
+7 IF '$DATA(^VA(200,+Y,0))#2
SET ACRQUIT=""
QUIT
+8 SET ACRTDA=+Y
+9 NEW X
+10 ;S X=$P(^VA(200,+Y,0),U) ;ACR*2.1*19.02 IM16848
+11 ;ACR*2.1*19.02 IM16848
SET X=$$NAME2^ACRFUTL1(+Y)
+12 SET X=$PIECE($PIECE(X,",",2)," ")_" "_$PIECE(X,",")
+13 SET ACRTNAM=X
+14 QUIT
SURE WRITE !!,"You have chosen to duplicate DOCUMENT NO.: ",ACRDOC
+1 IF "^130^600^148^"[(U_ACRREF_U)
Begin DoDot:1
+2 WRITE !,"The ",$SELECT(ACRREF'=148:"TRAVELER",1:"ATTENDEE")," for the new document is.....: ",ACRTNAM
End DoDot:1
+3 WRITE !,"You have chosen to create the"
+4 WRITE !,"NEW DOCUMENT in DEPARTMENT ACCOUNT ID NO.: ",ACRLBDA
+5 WRITE ?$X+2,ACRDNAM
+6 WRITE !?43,"FY: ",ACRFY
+7 WRITE ?$X+2,"CAN: ",ACRCAN
+8 SET DIR(0)="YO"
+9 SET DIR("A",1)="Are you certain this information is correct"
+10 SET DIR("A")="and you want to proceed with this duplication"
+11 SET DIR("B")="NO"
+12 WRITE !!
+13 DO DIR^ACRFDIC
+14 IF $GET(Y)'=1
SET ACRQUIT=""
QUIT
+15 SET ACRDUPJ=ACRDUPJ+1
+16 QUIT
DOC SET DIC="^ACRDOC("
+1 SET DIC(0)="AEMNQZ"
+2 SET DIC("A")="Duplicate DOCUMENT NO.: "
+3 ;ACR*2.1*3.32
SET DIC("S")="I $P($G(^ACROBL(+Y,""APV"")),U)'=""D"",'$P($G(^ACRDOC(+Y,0)),U,15),'$P($G(^(0)),U,19)"
+4 WRITE !!!
+5 DO DIC^ACRFDIC
+6 IF $DATA(ACRQUIT)
QUIT
+7 IF '+Y
SET ACRQUIT=""
QUIT
+8 IF '$DATA(^ACRDOC(+Y,0))
SET ACRQUIT=""
QUIT
+9 SET ACRDOCDA=+Y
+10 DO SETDOC^ACRFEA1
+11 IF '$GET(ACRREFDA)
SET ACRQUIT=""
QUIT
+12 IF ACRREF=600
SET ACRREF=130
+13 IF "^103^349^326^210^"[(U_ACRREF_U)
SET ACRREF=116
+14 SET (ACRREF,ACRREFX)=$PIECE(^AUTTDOCR(ACRREFDA,0),U)
+15 QUIT
BOIL ;DETERMINE IF BOILER PLATE STATEMENTS SHOULD BE DUPLICATED
+1 IF '$DATA(^ACRDOCBP("C",ACRDOCDA))
QUIT
+2 NEW J,X,Y
+3 WRITE !!,"The following BOILER PLATE statements are on file for this document."
+4 WRITE !!?10,"NO.",?15,"Type of Boiler Plate"
+5 WRITE !?10,"---",?15,"------------------------------"
+6 SET X=0
+7 FOR
SET X=$ORDER(^ACRDOCBP("C",ACRDOCDA,X))
IF 'X
QUIT
Begin DoDot:1
+8 SET J=$GET(J)+1
+9 SET J(J)=X
+10 SET Y=^ACRDOCBP(X,0)
+11 WRITE !?10,$JUSTIFY(J,3),?15,$PIECE($GET(^ACRBP(+Y,0)),U)
End DoDot:1
+12 SET DIR(0)="LO^1:"_+J
+13 SET DIR("A")="Duplicate which statement(s)"
+14 WRITE !
+15 DO DIR^ACRFDIC
+16 IF '+ACRY
KILL ACRQUIT
QUIT
+17 SET ACRBOIL=ACRY
+18 FOR J=1:1
SET ACRX=$PIECE(ACRBOIL,",",J)
IF 'ACRX!('$GET(J(+ACRX)))
QUIT
SET ACRBOIL(ACRX)=J(ACRX)
+19 QUIT
B NEW ACRX
+1 FOR J=1:1
SET ACRX=$PIECE(ACRBOIL,",",J)
IF 'ACRX!('$GET(ACRBOIL(+ACRX)))
QUIT
Begin DoDot:1
+2 SET ACRX=ACRBOIL(ACRX)
+3 SET X=+$GET(^ACRDOCBP(ACRX,0))
+4 IF 'X
QUIT
+5 SET DIC="^ACRDOCBP("
+6 SET DIC(0)="L"
+7 SET DIC("DR")=".02////"_ACROBL2
+8 DO FILE^ACRFDIC
+9 SET ACRBPDA=+Y
+10 SET %X="^ACRDOCBP("_ACRX_",1,"
+11 SET %Y="^ACRDOCBP("_ACRBPDA_",1,"
+12 DO %XY^%RCR
+13 SET DA=ACRBPDA
+14 SET DIK="^ACRDOCBP("
+15 DO IX1^ACRFDIC
End DoDot:1
+16 KILL ACRBOIL,ACRBPDA
+17 QUIT
AL ;DETERMINE IF AIRLINE RESERVATIONS SHOULD BE DUPLICATED
+1 IF '$DATA(^ACRAL("E",ACRDOCDA))
QUIT
+2 NEW J,X,Y
+3 WRITE !!,"The following AIRLINE RESERVATIONS are on file for this document."
+4 DO DISPLAY^ACRFSS5
+5 SET X=0
+6 FOR
SET X=$ORDER(^ACRAL("E",ACRDOCDA,X))
IF 'X
QUIT
Begin DoDot:1
+7 SET J=$GET(J)+1
+8 SET J(J)=X
End DoDot:1
+9 SET DIR(0)="LO^1:"_+J
+10 SET DIR("A")="Duplicate which reservation(s)"
+11 WRITE !
+12 DO DIR^ACRFDIC
+13 IF '+ACRY
KILL ACRQUIT
QUIT
+14 SET ACRBOIL=ACRY
+15 FOR J=1:1
SET ACRX=$PIECE(ACRBOIL,",",J)
IF 'ACRX!('$GET(J(+ACRX)))
QUIT
SET ACRBOIL(ACRX)=J(ACRX)
+16 QUIT
A(ACRBOIL,ACROBL2) ;
+1 ;----- DUPLICATES AIRLINE RESERVATIONS
+2 ;
+3 ; INPUT:
+4 ; ACRBOIL = ARRAY CONTAINING FLIGHT IENS FROM FMS AIRLINE
+5 ; INFORMATION FILE BEING DUPLICATED
+6 ; ACROBL2 = DUPLICATE DOCUMENT IEN
+7 ;
+8 NEW ACRDATA,ACRX,DD,DIC,DO,FLD,J,X
+9 FOR J=1:1
SET ACRX=$PIECE(ACRBOIL,",",J)
IF 'ACRX!('$GET(ACRBOIL(+ACRX)))
QUIT
Begin DoDot:1
+10 SET ACRX=ACRBOIL(ACRX)
+11 SET X=+$GET(^ACRAL(ACRX,0))
+12 IF 'X
QUIT
+13 SET DIC="^ACRAL("
+14 SET DIC(0)="L"
+15 SET DIC("DR")=".02////"_(ACROBL2)_";.03////"_ACROBL2
+16 SET ACRDATA=$GET(^ACRAL(ACRX,"DT"))
+17 FOR FLD=1:1:11
Begin DoDot:2
+18 SET DIC("DR")=DIC("DR")_";"_FLD_"///"_$PIECE(ACRDATA,U,FLD)
End DoDot:2
+19 DO FILE^DICN
End DoDot:1
+20 QUIT
