Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFDUP

ACRFDUP.m

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