PSABRKU3 ;BIR/JMB/PDW-Upload and Process Prime Vendor Invoice Data - CONT'D ;8/13/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26,41,47,67**; 10/24/97;Build 15
;Checking the X12 invoice data.
S (PSASTCNT,PSAITCNT,PSACTRL(1))=0
K ^TMP($J,"PSAPV SET"),PSAERR
S PSALAST=""
S PSALINE=0 F S PSALINE=$O(^TMP($J,"PSAPVS",PSALINE)) Q:PSALINE="" S PSADATA=^(PSALINE) D
.;check segment order
.D ^PSABRKU5 S PSALAST=$P(PSADATA,"^")
ISA .;control header
.I PSALAST="ISA" D Q
..S PSASTCNT=0
..S PSAISA=PSADATA,PSACTRL="" I $L($P(PSADATA,"^",14))'=9 S PSASEG="ISA" D MSG^PSABRKU8
.;
IEA .;control trailer
.I PSALAST="IEA" D Q
..I $P(PSADATA,"^",3)'=$P(PSAISA,"^",14) S PSASEG="IEA" D MSG^PSABRKU8
.;
GS .;group header
.I PSALAST="GS" S PSAGS=PSADATA D Q
..F %=3,4 S PSAPC=$S(%=3:7,1:9) I $P(PSADATA,"^",%)'=$TR($P(PSAISA,"^",PSAPC)," ") S PSASEG="GS" D MSG^PSABRKU8
.;
GE .;group trailer
.I PSALAST="GE" D Q
..I $P(PSADATA,"^",3)'=$P($G(PSAGS),"^",7) S PSASEG="GE" D MSG^PSABRKU8
.;
ST .;set header
.I PSALAST="ST" D Q
..S PSAST=PSADATA,PSACTRL=$P(PSADATA,"^",3),PSASTCNT=1,PSAITCNT=0,PSANTYPE=""
..I $L(PSACTRL)<4!($L(PSACTRL)>10) S PSASEG="ST" D MSG^PSABRKU8 Q
.. I PSACTRL="0001" S PSACTRL=0 D RESETST
..;PSA*3*41 - McKesson probability of multiple files, may have to
..;increment transaction set control numbers in 'ST' & 'SE'
..I $D(^TMP($J,"PSAPV SET",PSACTRL,"IN")) D RESETST
..I $D(^XTMP("PSAPV",PSACTRL)) D RESETST ;may already be on file
.;
SE .;set trailer
.I PSALAST="SE" S PSASTCNT=PSASTCNT+1 D Q
..I $G(PSACTRL(1))'>0,$P(PSADATA,"^",3)'=PSACTRL S PSASEG="SE1" D MSG^PSABRKU8 Q
..I PSASTCNT'=$P(PSADATA,"^",2) S PSASEG="SE2" D MSG^PSABRKU8
.;
BIG .;beginning segment for invoice
.I PSALAST="BIG" S PSASTCNT=PSASTCNT+1 D Q
..I $P(PSADATA,"^",4)="" S $P(PSADATA,"^",4)=$P(PSADATA,"^",2)
..S $P(PSADATA,"^",5)=$TR($P(PSADATA,"^",5)," ")
..S ^TMP($J,"PSAPV SET",PSACTRL,"IN")=$P(PSADATA,"^",2,5)
.;
REF .;(not used)
.I PSALAST="REF" S PSASTCNT=PSASTCNT+1 Q
.;
.;buyer, seller, shipping addresses
N1 .I PSALAST="N1" S PSASTCNT=PSASTCNT+1,PSANTYPE=$P(PSADATA,"^",2) D Q
..I PSANTYPE'="BY",PSANTYPE'="DS",PSANTYPE'="ST" S PSASEG="N1" D MSG^PSABRKU8 Q
..S ^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE)=$P(PSADATA,"^",3)
.;
N2 .I PSALAST="N2" D Q
..D:PSANTYPE="" NTYPE
..S $P(^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE),"^",2)=$P(PSADATA,"^",2) S PSASTCNT=PSASTCNT+1
.;
N3 .I PSALAST="N3" D Q
..D:PSANTYPE="" NTYPE
..S $P(^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE),"^",3)=$P(PSADATA,"^",2) S PSASTCNT=PSASTCNT+1
.;
N4 .I PSALAST="N4" D Q
..D:PSANTYPE="" NTYPE
..S $P(^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE),"^",4,6)=$P(PSADATA,"^",2,4) S PSASTCNT=PSASTCNT+1,PSANTYPE=""
.;
DTM .;date time reference
.I PSALAST="DTM" S PSASTCNT=PSASTCNT+1 D Q
..S %=$S($P(PSADATA,"^",2)="002":5,$P(PSADATA,"^",2)="035":6,1:0) I '% Q
..S $P(^TMP($J,"PSAPV SET",PSACTRL,"IN"),"^",%)=$P(PSADATA,"^",3)
.;
IT1 .;invoice line item
.I PSALAST="IT1" S PSASTCNT=PSASTCNT+1,PSAITCNT=PSAITCNT+1 D ITEM Q
.;BGN PSA*3*67
PID .;generic vendor item name
.I PSALAST="PID" S PSASTCNT=PSASTCNT+1,$P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",29)=$S($P(PSADATA,"^",6)=$P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",28):"Unknown",1:$P(PSADATA,"^",6)) Q
PO4 .;DESCRIPTION OF ITEM
.I PSALAST="PO4" S PSASTCNT=PSASTCNT+1,$P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",30)=$P(PSADATA,"^",3)_"^"_$P(PSADATA,"^",9) D Q
.;END PSA*3*67
CTT .;item count
.I PSALAST="CTT" S PSASTCNT=PSASTCNT+1 D Q
..I PSAITCNT'=$P(PSADATA,"^",2) S PSASEG="CTT" D MSG^PSABRKU8
.;
UNKNOWN .;Segment we don't use
.S PSASTCNT=PSASTCNT+1
;
ERROR S PSASEG=$O(PSAERR("")) D:PSASEG'="" ERROR^PSABRKU8
Q
;
NTYPE S PSASEG="NONTYPE" D NONTYPE^PSABRKU8
Q
;
ITEM ;check line item
I '$P(PSADATA,"^",2) S PSASEG="IT1-1" D MSG^PSABRKU8 Q
I $P(PSADATA,"^",6)'="DS" S PSASEG="IT1-2" D MSG^PSABRKU8 Q
I $P(PSADATA,"^",8)="",$P(PSADATA,"^",10)="",$P(PSADATA,"^",12)="" S PSASEG="IT1-3" D MSG^PSABRKU8 Q
;"IT1" Seg=Qty Invoiced ^ Unit of Measure ^ Unit Price ^ Basic Unit Code "DS" ^ NDC ^ VSN
S PSAITEM=+$P(PSADATA,"^",2),^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM)=+$P(PSADATA,"^",3)_"^"_$P(PSADATA,"^",4)_"^"_$P(PSADATA,"^",5)_"^"_$P(PSADATA,"^",8)_"^"_$P(PSADATA,"^",10)
I $P(PSADATA,"^",12)'="",$P(PSADATA,"^",11)="UP" S $P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",26)=$P(PSADATA,"^",12)
;Next line to add vendor Generic Description
I $P(PSADATA,"^",14)'="" S $P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",28)=$P(PSADATA,"^",14)
;Eop67
Q
RESETST ;Reset PSACTRL
S PSACTRL(1)=+PSACTRL+1,X1=PSACTRL(1)
S PSACTRL=X1 I $D(^TMP($J,"PSAPV SET",PSACTRL)) G RESETST
I $D(^XTMP("PSAPV",PSACTRL)) G RESETST
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSABRKU3 4819 printed Dec 13, 2024@01:48:54 Page 2
PSABRKU3 ;BIR/JMB/PDW-Upload and Process Prime Vendor Invoice Data - CONT'D ;8/13/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26,41,47,67**; 10/24/97;Build 15
+2 ;Checking the X12 invoice data.
+3 SET (PSASTCNT,PSAITCNT,PSACTRL(1))=0
+4 KILL ^TMP($JOB,"PSAPV SET"),PSAERR
+5 SET PSALAST=""
+6 SET PSALINE=0
FOR
SET PSALINE=$ORDER(^TMP($JOB,"PSAPVS",PSALINE))
if PSALINE=""
QUIT
SET PSADATA=^(PSALINE)
Begin DoDot:1
+7 ;check segment order
+8 DO ^PSABRKU5
SET PSALAST=$PIECE(PSADATA,"^")
ISA ;control header
+1 IF PSALAST="ISA"
Begin DoDot:2
+2 SET PSASTCNT=0
+3 SET PSAISA=PSADATA
SET PSACTRL=""
IF $LENGTH($PIECE(PSADATA,"^",14))'=9
SET PSASEG="ISA"
DO MSG^PSABRKU8
End DoDot:2
QUIT
+4 ;
IEA ;control trailer
+1 IF PSALAST="IEA"
Begin DoDot:2
+2 IF $PIECE(PSADATA,"^",3)'=$PIECE(PSAISA,"^",14)
SET PSASEG="IEA"
DO MSG^PSABRKU8
End DoDot:2
QUIT
+3 ;
GS ;group header
+1 IF PSALAST="GS"
SET PSAGS=PSADATA
Begin DoDot:2
+2 FOR %=3,4
SET PSAPC=$SELECT(%=3:7,1:9)
IF $PIECE(PSADATA,"^",%)'=$TRANSLATE($PIECE(PSAISA,"^",PSAPC)," ")
SET PSASEG="GS"
DO MSG^PSABRKU8
End DoDot:2
QUIT
+3 ;
GE ;group trailer
+1 IF PSALAST="GE"
Begin DoDot:2
+2 IF $PIECE(PSADATA,"^",3)'=$PIECE($GET(PSAGS),"^",7)
SET PSASEG="GE"
DO MSG^PSABRKU8
End DoDot:2
QUIT
+3 ;
ST ;set header
+1 IF PSALAST="ST"
Begin DoDot:2
+2 SET PSAST=PSADATA
SET PSACTRL=$PIECE(PSADATA,"^",3)
SET PSASTCNT=1
SET PSAITCNT=0
SET PSANTYPE=""
+3 IF $LENGTH(PSACTRL)<4!($LENGTH(PSACTRL)>10)
SET PSASEG="ST"
DO MSG^PSABRKU8
QUIT
+4 IF PSACTRL="0001"
SET PSACTRL=0
DO RESETST
+5 ;PSA*3*41 - McKesson probability of multiple files, may have to
+6 ;increment transaction set control numbers in 'ST' & 'SE'
+7 IF $DATA(^TMP($JOB,"PSAPV SET",PSACTRL,"IN"))
DO RESETST
+8 ;may already be on file
IF $DATA(^XTMP("PSAPV",PSACTRL))
DO RESETST
End DoDot:2
QUIT
+9 ;
SE ;set trailer
+1 IF PSALAST="SE"
SET PSASTCNT=PSASTCNT+1
Begin DoDot:2
+2 IF $GET(PSACTRL(1))'>0
IF $PIECE(PSADATA,"^",3)'=PSACTRL
SET PSASEG="SE1"
DO MSG^PSABRKU8
QUIT
+3 IF PSASTCNT'=$PIECE(PSADATA,"^",2)
SET PSASEG="SE2"
DO MSG^PSABRKU8
End DoDot:2
QUIT
+4 ;
BIG ;beginning segment for invoice
+1 IF PSALAST="BIG"
SET PSASTCNT=PSASTCNT+1
Begin DoDot:2
+2 IF $PIECE(PSADATA,"^",4)=""
SET $PIECE(PSADATA,"^",4)=$PIECE(PSADATA,"^",2)
+3 SET $PIECE(PSADATA,"^",5)=$TRANSLATE($PIECE(PSADATA,"^",5)," ")
+4 SET ^TMP($JOB,"PSAPV SET",PSACTRL,"IN")=$PIECE(PSADATA,"^",2,5)
End DoDot:2
QUIT
+5 ;
REF ;(not used)
+1 IF PSALAST="REF"
SET PSASTCNT=PSASTCNT+1
QUIT
+2 ;
+3 ;buyer, seller, shipping addresses
N1 IF PSALAST="N1"
SET PSASTCNT=PSASTCNT+1
SET PSANTYPE=$PIECE(PSADATA,"^",2)
Begin DoDot:2
+1 IF PSANTYPE'="BY"
IF PSANTYPE'="DS"
IF PSANTYPE'="ST"
SET PSASEG="N1"
DO MSG^PSABRKU8
QUIT
+2 SET ^TMP($JOB,"PSAPV SET",PSACTRL,PSANTYPE)=$PIECE(PSADATA,"^",3)
End DoDot:2
QUIT
+3 ;
N2 IF PSALAST="N2"
Begin DoDot:2
+1 if PSANTYPE=""
DO NTYPE
+2 SET $PIECE(^TMP($JOB,"PSAPV SET",PSACTRL,PSANTYPE),"^",2)=$PIECE(PSADATA,"^",2)
SET PSASTCNT=PSASTCNT+1
End DoDot:2
QUIT
+3 ;
N3 IF PSALAST="N3"
Begin DoDot:2
+1 if PSANTYPE=""
DO NTYPE
+2 SET $PIECE(^TMP($JOB,"PSAPV SET",PSACTRL,PSANTYPE),"^",3)=$PIECE(PSADATA,"^",2)
SET PSASTCNT=PSASTCNT+1
End DoDot:2
QUIT
+3 ;
N4 IF PSALAST="N4"
Begin DoDot:2
+1 if PSANTYPE=""
DO NTYPE
+2 SET $PIECE(^TMP($JOB,"PSAPV SET",PSACTRL,PSANTYPE),"^",4,6)=$PIECE(PSADATA,"^",2,4)
SET PSASTCNT=PSASTCNT+1
SET PSANTYPE=""
End DoDot:2
QUIT
+3 ;
DTM ;date time reference
+1 IF PSALAST="DTM"
SET PSASTCNT=PSASTCNT+1
Begin DoDot:2
+2 SET %=$SELECT($PIECE(PSADATA,"^",2)="002":5,$PIECE(PSADATA,"^",2)="035":6,1:0)
IF '%
QUIT
+3 SET $PIECE(^TMP($JOB,"PSAPV SET",PSACTRL,"IN"),"^",%)=$PIECE(PSADATA,"^",3)
End DoDot:2
QUIT
+4 ;
IT1 ;invoice line item
+1 IF PSALAST="IT1"
SET PSASTCNT=PSASTCNT+1
SET PSAITCNT=PSAITCNT+1
DO ITEM
QUIT
+2 ;BGN PSA*3*67
PID ;generic vendor item name
+1 IF PSALAST="PID"
SET PSASTCNT=PSASTCNT+1
SET $PIECE(^TMP($JOB,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",29)=$SELECT($PIECE(PSADATA,"^",6)=$PIECE(^TMP($JOB,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",28):"Unknown",1:$PIECE(PSADATA,"^",6))
QUIT
PO4 ;DESCRIPTION OF ITEM
+1 IF PSALAST="PO4"
SET PSASTCNT=PSASTCNT+1
SET $PIECE(^TMP($JOB,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",30)=$PIECE(PSADATA,"^",3)_"^"_$PIECE(PSADATA,"^",9)
Begin DoDot:2
End DoDot:2
QUIT
+2 ;END PSA*3*67
CTT ;item count
+1 IF PSALAST="CTT"
SET PSASTCNT=PSASTCNT+1
Begin DoDot:2
+2 IF PSAITCNT'=$PIECE(PSADATA,"^",2)
SET PSASEG="CTT"
DO MSG^PSABRKU8
End DoDot:2
QUIT
+3 ;
UNKNOWN ;Segment we don't use
+1 SET PSASTCNT=PSASTCNT+1
End DoDot:1
+2 ;
ERROR SET PSASEG=$ORDER(PSAERR(""))
if PSASEG'=""
DO ERROR^PSABRKU8
+1 QUIT
+2 ;
NTYPE SET PSASEG="NONTYPE"
DO NONTYPE^PSABRKU8
+1 QUIT
+2 ;
ITEM ;check line item
+1 IF '$PIECE(PSADATA,"^",2)
SET PSASEG="IT1-1"
DO MSG^PSABRKU8
QUIT
+2 IF $PIECE(PSADATA,"^",6)'="DS"
SET PSASEG="IT1-2"
DO MSG^PSABRKU8
QUIT
+3 IF $PIECE(PSADATA,"^",8)=""
IF $PIECE(PSADATA,"^",10)=""
IF $PIECE(PSADATA,"^",12)=""
SET PSASEG="IT1-3"
DO MSG^PSABRKU8
QUIT
+4 ;"IT1" Seg=Qty Invoiced ^ Unit of Measure ^ Unit Price ^ Basic Unit Code "DS" ^ NDC ^ VSN
+5 SET PSAITEM=+$PIECE(PSADATA,"^",2)
SET ^TMP($JOB,"PSAPV SET",PSACTRL,"IT",PSAITEM)=+$PIECE(PSADATA,"^",3)_"^"_$PIECE(PSADATA,"^",4)_"^"_$PIECE(PSADATA,"^",5)_"^"_$PIECE(PSADATA,"^",8)_"^"_$PIECE(PSADATA,"^",10)
+6 IF $PIECE(PSADATA,"^",12)'=""
IF $PIECE(PSADATA,"^",11)="UP"
SET $PIECE(^TMP($JOB,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",26)=$PIECE(PSADATA,"^",12)
+7 ;Next line to add vendor Generic Description
+8 IF $PIECE(PSADATA,"^",14)'=""
SET $PIECE(^TMP($JOB,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",28)=$PIECE(PSADATA,"^",14)
+9 ;Eop67
+10 QUIT
RESETST ;Reset PSACTRL
+1 SET PSACTRL(1)=+PSACTRL+1
SET X1=PSACTRL(1)
+2 SET PSACTRL=X1
IF $DATA(^TMP($JOB,"PSAPV SET",PSACTRL))
GOTO RESETST
+3 IF $DATA(^XTMP("PSAPV",PSACTRL))
GOTO RESETST
+4 QUIT
