- PSAUP2 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data - CONT'D ;8/13/97
- ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**19,37**; 10/24/97
- ;Checking the X12 invoice data.
- K ^TMP("PSAPV SET",$J),PSAERR
- S (PSASTCNT,PSAITCNT)=0
- S PSALAST=""
- S PSALINE=0 F S PSALINE=$O(^TMP("PSAPVS",$J,PSALINE)) Q:PSALINE="" S PSADATA=^(PSALINE) D
- .;check segment order
- .D ^PSAUP3 S PSALAST=$P(PSADATA,"^")
- ISA .;control header
- .I PSALAST="ISA" D Q
- ..S PSAISA=PSADATA,PSACTRL="" W "." I $L($P(PSADATA,"^",14))'=9 S PSASEG="ISA" D MSG^PSAUTL2
- .;
- IEA .;control trailer
- .I PSALAST="IEA" D Q
- ..I $P(PSADATA,"^",3)'=$P(PSAISA,"^",14) S PSASEG="IEA" D MSG^PSAUTL2
- .;
- 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^PSAUTL2
- .;
- GE .;group trailer
- .I PSALAST="GE" D Q
- ..I $P(PSADATA,"^",3)'=$P($G(PSAGS),"^",7) S PSASEG="GE" D MSG^PSAUTL2
- .;
- ST .;set header
- .I PSALAST="ST" D Q
- ..S PSAST=PSADATA,PSACTRL=$P(PSADATA,"^",3),PSASTCNT=1,PSAITCNT=0,PSANTYPE=""
- ..I $L(PSACTRL)>3,$L(PSACTRL)<10 Q
- ..S PSASEG="ST" D MSG^PSAUTL2 Q
- .;
- SE .;set trailer
- .I PSALAST="SE" S PSASTCNT=PSASTCNT+1 D Q
- ..I $P(PSADATA,"^",3)'=PSACTRL S PSASEG="SE1" D MSG^PSAUTL2 Q
- ..I PSASTCNT'=$P(PSADATA,"^",2) S PSASEG="SE2" D MSG^PSAUTL2
- .;
- 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("PSAPV SET",$J,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^PSAUTL2 Q
- ..S ^TMP("PSAPV SET",$J,PSACTRL,PSANTYPE)=$P(PSADATA,"^",3)
- .;
- N2 .I PSALAST="N2" D Q
- ..D:PSANTYPE="" NTYPE
- ..S $P(^TMP("PSAPV SET",$J,PSACTRL,PSANTYPE),"^",2)=$P(PSADATA,"^",2) S PSASTCNT=PSASTCNT+1
- .;
- N3 .I PSALAST="N3" D Q
- ..D:PSANTYPE="" NTYPE
- ..S $P(^TMP("PSAPV SET",$J,PSACTRL,PSANTYPE),"^",3)=$P(PSADATA,"^",2) S PSASTCNT=PSASTCNT+1
- .;
- N4 .I PSALAST="N4" D Q
- ..D:PSANTYPE="" NTYPE
- ..S $P(^TMP("PSAPV SET",$J,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("PSAPV SET",$J,PSACTRL,"IN"),"^",%)=$P(PSADATA,"^",3)
- .;
- IT1 .;invoice line item
- .I PSALAST="IT1" S PSASTCNT=PSASTCNT+1,PSAITCNT=PSAITCNT+1 D ITEM Q
- CTT .;item count
- .I PSALAST="CTT" S PSASTCNT=PSASTCNT+1 D Q
- ..I PSAITCNT'=$P(PSADATA,"^",2) S PSASEG="CTT" D MSG^PSAUTL2
- .;
- UNKNOWN .;Segment we don't use
- .S PSASTCNT=PSASTCNT+1
- ;
- ERROR S PSASEG=$O(PSAERR("")) D:PSASEG'="" ERROR^PSAUTL2
- Q
- ;
- NTYPE S PSASEG="NONTYPE" D MSG^PSAUTL2
- Q
- ;
- ITEM ;check line item
- I '$P(PSADATA,"^",2) S PSASEG="IT1-1" D MSG^PSAUTL2 Q
- I $P(PSADATA,"^",6)'="DS" S PSASEG="IT1-2" D MSG^PSAUTL2 Q
- ;DAVE B (PSA*3*19) check for piece 10 (VSN) added
- I $P(PSADATA,"^",8)="",$P(PSADATA,"^",10)="",$P(PSADATA,"^",12)="" S PSASEG="IT1-3" D MSG^PSAUTL2 Q
- ;"IT1" Seg=Qty Invoiced ^ Unit of Measure ^ Unit Price ^ Basic Unit Code "DS" ^ NDC ^ VSN
- S PSAITEM=+$P(PSADATA,"^",2),^TMP("PSAPV SET",$J,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("PSAPV SET",$J,PSACTRL,"IT",PSAITEM),"^",26)=$P(PSADATA,"^",12)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAUP2 3740 printed Feb 18, 2025@23:17:10 Page 2
- PSAUP2 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data - CONT'D ;8/13/97
- +1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**19,37**; 10/24/97
- +2 ;Checking the X12 invoice data.
- +3 KILL ^TMP("PSAPV SET",$JOB),PSAERR
- +4 SET (PSASTCNT,PSAITCNT)=0
- +5 SET PSALAST=""
- +6 SET PSALINE=0
- FOR
- SET PSALINE=$ORDER(^TMP("PSAPVS",$JOB,PSALINE))
- if PSALINE=""
- QUIT
- SET PSADATA=^(PSALINE)
- Begin DoDot:1
- +7 ;check segment order
- +8 DO ^PSAUP3
- SET PSALAST=$PIECE(PSADATA,"^")
- ISA ;control header
- +1 IF PSALAST="ISA"
- Begin DoDot:2
- +2 SET PSAISA=PSADATA
- SET PSACTRL=""
- WRITE "."
- IF $LENGTH($PIECE(PSADATA,"^",14))'=9
- SET PSASEG="ISA"
- DO MSG^PSAUTL2
- End DoDot:2
- QUIT
- +3 ;
- IEA ;control trailer
- +1 IF PSALAST="IEA"
- Begin DoDot:2
- +2 IF $PIECE(PSADATA,"^",3)'=$PIECE(PSAISA,"^",14)
- SET PSASEG="IEA"
- DO MSG^PSAUTL2
- 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^PSAUTL2
- 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^PSAUTL2
- 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)>3
- IF $LENGTH(PSACTRL)<10
- QUIT
- +4 SET PSASEG="ST"
- DO MSG^PSAUTL2
- QUIT
- End DoDot:2
- QUIT
- +5 ;
- SE ;set trailer
- +1 IF PSALAST="SE"
- SET PSASTCNT=PSASTCNT+1
- Begin DoDot:2
- +2 IF $PIECE(PSADATA,"^",3)'=PSACTRL
- SET PSASEG="SE1"
- DO MSG^PSAUTL2
- QUIT
- +3 IF PSASTCNT'=$PIECE(PSADATA,"^",2)
- SET PSASEG="SE2"
- DO MSG^PSAUTL2
- 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("PSAPV SET",$JOB,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^PSAUTL2
- QUIT
- +2 SET ^TMP("PSAPV SET",$JOB,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("PSAPV SET",$JOB,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("PSAPV SET",$JOB,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("PSAPV SET",$JOB,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("PSAPV SET",$JOB,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
- 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^PSAUTL2
- 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^PSAUTL2
- +1 QUIT
- +2 ;
- NTYPE SET PSASEG="NONTYPE"
- DO MSG^PSAUTL2
- +1 QUIT
- +2 ;
- ITEM ;check line item
- +1 IF '$PIECE(PSADATA,"^",2)
- SET PSASEG="IT1-1"
- DO MSG^PSAUTL2
- QUIT
- +2 IF $PIECE(PSADATA,"^",6)'="DS"
- SET PSASEG="IT1-2"
- DO MSG^PSAUTL2
- QUIT
- +3 ;DAVE B (PSA*3*19) check for piece 10 (VSN) added
- +4 IF $PIECE(PSADATA,"^",8)=""
- IF $PIECE(PSADATA,"^",10)=""
- IF $PIECE(PSADATA,"^",12)=""
- SET PSASEG="IT1-3"
- DO MSG^PSAUTL2
- QUIT
- +5 ;"IT1" Seg=Qty Invoiced ^ Unit of Measure ^ Unit Price ^ Basic Unit Code "DS" ^ NDC ^ VSN
- +6 SET PSAITEM=+$PIECE(PSADATA,"^",2)
- SET ^TMP("PSAPV SET",$JOB,PSACTRL,"IT",PSAITEM)=+$PIECE(PSADATA,"^",3)_"^"_$PIECE(PSADATA,"^",4)_"^"_$PIECE(PSADATA,"^",5)_"^"_$PIECE(PSADATA,"^",8)_"^"_$PIECE(PSADATA,"^",10)
- +7 IF $PIECE(PSADATA,"^",12)'=""
- IF $PIECE(PSADATA,"^",11)="UP"
- SET $PIECE(^TMP("PSAPV SET",$JOB,PSACTRL,"IT",PSAITEM),"^",26)=$PIECE(PSADATA,"^",12)
- +8 QUIT
