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

ACRFNEWD.m

Go to the documentation of this file. 
  1. 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
  1.  ;;ROUTINE TO CREATE NEW DOCUMENTS
  1. BEGIN ;EP;TO INQUIRE IF NEW DOCUMENT SHOULD BE CREATED
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Sure you want to create a **"_$S('$D(ACRAMEND)#2:"NEW",1:"MODIFICATION TO THE")_"** "_$P(^ACRTXTYP(ACRTXDA,0),U)_" entry"
  1.  S DIR("B")="NO"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I Y'=1 S ACRQUIT="" Q
  1.  Q:$D(ACRQUIT)!$D(ACROUT)!'$G(ACRFDNO)
  1.  D DOC^ACRFDOCN
  1.  W !!?10,"One moment, please.  Request being generated......"
  1.  Q:$D(ACRQUIT)!$D(ACROUT)
  1. BEGIN1 ;EP;TO CREATE NEW DOCUMENT
  1.  S X=0.00
  1.  S DIC="^ACROBL("
  1.  S DIC(0)="LZ"
  1.  S DIC("DR")=".03////"_ACRFDNO_";.04////"_ACRCANDA_";.05////"_DUZ_";.06////"_DT_";.1////"_ACRREFDA
  1.  S:'$D(ACRRR)#2 DIC("DR")=DIC("DR")_";907////"_ACRTXDA
  1.  D FILE^ACRFDIC
  1.  S (ACRDOCDA,ACRZDA)=+Y
  1.  S ACROBL=Y(0,0)
  1.  S ACRZY=Y
  1.  S X1=DT
  1.  S X2=30
  1.  D C^%DTC
  1.  S ACRDTREQ=X
  1.  S X=ACRDOC
  1.  S DIC="^ACRDOC("
  1.  S DIC(0)="LZ"
  1.  S DINUM=ACRDOCDA
  1.  S DIC("DR")=".03////"_DT_";.04////"_ACRTXDA_";.05////"_ACRDOCDA_";.06////"_ACRFDNO_";113020////"_$S(ACRTXDA'=2:"P",1:"S")_";113050////"_DT_";.12////0"
  1. BPA I '$D(ACRRR)#2 D
  1.  .S DIC("DR")=DIC("DR")_";113110////"_ACRDTREQ
  1.  .I $G(ACRBPA) D CALLNUM
  1.  I $D(ACRCALL) D  Q              ; ACR*2.1*14.03 IM13538
  1.  .W !?10,"Unable to assign BPA call number, try again later"  ; ACR*2.1*14.03 IM13538
  1.  .D PAUSE^ACRFWARN               ; ACR*2.1*14.03 IM13538
  1.  .S ACRQUIT=""                   ; ACR*2.1*14.03 IM13538
  1.  S:$D(ACRRR)#2 DIC("DR")=".02////"_ACRDOC_";"_DIC("DR")_";.13////"_ACRREFDA_";113110////"_ACRDTREQ_";.14////"_ACRID
  1.  W:'$D(ACRRR)#2&($E(IOST,1,2)="C-") !?10,"Default data being processed."
  1.  D FILE^ACRFDIC
  1.  I +Y<1 D  Q
  1.  .D EN3^ACRFDEL
  1.  .S ACRQUIT=""
  1.  S ACRDOCDA=+Y
  1.  N ACRS
  1.  I '$G(ACRADA),ACRFDNO D
  1.  .S ACRADA=$P(^ACRLOCB(ACRFDNO,"DT"),U,9)
  1.  .S ACRADA=$P(^ACRCAN(ACRADA,"DFLT1"),U,15)
  1.  .S ACRADA=$P(^ACRPO(ACRADA,0),U,19)
  1.  S ACRDT=^ACRSYS(ACRADA,"DT")
  1.  F ACR=1:1:16 S ACRS(ACR)=$P(ACRDT,U,ACR)
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRDOC("
  1.  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)
  1.  S DR=DR_";113360////"_ACRS(11)_";113390////"_ACRS(12)_";113400////"_ACRS(14)_";113410////"_ACRS(15)
  1.  I $G(ACRBPA) S DR=DR_";103070////"_ACRBPAV_";.04////"_ACRBPATX_";.4////"_ACRBPAPS_";103080////"_ACRBPATO_";103010////"_$G(ACROD)_";103150////"_$G(ACRRQDD)_";103120////"_ACRBPAFO
  1.  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"
  1.  S DR=DR_";113100////"_ACRCANDA
  1.  S ACRREF=$P(^AUTTDOCR(ACRREFDA,0),U)
  1.  I ACRREF=116 S DR=DR_";103990////"_$P($G(^ACRPO(+$P($G(^ACRCAN(ACRCANDA,"DFLT1")),U,15),"DT")),U,7)
  1.  D DIE^ACRFDIC
  1.  I ACRREF=130 D
  1.  .S DA=ACRDOCDA
  1.  .S DIE="^ACRDOC("
  1.  .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"
  1.  .S DR=DR_";130157////0;130172////"_ACRS(16)_";130010///"_$S('$D(ACRAMEND):"O",1:"A")
  1.  .D DIE^ACRFDIC
  1.  K ACRAMEND
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACROBL("
  1.  S DR=".07////"_ACRSSADA_";.08////"_ACRALWNO_";.09////"_ACRAPPDA_";1////"_ACRDOCDA_";10////"_ACRTXOBJ
  1.  W:'$D(ACRRR)#2&($E(IOST,1,2)="C-") !?10,"Mandatory signatures being set."
  1.  D DIE^ACRFDIC
  1.  S ACRLBOC=$S(ACRTXOBJ:$P(^AUTTOBJC(ACRTXOBJ,0),U),1:"")
  1.  S ACRLBDA=ACRFDNO
  1.  S ACRREF=$P(^AUTTDOCR(ACRREFDA,0),U)
  1.  D SETDOC^ACRFEA1
  1.  I $G(ACRBPA) D
  1.  .W !?10,"Small Purchase Data being transferred from original BPA..."
  1.  .D BPAADD^ACRFCIS
  1.  .W "..."
  1.  D EXPDN(ACRDOCDA)              ;ACR*2.1*14.01 IM12272
  1.  Q
  1.  ;
  1. AMEND ;EP;TO INDICATE IF REQUEST IS FOR MOD TO EXISTING DOCUMENT AND SELECT
  1.  ;DOCUMENT TO BE MODIFIED
  1.  K ACRAMEND,ACRNOT
  1.  S DIR(0)="YO"
  1.  S DIR("B")="NO"
  1.  S DIR("A")="Is this a modification"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:$D(ACRQUIT)!$D(ACROUT)!(Y'=1)
  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))"
  1.  ;
  1. A1 ;EP;FOR PURCHASING OFFICER TO SELECT DOCUMENT TO MODIFY
  1.  S DIC="^ACRDOC("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Document Modified: "
  1.  S D="B^C^G^J"
  1.  ;Modified following line   ;ACR*2.1*14.02 IM13539
  1.  ;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"""
  1.  ;New line follows   ;ACR*2.1*14.02 IM13539
  1.  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"""
  1.  W !
  1.  D MIX^ACRFDIC
  1.  ;S:+Y<1 ACRQUIT=""                              ;ACR*2.1*14.02 IM13539
  1.  ;I +Y<1 D                                        ;ACR*2.1*14.02 IM13539
  1.  ;I +Y<1!($P($G(^ACROBL(+Y,"APV")),U)="A") D      ;ACR*2.1*21.06 IM22547
  1.  I +Y<1!($P($G(^ACROBL(+Y,"APV")),U)'="A") D      ;ACR*2.1*21.06 IM22547
  1.  .W !!,*7,"Document not found, or may not be approved" ;ACR*2.1*14.02 IM13539
  1.  .D PAUSE^ACRFWARN                               ;ACR*2.1*14.02 IM13539
  1.  .S ACRQUIT=""                                   ;ACR*2.1*14.02 IM13539
  1.  Q:$D(ACRQUIT)!$D(ACROUT)
  1.  I '$$AMEND^ACRFNEW1(+Y) D  Q                    ;ACR*2.1*14.02 IM13539
  1.  .W !!,*7,"CANNOT AMEND AN AMENDMENT"            ;ACR*2.1*14.02 IM13539
  1.  .D PAUSE^ACRFWARN                               ;ACR*2.1*14.02 IM13539
  1.  .S ACRQUIT=""                                   ;ACR*2.1*14.02 IM13539
  1.  S ACRAMEND=+Y
  1.  S ACRTXDA=$P(^ACRDOC(+Y,0),U,4)
  1.  S ACRREFDA=$P(^ACRDOC(+Y,0),U,13)
  1.  S:$P($G(^ACRDOC(+Y,"PO")),U,5) ACRVDA=$P(^("PO"),U,5)
  1.  S ACRREF=$P(^AUTTDOCR(ACRREFDA,0),U)
  1.  S ACRTXOBJ=$P(^ACROBL(+Y,"DT"),U,3)
  1.  S ACRREF=$S("^116^204^103^349^326^210^"[(U_ACRREF_U):116,"^130^600^"[(U_ACRREF_U):130,1:ACRREF)
  1.  S ACRREFDA=$O(^AUTTDOCR("B",ACRREF,0))
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Are you certain this is the document you want to modify"
  1.  S DIR("B")="NO"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  S:Y'=1 ACRQUIT=""
  1.  Q
  1. CALLNUM ;D CALLNUM^ACRFNEW1
  1.  S ACRCALL=$$CALLNUM^ACRFNEW1(ACRBPA)  ; ACR*2.1*14.03 IM13538
  1.  Q:ACRCALL=""                          ; ACR*2.1*14.03 IM13538
  1.  S ACRPONUM=$E(ACRPONUM,1,8)_($S($L(ACRCALL)=1:0,1:""))_ACRCALL
  1.  K ACRCALL
  1.  G:$D(^ACRDOC("C",ACRPONUM)) CALLNUM
  1.  S DIC("DR")=DIC("DR")_";.19////"_ACRBPA_";.02////"_ACRPONUM_$S($D(^ACRDOC(ACRDOCDA,6,"B",DUZ)):";24////"_DUZ,1:"")
  1.  Q
  1. EXPDN(ACRDOCDA)    ;EP                         ;ACR*2.1*14.01 IM12272
  1.  ;----- INSERT EXPANDED DOCUMENT NUMBER INTO FMS DOCUMENT FILE AT
  1.  ;      THE TIME THE DOCUMENT IS CREATED FOR TRAVEL ORDERS AND 
  1.  ;      TRAINING REQUESTS
  1.  ;
  1.  ;      ACRDOCDA  =  INTERNAL DOCUMENT NUMBER
  1.  ;
  1.  N ACREXPDN,DA,DIE,DR,X,Y
  1.  S ACREXPDN=$$EXPDN^ACRFUTL(ACRDOCDA)
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRDOC("
  1.  S DR=".011///^S X=ACREXPDN"
  1.  D ^DIE
  1.  Q