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