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

ACRFPVEN.m

Go to the documentation of this file. 
  1. ACRFPVEN ;IHS/OIRM/DSD/THL,AEF - MANAGE IMPORT OF PRIME VENDOR CONTRACT FILE;  [ 11/01/2001   9:44 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
  1.  ;;MANAGE THE PRIME VENDOR CONTRACT FILE/DATA TRANSFER INTO ARMS
  1. EN ;EP;TO SELECT PRIME VENDOR CONTRACT FUNCTION
  1.  F  D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
  1. EXIT K ACRQUIT,ACROUT,ACR1,ACR2,ACR3,ACR4,ACR5,ACR6,ACR7,ACRDOCX,ACRDOC0,ACRDOCDA,ACRLBDA,ACR,ACROP,ACRX
  1.  Q
  1. EN1 W @IOF
  1.  W !!?10,"Utility to Import Prime Vendor Purchase Order Data"
  1.  S DIR(0)="YO"
  1.  S DIR("A")="IMPORT Prime Vendor Purchase Order Data"
  1.  S DIR("B")="NO"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I $G(Y)'=1 S ACRQUIT="" Q
  1.  I $G(Y)=1 D  Q
  1.  .D IMPORT
  1.  .U 0
  1.  .I $G(ACRI) W !!,"Import Complete."
  1.  .E  W !!,"NO ITEMS IMPORTED.  Import NOT completed."
  1.  .D PAUSE^ACRFWARN
  1.  .K ACRQUIT
  1.  I $G(Y)=2 D  Q
  1.  .D UPDATE
  1.  .U 0
  1.  .W !!,"ARMS Update Complete."
  1.  .D PAUSE^ACRFWARN
  1.  .K ACRQUIT
  1.  Q
  1. IMPORT ;EP;READ DATA FROM HOST FILE
  1.  ;ACR1 = PO NUMBER
  1.  ;ACR2 = NDC
  1.  ;ACR3 = VON
  1.  ;ACR4 = ITEM DESCRIPTION
  1.  ;ACR5 = UNIT OF ISSUE
  1.  ;ACR6 = QUANTITY SHIPPED
  1.  ;ACR7 = PRICE
  1.  D NOW^%DTC
  1.  N ACRNOW
  1.  S ACRNOW=$P(%,".",2)
  1.  N ACRJDATE
  1.  S ACRJDATE=$$JDATE^ACRFIV12(DT)
  1.  S DIR(0)="FO^3:10^I X?1""S""1N1U1"".""3N"
  1.  S DIR("A")="Name of file to import"
  1.  S DIR("B")="AS"_$E(DT,3)_$S(+$E(ACRNOW,1,2)>12:"P",1:"A")_"."_ACRJDATE
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I $G(Y)]"^"!($G(Y)="") S ACRQUIT="" Q
  1.  N ACRXFILE
  1.  S ACRXFILE=Y
  1.  I $D(^ACRSUP("D",ACRXFILE)) D  Q
  1.  .W !!,"Prime Vendor PO number ",ACRXFILE," is already on file in ARMS."
  1.  .W !,"It cannot be imported a second time."
  1.  .D PAUSE^ACRFWARN
  1.  N X,J,I
  1.  S %FN=$S($P($G(^ACRSYS(1,"DT1")),U,11)]"":$P(^("DT1"),U,11),1:"/usr/spool/uucppublic/")_ACRXFILE
  1.  S ACROP="R"
  1.  D HOST^ACRFZIS
  1.  I $D(ACRQUIT) D  Q
  1.  .W !!,"The file you specified - ",ACRXFILE," was not found."
  1.  .W !!,"Please confirm the file name and location before trying again."
  1.  .S ACRQUIT=""
  1.  N ACRI
  1.  S ACRI=0
  1.  F  U IO R X:10 Q:X=""  D   ;DIRECT READ FROM UNIX FILE
  1.  .S ACR1=$E(X,125,132)
  1.  .S ACR1=$TR(ACR1," ","")
  1.  .Q:ACR1=""
  1.  .S ACRDOCDA=$O(^ACRDOC("PVEN",ACR1,0))
  1.  .Q:$P($G(^ACRDOC(+ACRDOCDA,"REQ2")),U,14)=1
  1.  .S ACR2=$E(X,26,36)
  1.  .S ACR3=$E(X,37,42)
  1.  .S ACR4=$E(X,43,72)
  1.  .S ACR5=$E(X,73,80)
  1.  .S ACR5=$TR(ACR5," ","")
  1.  .S ACR6=$E(X,85,88)
  1.  .S ACR6=$TR(ACR6," ","")
  1.  .Q:ACR6=0  ;QUIT IF QUANTITY FILLED IS ZERO
  1.  .S ACR7=$E(X,99,108)
  1.  .S ACR7=$TR(ACR7," ","")
  1.  .U 0
  1.  .W !,ACR1,?$X+2,ACR2,?35,ACR3,?51,$J(ACR4,4),?57,$J(ACR5,10),?68," Imported."
  1.  .S X=ACR1
  1.  .S DIC="^ACRSUP("
  1.  .S DIC(0)="L"
  1.  .S DIC("DR")=".02////"_(ACR2)_";.03////"_(ACR3)_";.04////"_ACR4_";.06////"_ACR6_";.07////"_ACR7_";.08////0;.09////"_ACRXFILE
  1.  .D FILE^ACRFDIC
  1.  .S ACRI=ACRI+1
  1. CLOSE D CLOSE^ACRFZIS
  1.  Q
  1. UPDATE ;EP;UPDATE ARMS DOCUMENT WITH VENDOR ORDER DATA
  1.  S ACRDOCX=""
  1.  S ACR=0
  1.  F  S ACR=$O(^ACRSUP("C",0,ACR)) Q:'ACR  D
  1.  .S ACRX=^ACRSUP(ACR,0)
  1.  .Q:$P(ACRX,U,8)=1
  1.  .S ACR1=$P(ACRX,U)
  1.  .S ACRDOCDA=$O(^ACRDOC("PVEN",ACR1,0))
  1.  .Q:'ACRDOCDA
  1.  .I ACRDOCX'=ACRDOCDA D
  1.  ..S ACRDOCX=ACRDOCDA
  1.  ..W !,"Items being imported for DOCUMENT NO. ",$P(^ACRDOC(ACRDOCDA,0),U)
  1.  .D UP1
  1.  Q
  1. UP1 S ACRLBDA=$P(^ACRDOC(ACRDOCDA,0),U,6)
  1.  S ACRCANDA=$P($G(^ACRLOCB(+ACRLBDA,"DT")),U,9)
  1.  S DIC="^ACRSS("
  1.  S DIC(0)="L"
  1.  S DIC("DR")="100////"_$P(ACRX,U,4)
  1.  S X=1
  1.  D FILE^ACRFDIC
  1.  S DA=+Y
  1.  S DIE="^ACRSS("
  1.  S DR=".06////"_ACRLBDA_";.02////"_ACRDOCDA_";.03////"_ACRDOCDA_";.04////"_$O(^AUTTOBJC("B","2621 ",0))_";.05////"_ACRCANDA_";.2////"_ACRDOCDA_";1////"_$P(ACRX,U,3)_";3////"_$P(ACRX,U,2)_";10////"_$P(ACRX,U,6)_";11///EA;12////"_$P(ACRX,U,7)
  1.  D DIE^ACRFDIC
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRDOC("
  1.  S DR="113430////1"
  1.  D DIE^ACRFDIC
  1.  S DA=ACR
  1.  S DIE="^ACRSUP("
  1.  S DR=".08////1"
  1.  D DIE^ACRFDIC
  1.  U 0 W "."
  1.  Q
  1. DOC ;EP;TO UPDATE ARMS FOR SELECTED DOCUMENT
  1.  K ^TMP("ACRSUP",$J)
  1.  N ACR
  1.  S ACR=0
  1.  F  S ACR=$O(^ACRSUP("B",ACR1,ACR)) Q:'ACR  D
  1.  .S ACRX=^ACRSUP(ACR,0)
  1.  .Q:$P(ACRX,U,8)=1
  1.  .I $D(^TMP("ACRSUP",$J,ACRX)) D  Q
  1.  ..S DA=ACR
  1.  ..S DIK="^ACRSUP("
  1.  ..D DIK^ACRFDIC
  1.  ..W "*"
  1.  .S ^TMP("ACRSUP",$J,ACRX)=""
  1.  .D UP1
  1.  K ^TMP("ACRSUP",$J)
  1.  Q
  1. POS ;EP;FIND POS WHICH HAVE NOT BEEN IMPORTED TO ARMS
  1.  D POSEXIT
  1.  D POS1
  1. POSEXIT K ^TMP("ACRPV",$J)
  1.  Q
  1. POS1 N ACR,ACRJ,ACRX,ACR1
  1.  S ACR=0
  1.  F  S ACR=$O(^ACRSUP("C",0,ACR)) Q:'ACR  D
  1.  .S ACRX=^ACRSUP(ACR,0)
  1.  .Q:$P(ACRX,U,8)=1
  1.  .S ACR1=$P(ACRX,U)
  1.  .S ^TMP("ACRPV",$J,ACR1)=""
  1.  I '$D(^TMP("ACRPV",$J)) D  Q
  1.  .W !!,"There are no PRIME VENDOR orders on file"
  1.  .W !,"which need to be added to an ARMS document."
  1.  .D PAUSE^ACRFWARN
  1.  S ACRJ=0
  1.  S ACR=""
  1.  F  S ACR=$O(^TMP("ACRPV",$J,ACR)) Q:ACR=""  D
  1.  .S ACRJ=ACRJ+1
  1.  .W !?10,ACRJ,?15,ACR
  1.  .I ACRJ#10=0 D PAUSE^ACRFWARN
  1.  .S ACR1(ACRJ)=ACR
  1.  S DIR(0)="NO^1:"_ACRJ
  1.  S DIR("A",1)="Import items from which PRIME VENDOR order"
  1.  S DIR("A")="for ARMS requisition/call "_$P(^ACRDOC(ACRDOCDA,0),U)
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:'Y
  1.  S ACR1=ACR1(Y)
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRDOC("
  1.  S DR="113420////"_ACR1
  1.  D DIE^ACRFDIC
  1.  D DOC
  1.  Q