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

ACRFSS.m

Go to the documentation of this file. 
  1. ACRFSS ;IHS/OIRM/DSD/THL,AEF - DISPLAY AND EDIT SERVICES/SUPPLIES;  [ 01/31/2007  9:55 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,22**;NOV 05, 2001
  1.  ;;ROUTINE TO DISPLAY AND EDIT SERVICES/SUPPLIES AND TRAVEL ORDER AND
  1.  ;;TRAINING REQUEST INFORMATION
  1. EN N ACRI
  1.  K ACRQUIT,DR,ACRSSDR
  1.  S:'$D(ACRTXDA) ACRTXDA=$P(ACRDOC0,U,4)
  1.  I ACRREF=130!(ACRREF=148)!(ACRREF=600) D  Q
  1.  .D ^ACRFSS3
  1.  .D EXIT
  1.  I ACRREF=999 D  Q
  1.  .D ^ACRFSS6
  1.  .D EXIT
  1.  F  D EN1 Q:$D(ACRQUIT)!$D(ACROUT)!$D(ACRREV)!$D(ACROUT)
  1.  I $D(ACRPO),'$D(ACROUT) D
  1.  .N ACRX
  1.  .S ACRX=0
  1.  .F  S ACRX=$O(ACRSS(ACRX)) Q:'ACRX  D
  1.  ..S ACRSSDA=$P(ACRSS(ACRX),U)
  1.  ..I $P(^ACRSS(ACRSSDA,0),U,12)]"" K ACRSS(ACRX)
  1.  .S (ACRK,ACRX)=0
  1.  .F  S ACRX=$O(ACRSS(ACRX)) Q:'ACRX  S ACRK=ACRK+1
  1.  .I ACRK>1 D  Q:Y'=1
  1.  ..S DIR(0)="YO"
  1.  ..S DIR("A")="Add these ITEMS to the STANDARD ITEM FILE"
  1.  ..S DIR("B")="NO"
  1.  ..W !
  1.  ..D DIR^ACRFDIC
  1.  .N ACRX
  1.  .S ACRX=0
  1.  .F  S ACRX=$O(ACRSS(ACRX)) Q:'ACRX  D
  1.  ..S ACRSSDA=+ACRSS(ACRX)
  1.  ..Q:$P(^ACRSS(ACRSSDA,0),U,12)]""
  1.  ..S DIR(0)="YO"
  1.  ..S DIR("A")="Add ITEM NO. "_ACRX_" to the STANDARD ITEM FILE"
  1.  ..S DIR("B")="NO"
  1.  ..W !
  1.  ..D DIR^ACRFDIC
  1.  ..Q:Y'=1
  1.  ..D ADD^ACRFSTOK
  1.  ..S DA=ACRSSDA
  1.  ..S DIE="^ACRSS("
  1.  ..S DR=".12////"_ACRITMDA
  1.  ..D DIE^ACRFDIC
  1. EXIT I $D(ACRSSTOT),$P(ACROBL0,U)'=ACRSSTOT D
  1.  .W !
  1.  .D WAIT^DICD:$E($G(IOST),1,2)="C-"
  1.  .D EX
  1.  D EXIT^ACRFSSA
  1.  Q
  1. EN1 I $D(ACRPO),'$D(^ACRSS("C",ACRDOCDA)),'$D(^ACRSS("J",ACRDOCDA)) D  Q
  1.  .W !!,"NO ITEMS ORDERED ON THIS REQUEST."
  1.  .H 2
  1.  .S ACRQUIT=""
  1.  I $D(^ACRSS("C",ACRDOCDA))!$D(^ACRSS("J",ACRDOCDA)) D
  1.  .N ACRSJ
  1.  .D DISPLAY^ACRFSS12
  1.  .D SELECT
  1.  I '$D(ACRREV),'$D(ACRPO),'$D(^ACRSS("C",ACRDOCDA)) D  Q:$D(ACRQUIT)!$D(ACROUT)
  1.  .S ACRJ=0
  1.  .S ACRDOCVN=$P(ACRDOCPO,U,5)
  1.  .W @IOF
  1.  .W !?20,"ADD ITEMS TO THIS REQUEST"
  1.  .W !!
  1.  .D ORDER^ACRFSS11
  1.  I '$D(ACRREV),'$D(ACRPO) D
  1.  .Q:"^103^349^326^210^"[(U_$G(ACRREFX)_U)
  1.  .Q:$P(^ACRDOC(ACRDOCDA,0),U,4)=35&($E($G(^ACROBL(ACRDOCDA,"APV")))="A")
  1.  .Q:$G(ACRAPVT)=31!($G(ACRAPVT)=6)
  1.  .D ^ACRFSCHK
  1.  Q
  1. SELECT D ^ACRFSSPO
  1.  D CHECK^ACRFWARN
  1.  Q:$D(ACROUT)
  1.  I $$REQTP^ACRFSSU(ACRDOCDA)["CREDIT CARD" D     ;ACR*2.1*5.17
  1.  .;I ACRSSTOT>2500 D CHECKCC^ACRFWARN(ACRSSTOT)   ;ACR*2.1*5.17 ;ACR*2.1*22.06 IM23064
  1.  .I ACRSSTOT>3000 D CHECKCC^ACRFWARN(ACRSSTOT)  ;ACR*2.1*22.06 IM23064
  1.  Q:$D(ACROUT)                                    ;ACR*2.1*5.17
  1.  I $D(ACRREV),$E(IOST,1,2)="C-" Q
  1.  I $D(ACRPO),ACRJ<1 S ACRQUIT="" H 2 Q
  1. SELECT1 I '$D(ACRPO) D
  1.  .S DIR(0)="SO^1:Edit an item;2:Add a new item;3:Delete an item;4:View item ADDITIONAL DESCRIPTION;5:Item Entry Completed"
  1.  .S:$G(ACRPOT)>2500 DIR(0)=DIR(0)_";6:Add Cost Comparison Data"
  1.  .I $P(^ACRDOC(ACRDOCDA,0),U,19),$P(^ACRDOC(ACRDOCDA,"PO"),U,5)=$P($G(^ACRSYS(1,"DT1")),U,12),$P($G(^ACRDOC(ACRDOCDA,"REQ2")),U,13)]"",$D(^ACRSUP("B",$P(^("REQ2"),U,13))) D
  1.  ..I $G(ACRPOT)>2500 S DIR(0)=DIR(0)_";7:"
  1.  ..E  S DIR(0)=DIR(0)_";6:"
  1.  ..S DIR(0)=DIR(0)_$S('$P($G(^ACRDOC(ACRDOCDA,"REQ2")),U,14):"Import Supply Contract Data",1:"Edit Unit of Issue/Object Code")
  1.  ..S ACRSUPC=$P($G(^ACRDOC(ACRDOCDA,"REQ2")),U,14) ;CONTROL UPDATE OF SUPPLY CONTRACT DATA FOR SELECTED DOCUMENT
  1.  I $D(ACRPO) D
  1.  .S DIR(0)="SO^1:Edit an item;2:Add NEW or Standard item;3:Delete an item;4:View item ADDITIONAL DESCRIPTION;5:Item Edit Completed;6:Transfer an item"
  1.  .S:$G(ACRPOT)>2500 DIR(0)=DIR(0)_";7:Add Cost Comparison Data"
  1.  I $G(ACRAPVT)=31!($G(ACRAPVT)=6) D
  1.  .S DIR(0)="SO^1:Edit an item;5:Item Entry Completed"
  1.  S DIR(0)=DIR(0)_";OUT:Discontinue Processing "_$S('$D(ACRPO):"Request",1:"PO")
  1.  S DIR("A")="    Option"
  1.  S DIR("B")=5
  1.  D DIR^ACRFDIC
  1.  Q:$D(ACRQUIT)!$D(ACROUT)
  1.  I Y=1 D EDIT^ACRFSS1 Q
  1.  I Y=2 D ORDER^ACRFSS11 K ACRQUIT Q
  1.  I Y=3 D DELETE^ACRFSS2 K ACRQUIT Q
  1.  I Y=4 D VIEW^ACRFSS2 K ACRQUIT Q
  1.  I Y=6,$D(ACRPO) D TRANS^ACRFSS2 Q
  1.  I Y=6,'$D(ACRPO),'$D(ACRSUPC) D EDIT^ACRFSS2 Q
  1.  I Y=7,'$D(ACRSUPC) D EDIT^ACRFSS2 Q
  1.  I Y=6!(Y=7),$D(ACRSUPC) D PVENDOR Q
  1.  I Y=5 S ACRQUIT="" Q
  1.  I Y="OUT",'$D(ACRPO),'$D(ACRPOA) S ACROUT=""
  1.  Q
  1. OBL ;EP;TO TRIGGER THE REQUEST APPROVED AND/OR REQUEST AUTHORIZED FIELD(S)
  1.  ;IN THE FMS SUPPLIES/SERVICES FILE TO UPDATE THE REQUESTED AND
  1.  ;OBLIGATED AMOUNTS
  1.  S ACRDA=0
  1.  F  S ACRDA=$O(^ACRSS("J",ACRDOCDA,ACRDA)) Q:'ACRDA  D
  1.  .S DA=ACRDA
  1.  .S DIE="^ACRSS("
  1.  .S DR="905////A"
  1.  .I "^103^349^326^210^600^148^"[(U_ACRREF_U) S DR=DR_";911///A"
  1.  .I ACRREF=204,$P(^ACRDOC(ACRDOCDA,0),U,4)=30 S DR=DR_";911///A"
  1.  .I ACRREF=116,$P(^ACRDOC(ACRDOCDA,0),U,4)=35 S DR=DR_";911///A"
  1.  .I $P(^ACRDOC(ACRDOCDA,0),U,19),$D(^ACRDOC($P(^(0),U,19),0)),$P(^(0),U,20) S DR=DR_";911///A"
  1.  .D DIE^ACRFDIC
  1.  .D TRANS
  1.  Q
  1. EX Q:'$P(^ACRSYS(1,"DT"),U,99)
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACROBL("
  1.  S DR=".01///"_(ACRSSTOT-$G(ACRQD))
  1.  S:$D(ACRVENDA) DR=DR_";100////"_ACRVENDA
  1.  D DIE^ACRFDIC
  1.  S DA=$O(^ACRTRX("AC",ACRDOCDA,"O",0))
  1.  S DIE="^ACRTRX("
  1.  S DR="10////"_(ACRSSTOT-$G(ACRQD))
  1.  D DIE^ACRFDIC
  1.  Q
  1. DISPLAY ;EP;
  1.  D DISPLAY^ACRFSS12
  1.  Q
  1. TRANS ;EP;TO SET THE DOCUMENT FILE MULTIPLE FOR ITEMS TRANSFERRED TO
  1.  ;ANOTHER DOCUMENT
  1.  Q:$D(^ACRSS("C",ACRDOCDA,ACRDA))
  1.  Q:$P(^ACRSS(ACRDA,0),U,2)=ACRDOCDA
  1.  S DA(1)=$P(^ACRSS(ACRDA,0),U,2)
  1.  Q:$D(^ACRDOC(DA(1),31,"B",ACRDOCDA))
  1.  S X=ACRDOCDA
  1.  S DIC="^ACRDOC("_DA(1)_",31,"
  1.  S DIC(0)="L"
  1.  S:'$D(^ACRDOC(DA(1),31,0)) ^ACRDOC(DA(1),31,0)="^9002196.031P"
  1.  D FILE^ACRFDIC
  1.  Q
  1. PVENDOR ;PRIME VENDOR OPTIONS
  1.  ;IF PRIME VENDOR DATA HAS NOT BEEN IMPORTED FOR THIS DOCUMENT, IMPORT
  1.  I '$G(ACRSUPC) D  Q
  1.  .K ACRSUPC
  1.  .S ACR1=$P($G(^ACRDOC(ACRDOCDA,"REQ2")),U,13)
  1.  .I ACR1="" K ACRSUPC Q
  1.  .S DIR(0)="YO"
  1.  .S DIR("A")="Update Items from Contractor Data"
  1.  .W !
  1.  .D DIR^ACRFDIC
  1.  .Q:$G(Y)'=1
  1.  .D DOC^ACRFPVEN
  1.  ;IF PRIME VENDOR DATA HAS BEEN IMPORTED ALLOW EDIT OF UNIT OF ISSUE
  1.  ;AND OBJECT CODE
  1.  N ACRSSDA
  1.  S ACRSSDA=0
  1.  F  S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA!$D(ACRQUIT)  D
  1.  .S DA=ACRSSDA
  1.  .S DIE="^ACRSS("
  1.  .S DR=".04T;11T"
  1.  .W !
  1.  .D DIE^ACRFDIC
  1.  .K ACRQUIT
  1.  .S DIR(0)="YO"
  1.  .S DIR("A")="Edit next item......"
  1.  .S DIR("B")="YES"
  1.  .D DIR^ACRFDIC
  1.  .I $G(Y)'=1 S ACRQUIT="" Q
  1.  Q