Changeset 623 for WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- Location:
- WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA
- Files:
-
- 13 edited
-
PSABRKU3.m (modified) (1 diff)
-
PSABRKU5.m (modified) (1 diff)
-
PSAENTO.m (modified) (1 diff)
-
PSAORDP1.m (modified) (1 diff)
-
PSAPROC4.m (modified) (1 diff)
-
PSAPROC7.m (modified) (1 diff)
-
PSAUDP.m (modified) (1 diff)
-
PSAUP4.m (modified) (1 diff)
-
PSAUTL1.m (modified) (1 diff)
-
PSAUTL4.m (modified) (1 diff)
-
PSAVER7.m (modified) (1 diff)
-
PSAVERA.m (modified) (1 diff)
-
PSAVERA1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSABRKU3.m
r613 r623 1 PSABRKU3 ;BIR/JMB/PDW-Upload and Process Prime Vendor Invoice Data - CONT'D ;8/13/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26,41,47,67**; 10/24/97;Build 15 3 ;Checking the X12 invoice data. 4 S (PSASTCNT,PSAITCNT,PSACTRL(1))=0 5 K ^TMP($J,"PSAPV SET"),PSAERR 6 S PSALAST="" 7 S PSALINE=0 F S PSALINE=$O(^TMP($J,"PSAPVS",PSALINE)) Q:PSALINE="" S PSADATA=^(PSALINE) D 8 .;check segment order 9 .D ^PSABRKU5 S PSALAST=$P(PSADATA,"^") 10 ISA .;control header 11 .I PSALAST="ISA" D Q 12 ..S PSASTCNT=0 13 ..S PSAISA=PSADATA,PSACTRL="" I $L($P(PSADATA,"^",14))'=9 S PSASEG="ISA" D MSG^PSABRKU8 14 .; 15 IEA .;control trailer 16 .I PSALAST="IEA" D Q 17 ..I $P(PSADATA,"^",3)'=$P(PSAISA,"^",14) S PSASEG="IEA" D MSG^PSABRKU8 18 .; 19 GS .;group header 20 .I PSALAST="GS" S PSAGS=PSADATA D Q 21 ..F %=3,4 S PSAPC=$S(%=3:7,1:9) I $P(PSADATA,"^",%)'=$TR($P(PSAISA,"^",PSAPC)," ") S PSASEG="GS" D MSG^PSABRKU8 22 .; 23 GE .;group trailer 24 .I PSALAST="GE" D Q 25 ..I $P(PSADATA,"^",3)'=$P($G(PSAGS),"^",7) S PSASEG="GE" D MSG^PSABRKU8 26 .; 27 ST .;set header 28 .I PSALAST="ST" D Q 29 ..S PSAST=PSADATA,PSACTRL=$P(PSADATA,"^",3),PSASTCNT=1,PSAITCNT=0,PSANTYPE="" 30 ..I $L(PSACTRL)<4!($L(PSACTRL)>10) S PSASEG="ST" D MSG^PSABRKU8 Q 31 .. I PSACTRL="0001" S PSACTRL=0 D RESETST 32 ..;PSA*3*41 - McKesson probability of multiple files, may have to 33 ..;increment transaction set control numbers in 'ST' & 'SE' 34 ..I $D(^TMP($J,"PSAPV SET",PSACTRL,"IN")) D RESETST 35 ..I $D(^XTMP("PSAPV",PSACTRL)) D RESETST ;may already be on file 36 .; 37 SE .;set trailer 38 .I PSALAST="SE" S PSASTCNT=PSASTCNT+1 D Q 39 ..I $G(PSACTRL(1))'>0,$P(PSADATA,"^",3)'=PSACTRL S PSASEG="SE1" D MSG^PSABRKU8 Q 40 ..I PSASTCNT'=$P(PSADATA,"^",2) S PSASEG="SE2" D MSG^PSABRKU8 41 .; 42 BIG .;beginning segment for invoice 43 .I PSALAST="BIG" S PSASTCNT=PSASTCNT+1 D Q 44 ..I $P(PSADATA,"^",4)="" S $P(PSADATA,"^",4)=$P(PSADATA,"^",2) 45 ..S $P(PSADATA,"^",5)=$TR($P(PSADATA,"^",5)," ") 46 ..S ^TMP($J,"PSAPV SET",PSACTRL,"IN")=$P(PSADATA,"^",2,5) 47 .; 48 REF .;(not used) 49 .I PSALAST="REF" S PSASTCNT=PSASTCNT+1 Q 50 .; 51 .;buyer, seller, shipping addresses 52 N1 .I PSALAST="N1" S PSASTCNT=PSASTCNT+1,PSANTYPE=$P(PSADATA,"^",2) D Q 53 ..I PSANTYPE'="BY",PSANTYPE'="DS",PSANTYPE'="ST" S PSASEG="N1" D MSG^PSABRKU8 Q 54 ..S ^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE)=$P(PSADATA,"^",3) 55 .; 56 N2 .I PSALAST="N2" D Q 57 ..D:PSANTYPE="" NTYPE 58 ..S $P(^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE),"^",2)=$P(PSADATA,"^",2) S PSASTCNT=PSASTCNT+1 59 .; 60 N3 .I PSALAST="N3" D Q 61 ..D:PSANTYPE="" NTYPE 62 ..S $P(^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE),"^",3)=$P(PSADATA,"^",2) S PSASTCNT=PSASTCNT+1 63 .; 64 N4 .I PSALAST="N4" D Q 65 ..D:PSANTYPE="" NTYPE 66 ..S $P(^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE),"^",4,6)=$P(PSADATA,"^",2,4) S PSASTCNT=PSASTCNT+1,PSANTYPE="" 67 .; 68 DTM .;date time reference 69 .I PSALAST="DTM" S PSASTCNT=PSASTCNT+1 D Q 70 ..S %=$S($P(PSADATA,"^",2)="002":5,$P(PSADATA,"^",2)="035":6,1:0) I '% Q 71 ..S $P(^TMP($J,"PSAPV SET",PSACTRL,"IN"),"^",%)=$P(PSADATA,"^",3) 72 .; 73 IT1 .;invoice line item 74 .I PSALAST="IT1" S PSASTCNT=PSASTCNT+1,PSAITCNT=PSAITCNT+1 D ITEM Q 75 .;BGN PSA*3*67 76 PID .;generic vendor item name 77 .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 78 PO4 .;DESCRIPTION OF ITEM 79 .I PSALAST="PO4" S PSASTCNT=PSASTCNT+1,$P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",30)=$P(PSADATA,"^",3)_"^"_$P(PSADATA,"^",9) D Q 80 .;END PSA*3*67 81 CTT .;item count 82 .I PSALAST="CTT" S PSASTCNT=PSASTCNT+1 D Q 83 ..I PSAITCNT'=$P(PSADATA,"^",2) S PSASEG="CTT" D MSG^PSABRKU8 84 .; 85 UNKNOWN .;Segment we don't use 86 .S PSASTCNT=PSASTCNT+1 87 ; 88 ERROR S PSASEG=$O(PSAERR("")) D:PSASEG'="" ERROR^PSABRKU8 89 Q 90 ; 91 NTYPE S PSASEG="NONTYPE" D NONTYPE^PSABRKU8 92 Q 93 ; 94 ITEM ;check line item 95 I '$P(PSADATA,"^",2) S PSASEG="IT1-1" D MSG^PSABRKU8 Q 96 I $P(PSADATA,"^",6)'="DS" S PSASEG="IT1-2" D MSG^PSABRKU8 Q 97 I $P(PSADATA,"^",8)="",$P(PSADATA,"^",10)="",$P(PSADATA,"^",12)="" S PSASEG="IT1-3" D MSG^PSABRKU8 Q 98 ;"IT1" Seg=Qty Invoiced ^ Unit of Measure ^ Unit Price ^ Basic Unit Code "DS" ^ NDC ^ VSN 99 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) 100 I $P(PSADATA,"^",12)'="",$P(PSADATA,"^",11)="UP" S $P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",26)=$P(PSADATA,"^",12) 101 ;Next line to add vendor Generic Description 102 I $P(PSADATA,"^",14)'="" S $P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",28)=$P(PSADATA,"^",14) 103 ;Eop67 104 Q 105 RESETST ;Reset PSACTRL 106 S PSACTRL(1)=+PSACTRL+1,X1=PSACTRL(1) 107 S PSACTRL=X1 I $D(^TMP($J,"PSAPV SET",PSACTRL)) G RESETST 108 I $D(^XTMP("PSAPV",PSACTRL)) G RESETST 109 Q 1 PSABRKU3 ;BIR/JMB/PDW-Upload and Process Prime Vendor Invoice Data - CONT'D ;8/13/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26,41,47**; 10/24/97 3 ;Checking the X12 invoice data. 4 S (PSASTCNT,PSAITCNT,PSACTRL(1))=0 5 K ^TMP($J,"PSAPV SET"),PSAERR 6 S PSALAST="" 7 S PSALINE=0 F S PSALINE=$O(^TMP($J,"PSAPVS",PSALINE)) Q:PSALINE="" S PSADATA=^(PSALINE) D 8 .;check segment order 9 .D ^PSABRKU5 S PSALAST=$P(PSADATA,"^") 10 ISA .;control header 11 .I PSALAST="ISA" D Q 12 ..S PSASTCNT=0 13 ..S PSAISA=PSADATA,PSACTRL="" I $L($P(PSADATA,"^",14))'=9 S PSASEG="ISA" D MSG^PSABRKU8 14 .; 15 IEA .;control trailer 16 .I PSALAST="IEA" D Q 17 ..I $P(PSADATA,"^",3)'=$P(PSAISA,"^",14) S PSASEG="IEA" D MSG^PSABRKU8 18 .; 19 GS .;group header 20 .I PSALAST="GS" S PSAGS=PSADATA D Q 21 ..F %=3,4 S PSAPC=$S(%=3:7,1:9) I $P(PSADATA,"^",%)'=$TR($P(PSAISA,"^",PSAPC)," ") S PSASEG="GS" D MSG^PSABRKU8 22 .; 23 GE .;group trailer 24 .I PSALAST="GE" D Q 25 ..I $P(PSADATA,"^",3)'=$P($G(PSAGS),"^",7) S PSASEG="GE" D MSG^PSABRKU8 26 .; 27 ST .;set header 28 .I PSALAST="ST" D Q 29 ..S PSAST=PSADATA,PSACTRL=$P(PSADATA,"^",3),PSASTCNT=1,PSAITCNT=0,PSANTYPE="" 30 ..I $L(PSACTRL)<4!($L(PSACTRL)>10) S PSASEG="ST" D MSG^PSABRKU8 Q 31 .. I PSACTRL="0001" S PSACTRL=0 D RESETST 32 ..;PSA*3*41 - McKesson probability of multiple files, may have to 33 ..;increment transaction set control numbers in 'ST' & 'SE' 34 ..I $D(^TMP($J,"PSAPV SET",PSACTRL,"IN")) D RESETST 35 ..I $D(^XTMP("PSAPV",PSACTRL)) D RESETST ;may already be on file 36 .; 37 SE .;set trailer 38 .I PSALAST="SE" S PSASTCNT=PSASTCNT+1 D Q 39 ..I $G(PSACTRL(1))'>0,$P(PSADATA,"^",3)'=PSACTRL S PSASEG="SE1" D MSG^PSABRKU8 Q 40 ..I PSASTCNT'=$P(PSADATA,"^",2) S PSASEG="SE2" D MSG^PSABRKU8 41 .; 42 BIG .;beginning segment for invoice 43 .I PSALAST="BIG" S PSASTCNT=PSASTCNT+1 D Q 44 ..I $P(PSADATA,"^",4)="" S $P(PSADATA,"^",4)=$P(PSADATA,"^",2) 45 ..S $P(PSADATA,"^",5)=$TR($P(PSADATA,"^",5)," ") 46 ..S ^TMP($J,"PSAPV SET",PSACTRL,"IN")=$P(PSADATA,"^",2,5) 47 .; 48 REF .;(not used) 49 .I PSALAST="REF" S PSASTCNT=PSASTCNT+1 Q 50 .; 51 .;buyer, seller, shipping addresses 52 N1 .I PSALAST="N1" S PSASTCNT=PSASTCNT+1,PSANTYPE=$P(PSADATA,"^",2) D Q 53 ..I PSANTYPE'="BY",PSANTYPE'="DS",PSANTYPE'="ST" S PSASEG="N1" D MSG^PSABRKU8 Q 54 ..S ^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE)=$P(PSADATA,"^",3) 55 .; 56 N2 .I PSALAST="N2" D Q 57 ..D:PSANTYPE="" NTYPE 58 ..S $P(^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE),"^",2)=$P(PSADATA,"^",2) S PSASTCNT=PSASTCNT+1 59 .; 60 N3 .I PSALAST="N3" D Q 61 ..D:PSANTYPE="" NTYPE 62 ..S $P(^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE),"^",3)=$P(PSADATA,"^",2) S PSASTCNT=PSASTCNT+1 63 .; 64 N4 .I PSALAST="N4" D Q 65 ..D:PSANTYPE="" NTYPE 66 ..S $P(^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE),"^",4,6)=$P(PSADATA,"^",2,4) S PSASTCNT=PSASTCNT+1,PSANTYPE="" 67 .; 68 DTM .;date time reference 69 .I PSALAST="DTM" S PSASTCNT=PSASTCNT+1 D Q 70 ..S %=$S($P(PSADATA,"^",2)="002":5,$P(PSADATA,"^",2)="035":6,1:0) I '% Q 71 ..S $P(^TMP($J,"PSAPV SET",PSACTRL,"IN"),"^",%)=$P(PSADATA,"^",3) 72 .; 73 IT1 .;invoice line item 74 .I PSALAST="IT1" S PSASTCNT=PSASTCNT+1,PSAITCNT=PSAITCNT+1 D ITEM Q 75 CTT .;item count 76 .I PSALAST="CTT" S PSASTCNT=PSASTCNT+1 D Q 77 ..I PSAITCNT'=$P(PSADATA,"^",2) S PSASEG="CTT" D MSG^PSABRKU8 78 .; 79 UNKNOWN .;Segment we don't use 80 .S PSASTCNT=PSASTCNT+1 81 ; 82 ERROR S PSASEG=$O(PSAERR("")) D:PSASEG'="" ERROR^PSABRKU8 83 Q 84 ; 85 NTYPE S PSASEG="NONTYPE" D NONTYPE^PSABRKU8 86 Q 87 ; 88 ITEM ;check line item 89 I '$P(PSADATA,"^",2) S PSASEG="IT1-1" D MSG^PSABRKU8 Q 90 I $P(PSADATA,"^",6)'="DS" S PSASEG="IT1-2" D MSG^PSABRKU8 Q 91 I $P(PSADATA,"^",8)="",$P(PSADATA,"^",10)="",$P(PSADATA,"^",12)="" S PSASEG="IT1-3" D MSG^PSABRKU8 Q 92 ;"IT1" Seg=Qty Invoiced ^ Unit of Measure ^ Unit Price ^ Basic Unit Code "DS" ^ NDC ^ VSN 93 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) 94 I $P(PSADATA,"^",12)'="",$P(PSADATA,"^",11)="UP" S $P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",26)=$P(PSADATA,"^",12) 95 Q 96 RESETST ;Reset PSACTRL 97 S PSACTRL(1)=+PSACTRL+1,X1=PSACTRL(1) 98 S PSACTRL=X1 I $D(^TMP($J,"PSAPV SET",PSACTRL)) G RESETST 99 I $D(^XTMP("PSAPV",PSACTRL)) G RESETST 100 Q -
WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSABRKU5.m
r613 r623 1 PSABRKU5 ;BIR/DB-Upload and Process Prime Vendor Invoice Data - CONT'D ;7/23/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26,67**; 10/24/97;Build 15 3 ;This routine checks for correct X12 formating. 4 ; 5 ORDER ; check order of code sheets 6 S PSANEXT=$P(PSADATA,"^") 7 ; 8 I PSALAST="GE",PSANEXT="GS" Q 9 I PSALAST="GE",PSANEXT'="IEA" D ORDERROR("GE",PSANEXT,"IEA") Q 10 ; 11 I PSALAST="ISA",PSANEXT'="GS" D ORDERROR("ISA",PSANEXT,"GS") Q 12 ; 13 I PSALAST="SE",PSANEXT="ST" Q 14 I PSALAST="SE",PSANEXT'="GE" D ORDERROR("SE",PSANEXT,"GE") Q 15 ; 16 I PSALAST="GS",PSANEXT'="ST" D ORDERROR("GS",PSANEXT,"ST") Q 17 ; 18 I PSALAST="CTT",PSANEXT'="SE" D ORDERROR("CTT",PSANEXT,"SE") Q 19 ; 20 I PSALAST="ST",PSANEXT'="BIG" D ORDERROR("ST",PSANEXT,"BIG") Q 21 ; 22 ;adding next two lines for new format 23 I PSALAST="IT1",PSANEXT="PID" Q 24 I PSALAST="PO4",PSANEXT'="IT1",PSANEXT'="CTT"&(PSANEXT'="TDS") D ORDERROR("PO4",PSANEXT,"CTT") Q 25 ;End of PSA*3*67 Changes 26 Q 27 ; 28 ORDERROR(PSALAST,PSANEW,PSAEXPEC) ;Segments out of order 29 ;ISA segment should be first 30 I PSALAST="" S PSASEG="ORDER1" D MSG^PSABRKU8 Q 31 ;Segments other than ISA 32 S PSASEG="ORDER2" D MSG^PSABRKU8 33 Q 1 PSABRKU5 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data - CONT'D ;7/23/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26**; 10/24/97 3 ;This routine checks for correct X12 formating. 4 ; 5 ORDER ; check order of code sheets 6 ; isa <--------------+ 7 ; gs <----------+ | 8 ; st <------+ | | 9 ; | big | | | 10 ; | it1 <--+ | | | 11 ; | ... | | | |--repeats 12 ; | it1 <--+ | | | 13 ; | ctt | | | 14 ; se <------+ | | 15 ; ge <----------+ | 16 ; iea <--------------+ 17 S PSANEXT=$P(PSADATA,"^") 18 ; 19 I PSALAST="GE",PSANEXT="GS" Q 20 I PSALAST="GE",PSANEXT'="IEA" D ORDERROR("GE",PSANEXT,"IEA") Q 21 ; 22 I PSALAST="ISA",PSANEXT'="GS" D ORDERROR("ISA",PSANEXT,"GS") Q 23 ; 24 I PSALAST="SE",PSANEXT="ST" Q 25 I PSALAST="SE",PSANEXT'="GE" D ORDERROR("SE",PSANEXT,"GE") Q 26 ; 27 I PSALAST="GS",PSANEXT'="ST" D ORDERROR("GS",PSANEXT,"ST") Q 28 ; 29 I PSALAST="CTT",PSANEXT'="SE" D ORDERROR("CTT",PSANEXT,"SE") Q 30 ; 31 I PSALAST="ST",PSANEXT'="BIG" D ORDERROR("ST",PSANEXT,"BIG") Q 32 ; 33 I PSALAST="IT1",PSANEXT="IT1" Q 34 I PSALAST="IT1",PSANEXT'="CTT"&(PSANEXT'="TDS") D ORDERROR("IT1",PSANEXT,"CTT") Q 35 Q 36 ; 37 ORDERROR(PSALAST,PSANEW,PSAEXPEC) ;Segments out of order 38 ;ISA segment should be first 39 I PSALAST="" S PSASEG="ORDER1" D MSG^PSABRKU8 Q 40 ;Segments other than ISA 41 S PSASEG="ORDER2" D MSG^PSABRKU8 42 Q -
WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAENTO.m
r613 r623 1 PSAENTO 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**12,21,43,63**; 10/24/97;Build 10 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 OP 20 21 22 23 24 25 26 27 28 DAVEB 29 30 31 32 33 34 35 OPC 36 S DIE="^PSD(58.8,",DA=PSALOC,DR="20//^S X=$P($G(^PS(59,+PSAOSIT,0)),U)" D ^DIE K DIE I $D(DTOUT)!($D(Y)) G QUIT ;; <3*63 RJS> 37 38 39 40 41 ED 42 QUES 43 44 45 46 47 LOOP 48 49 50 51 ITEM 52 53 54 55 56 57 ...F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3)I Q58 FIND 59 60 61 62 63 64 65 DRUGS 66 67 IV 68 69 IV1 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 QUIT 93 UNLINK 94 95 96 97 98 99 100 101 102 103 104 1 PSAENTO ;BIR/LTL,JMB-Set Up/Edit a Pharmacy Location - CONT'D ;7/23/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**12,21,43**; 10/24/97 3 ;This routines is called by PSAENT. 4 ; 5 ;References to global ^PRC(441 are covered by IA #214 6 ;References to global ^PRCP(445 are covered by IA #214 7 ;References to global ^PS(52.6, are covered by IA #270 8 ;References to global ^PS(52.7 are covered by IA #770 9 ;References to global ^PS(59, are covered by IA #212 10 ;References to global ^PS(59.5 are covered by IA #1884 11 ;References to global ^PSDRUG( are covered by IA #2095 12 ;References to global ^PSDRUG("AB" are covered by IA #2095 13 ; 14 ;External references to $$DESCR^PRCPUX1 are covered by IA #259 15 ;External references to $$INVNAME^PRCPUX1 are covered by IA #259 16 ; 17 ; 18 ; 19 OP G:$P($G(^PSD(58.8,+$G(PSALOC),0)),U,10) OPC 20 S Y=1 S PSA=$O(^PS(59,0)) D:$O(^PS(59,PSA)) G:Y<0 QUIT 21 .;more than one OP site 22 .W !!,"Because there is more than one Outpatient Site at this facility, I need you to " 23 .S DIC="^PS(59,",DIC(0)="AEMQ",DIC("A")="select an Outpatient Site: " D ^DIC K DIC S PSAOSIT=+Y 24 S:'$D(PSAOSIT) PSAOSIT=+$O(^PS(59,0)) 25 ;if IP changed to combined, check for existing OP and zap 26 I +$G(PSALOC),+$G(PSAOC),$O(^PSD(58.8,"AOP",+PSAOSIT,"")),($O(^PSD(58.8,"AOP",+PSAOSIT,""))'=$G(PSALOC)) S DIE="^PSD(58.8,",DA=$O(^PSD(58.8,"AOP",+PSAOSIT,"")),DR="20////@" D ^DIE K DIE 27 I $G(PSALOC),'$O(^PSD(58.8,"AOP",+PSAOSIT,"")) S DIE="^PSD(58.8,",DA=PSALOC,DR="20////^S X=+PSAOSIT" D ^DIE K DIE 28 DAVEB I '$O(^PSD(58.8,"AOP",+PSAOSIT,"")) D G:Y<0 QUIT 29 .;DAVE B (PSA*3*12) dic(0) was AEMQLZ; *43 added back Z 30 .S DIC="^PSD(58.8,",DIC(0)="AELXZ",DLAYGO=58.8,DIC("A")="Please select Location: ",DIC("B")=$S(PSAITY=2:"OUTPATIENT",PSAITY=3:"COMBINED (IP/OP)",1:"") 31 .S DIC("DR")="1////P;20////^S X=+PSAOSIT",DIC("S")="I $P($G(^(0)),U,2)=""P"",$S($P($G(^(0)),U,10):$P($G(^(0)),U,10)=+PSAOSIT,1:1)" 32 .S:PSAITY=3 DIC("W")="W ?30,""IP SITE: "",$P($G(^PS(59.4,+$P($G(^(0)),U,3),0)),U)" 33 .D ^DIC K DIC,DLAYGO S:Y>0 PSALOC=+Y,PSALOCN=Y(0,0) 34 S:'$D(PSALOC) PSALOC=$O(^PSD(58.8,"AOP",+PSAOSIT,"")),PSALOCN=$P($G(^PSD(58.8,+PSALOC,0)),U) 35 OPC W !!,"Outpatient site selection affects the collection of dispensing data.",! 36 S DIE="^PSD(58.8,",DA=PSALOC,DR="20//^S X=$P($G(^PS(59,+PSAOSIT,0)),U)" D ^DIE K DIE G:$D(Y) QUIT 37 S PSAOSIT=+$P($G(^PSD(58.8,PSALOC,0)),"^",10) 38 G:'PSALOC QUIT 39 N PSADT,PSAT,PSAQTY,PSAY 40 G:$G(PSAPVMEN) DRUGS 41 ED S DIE=58.8,DA=PSALOC,DR="[PSAENT]" D ^DIE K DIE,DA G:$D(Y) QUIT G:'$D(PSAINV) DRUGS D:$O(^PRCP(445,PSAINV,1,0)) G:$D(DIRUT) QUIT 42 QUES .S DIR(0)="Y",DIR("A",1)="Would you like to loop through "_$$INVNAME^PRCPUX1($G(PSAINV))_"'S",DIR("A")="items to check for any new entries that are ready to load" 43 .S DIR("?")="I will check for items that are linked to the DRUG file but not yet stocked." 44 .W ! D ^DIR K DIR Q:'Y S PSAIT=0 D 45 ..S DIR(0)="Y",DIR("A")="Load inventory quantities also",DIR("B")="Yes",DIR("?")="Inventory quantities will be multiplied by the dispensing unit conversion factor." D ^DIR K DIR Q:$D(DIRUT) S:Y=1 PSAY=1 46 ..S:'$D(^PSD(58.8,+PSALOC,1,0)) ^(0)="^58.8001IP^^" 47 LOOP ..F S PSAIT=$O(^PRCP(445,+PSAINV,1,PSAIT)) Q:'PSAIT I '$G(^PRC(441,PSAIT,3)),$O(^PSDRUG("AB",+PSAIT,0)) S PSADRUG=$O(^PSDRUG("AB",PSAIT,0)) D:'$D(^PSD(58.8,+PSALOC,1,+PSADRUG,0)) Q:$D(DIRUT) 48 ...Q:'$S('$D(^PSDRUG(PSADRUG,"I")):1,+^("I")>DT:1,1:0) 49 ...S DIR(0)="Y",DIR("A",1)="OK to load "_$P($G(^PSDRUG(PSADRUG,0)),U)_" from the DRUG file",DIR("A")="linked to inventory item: "_$$DESCR^PRCPUX1($G(PSAINV),$G(PSAIT)),DIR("B")="Yes" D ^DIR K DIR Q:Y<1 S X=PSADRUG 50 ...S:$G(PSAY) DIC("DR")="3//^S X=PSAQTY;S PSAQTY=X" 51 ITEM ...S DA(1)=PSALOC,DIC="^PSD(58.8,PSALOC,1,",DIC(0)="EMQL",DLAYGO=58.8,PSAQTY=$P($G(^PRCP(445,+PSAINV,1,PSAIT,0)),U,7)*$S($P($G(^(0)),U,29):$P(^(0),U,29),1:1) D ^DIC K DIC,DLAYGO Q:Y<0 52 ...Q:'$G(PSAY) 53 ...W !,"Updating Beginning balance and transaction history.",! 54 ...D NOW^%DTC S PSADT=+$E(%,1,12) K % 55 ...S ^PSD(58.8,+PSALOC,1,+PSADRUG,5,0)="^58.801A^^" 56 ...S DIC="^PSD(58.8,+PSALOC,1,+PSADRUG,5,",DIC(0)="LM",(X,DINUM)=$E(DT,1,5)*100,DA(2)=PSALOC,DA(1)=PSADRUG,DIC("DR")="1////^S X=$G(PSAQTY);5////^S X=$G(PSAQTY)",DLAYGO=58.8 D ^DIC K DIC,DLAYGO 57 ...F L +^PSD(58.81,0):0 I Q 58 FIND ...S PSAT=$P(^PSD(58.81,0),U,3)+1 I $D(^PSD(58.81,PSAT)) S $P(^PSD(58.81,0),U,3)=$P(^PSD(58.81,0),U,3)+1 G FIND 59 ...S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSAT D ^DIC K DIC,DLAYGO L -^PSD(58.81,0) 60 ...S DIE="^PSD(58.81,",DA=PSAT,DR="1////11;2////^S X=PSALOC;3////^S X=PSADT;4////^S X=PSADRUG;5////^S X=PSAQTY;6////^S X=DUZ;9////0" D ^DIE K DIE 61 ...S:'$D(^PSD(58.8,+PSALOC,1,+PSADRUG,4,0)) ^(0)="^58.800119PA^^" 62 ...S DIC="^PSD(58.8,+PSALOC,1,+PSADRUG,4,",DLAYGO=58.8,DIC(0)="L",(X,DINUM)=PSAT 63 ...S DA(2)=PSALOC,DA(1)=PSADRUG D ^DIC K DA,DIC,DLAYGO 64 ...I $O(^PS(52.6,"AC",+PSADRUG,0))!($O(^PS(52.7,"AC",+PSADRUG,0))) S PSAIT(1)=PSAIT,PSAIT(2)=$P($G(^PSDRUG(+PSADRUG,0)),U),PSAIT(4)=$G(^PSDRUG(+PSADRUG,660)),PSAIT=PSADRUG D ^PSAPSI4 S PSAIT=PSAIT(1) 65 DRUGS W ! S DIR(0)="Y",DIR("A")="Add/edit drugs",DIR("B")="No" D ^DIR K DIR D:Y=1 ^PSADRUG 66 Q:'+$G(PSAOSIT) 67 IV I '$O(^PSD(58.8,PSALOC,3.5,0)) W ! S DIR(0)="Y",DIR("A")="Does the outpatient site dispense IVs to IV rooms",DIR("B")="No" D ^DIR K DIR G:Y=0 QUIT 68 S PSALEN=$L($P($G(^PS(59,+PSAOSIT,0)),"^")),PSALEN=PSALEN+16 69 IV1 W @IOF,!?((80-PSALEN)/2),$P($G(^PS(59,+PSAOSIT,0)),"^")_" Outpatient Site",!! 70 I $O(^PSD(58.8,PSALOC,3.5,0)) D 71 .W "Currently linked IV Rooms:" S PSANOW=0 72 .F S PSANOW=$O(^PSD(58.8,PSALOC,3.5,PSANOW)) Q:'PSANOW S PSANOW($P($G(^PS(59.5,PSANOW,0)),"^"))="" 73 .S PSANOW="" F S PSANOW=$O(PSANOW(PSANOW)) Q:PSANOW="" W ?27,PSANOW,! 74 S DIR(0)="SAO^L:Link;U:Unlink",DIR("A")="Link or unlink IV rooms (L/U): " D ^DIR K DIR G:$G(DIRUT) QUIT G:Y="U" UNLINK 75 W !!,"Enter the IV rooms that receive IVs from the outpatient site.",! 76 K DIC S DIC="^PS(59.5,",DIC(0)="AEQZ" 77 F D ^DIC Q:$G(DTOUT)!($G(DUOUT))!(Y<0) D 78 .S PSAIVLOC=+$O(^PSD(58.8,"AIV",+Y,0)) 79 .I PSAIVLOC,PSAIVLOC'=PSALOC W !!,"<< "_Y(0,0)_" is already linked to the "_$P($G(^PS(59,+$P($G(^PSD(58.8,PSALOC,0)),"^",10),0)),"^"),!?4,"outpatient site in the "_$P($G(^PSD(58.8,PSALOC,0)),"^")_" pharmacy location. >>",! K Y Q 80 .I PSAIVLOC,PSAIVLOC=PSALOC W !!,"<< "_Y(0,0)_" is already linked to this outpatient site. >>",! K Y Q 81 .S:$D(Y(0,0)) PSAIV(Y(0,0))=+Y 82 K DIC S PSAIV=$O(PSAIV("")) I PSAIV="" W !!,"<< No IV rooms were selected to be linked to the Outpatient site. >>",! G QUIT 83 W @IOF W !?((80-PSALEN)/2),$P($G(^PS(59,+PSAOSIT,0)),"^")_" Outpatient Site",!!,"IV rooms to be linked:" 84 S PSAIV="" F S PSAIV=$O(PSAIV(PSAIV)) Q:PSAIV="" W ?23,PSAIV,! 85 S DIR(0)="Y",DIR("A")="Should the IV rooms be linked",DIR("B")="N" D ^DIR K DIR I 'Y K PSAIV G IV1 86 S:'$D(^PSD(58.8,PSALOC,3.5,0)) ^PSD(58.8,PSALOC,3.5,0)="^58.831P^^" 87 W ! S DIC="^PSD(58.8,"_PSALOC_",3.5,",DIC(0)="ML",PSAIV="" K DD,DO 88 W !,"Linking IV rooms" 89 F S PSAIV=$O(PSAIV(PSAIV)) Q:PSAIV="" K DD,DO S (X,DINUM)=PSAIV(PSAIV),DA(1)=PSALOC D FILE^DICN W "." 90 W !,"The IV rooms were linked successfully." 91 K DIC,PSAIV,DINUM,X 92 QUIT Q 93 UNLINK ;Unlink IV Rooms 94 S DIR(0)="Y",DIR("B")="N",PSANOW="" W ! 95 F S PSANOW=$O(PSANOW(PSANOW)) Q:PSANOW="" S DIR("A")="Unlink "_PSANOW D ^DIR Q:$G(DIRUT) I Y S PSANOW(PSANOW)=Y,PSADEL(PSANOW)="" 96 S PSANOW="",PSADEL=$O(PSADEL(PSANOW)) 97 W @IOF,!?((80-PSALEN)/2),$P($G(^PS(59,+PSAOSIT,0)),"^")_" Outpatient Site",!! 98 I PSADEL'="" W !,"To be unlinked:" S PSANOW="" D 99 .F S PSANOW=$O(PSADEL(PSANOW)) Q:PSANOW="" W ?16,PSANOW,! 100 .W ! S DIR(0)="Y",DIR("B")="N",DIR("A")="Okay to unlink the IV Rooms" D ^DIR K DIR Q:$G(DIRUT) I 'Y W !,"No IV rooms were unlinked." Q 101 .W !,"Unlinking IV rooms" 102 .S PSANOW="",DIE="^PSD(58.8,"_PSALOC_",3.5,",DA(1)=PSALOC F S PSANOW=$O(PSADEL(PSANOW)) Q:PSANOW="" S DA=$O(^PS(59.5,"B",PSANOW,0)),DR=".01///@" D ^DIE W "." 103 .K DIE W !,"IV rooms unlinked." 104 Q -
WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAORDP1.m
r613 r623 1 PSAORDP1 ;BIR/JMB-Print Orders - CONT'D ;9/19/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,21,61,65,67**; 10/24/97;Build 15 3 ;This routine prints invoices. 4 ; 5 ;References to global ^DIC(51.5 are covered by IA #1931 6 ;References to global ^PSDRUG( are covered by IA #2095 7 ;References to global ^PSDRUG("C" are covered by IA #2095 8 ; 9 DQ S IOM=80 D NOW^%DTC S Y=% D DD^%DT S PSARUN=$E(Y,1,18),PSAPAGE=1,$P(PSASLN,"-",80)="",$P(PSADLN,"=",80)="",(PSADJDRG,PSAOUT)=0,PSAFPG=1 10 S PSAEND=0,PSAORDER=$P(^PSD(58.811,PSAORD,0),"^") D HEADER^PSAORDP2 11 S PSAIN=$G(^PSD(58.811,PSAORD,1,PSAINV,0)),PSAINVN=$P(PSAIN,"^"),PSASTA=$P(PSAIN,"^",3),PSADEL=+$P(PSAIN,"^",6),PSAREC=+$P(PSAIN,"^",7) 12 START W !,"PRIME VENDOR : ",$S($P($G(^PSD(58.811,PSAORD,0)),"^",2)'="":$P($G(^(0)),"^",2),1:"UNKNOWN") 13 W !!,"ORDER# : "_PSAORDER,?40,"ORDER DATE : "_$$DATE($P(PSAIN,"^",4)) 14 W !,"INVOICE#: "_PSAINVN,?40,"INVOICE DATE : "_$$DATE($P(PSAIN,"^",2)) 15 W !,"STATUS : "_$S(PSASTA="P":"PROCESSED",PSASTA="V":"VERIFIED",PSASTA="L":"LOCKED VERIFYING",PSASTA="C":"COMPLETED",1:"UNKNOWN")_$S(+$P(PSAIN,"^",13):" (SUPPLY INVOICE)",1:"") ;;<*65 RJS> 16 W ?40,"DELIVERY DATE: "_$S(PSADEL:$$DATE(PSADEL),1:"UNKNOWN") 17 W !?40,"DATE RECEIVED: "_$S(PSAREC:$$DATE(PSAREC),PSADEL:$$DATE(PSADEL),1:"UNKNOWN"),! 18 S PSADJDRG=0 S (PSAIECST,PSAAECST)=0 D LINE 19 ; 20 EXIT ;Kills 21 K %,DIR,DIRUT,PSAAECST,PSACIEN,PSADATA,PSADATE,PSADEC,PSADEL,PSADJ,PSADJD,PSADJDP,PSADJDRG,PSADJSUP,PSADJDV,PSADPDT,PSADPDUZ,PSADVDT,PSADVDUZ,PSADJO,PSADJOP,PSADJOV 22 K PSADJP,PSADJPP,PSADJPV,PSADJQ,PSADJQP,PSADJQV,PSADLN,PSADRG,PSAECOST,PSAEND,PSAFPG,PSAICOST,PSAIECST,PSAIN,PSAINVN 23 K PSALN,PSAMORE,PSANDC,PSANODE,PSAOPDT,PSAOPDUZ,PSAORDER,PSAOU,PSAOVDT,PSAOVDUZ,PSAPAGE,PSAPPDT,PSAPPDUZ,PSAPRICE 24 K PSAPVDT,PSAPVDUZ,PSAQPDT,PSAQPDUZ,PSAQPREA,PSAQVDT,PSAQVDUZ,PSAQVREA,PSAREC,PSARUN,PSAS,PSASLN,PSASS,PSASTA,PSATOT,Y 25 Q 26 ; 27 DATE(PSADATE) ;convert date 28 S %=$E(PSADATE,4,5)_"/"_$E(PSADATE,6,7)_"/"_$E(PSADATE,2,3) 29 I $TR(%,"/")="" S %="UNKNOWN" 30 Q % 31 ; 32 LINE ;print line items 33 D LINEHDR^PSAORDP2 S (PSAICOST,PSALN,PSATOT)=0 34 F S PSALN=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN)) Q:'PSALN!(PSAOUT) D Q:PSAOUT 35 .Q:'$D(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,0)) 36 .S PSADATA=^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,0) 37 .K PSADJQP,PSAQPDUZ,PSAQPDT,PSAQPREA,PSADJQV,PSAQVDUZ,PSAQVDT,PSAQVREA 38 .K PSADJOP,PSAOPDUZ,PSAOPDT,PSADJOV,PSAOVDUZ,PSAOVDT 39 .K PSADJPP,PSAPPDUZ,PSAPPDT,PSADJPV,PSAPVDUZ,PSAPVDT 40 .K PSADJDP,PSADPDUZ,PSADPDT,PSADJDV,PSADVDUZ,PSADVDT 41 .S PSADJSUP=0 42 .I $D(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)) S PSAMORE=4 D 43 ..S:+$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^") PSAMORE=5 44 ..S:+$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^",2) PSAMORE=PSAMORE+1 45 .E S PSAMORE=4 46 .I ($Y+PSAMORE)>IOSL D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2 Q:PSAOUT D HEADER^PSAORDP2,LINEHDR^PSAORDP2 47 .W !,$P(PSADATA,"^") 48 DRUG .S PSADRG=0,PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","D",0)) 49 .I $G(PSADJ) D 50 ..S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0)) 51 ..S PSADJD=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 52 ..I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")'="" D Q 53 ...W ?8,"*"_$P($G(^PSDRUG(+PSADJD,0)),"^") S PSADJDRG=1,PSADRG=PSADJD 54 ...I $P(PSANODE,"^",6)'="" S PSADJDV=$P(PSANODE,"^",6),PSADVDT=$P(PSANODE,"^",8),PSADVDUZ=$P(PSANODE,"^",9) 55 ...I $P(PSANODE,"^",2)'="" S PSADJDP=$P(PSANODE,"^",2),PSADPDT=$P(PSANODE,"^",4),PSADPDUZ=$P(PSANODE,"^",5) 56 ..I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")="" S PSADJ=0 Q 57 ..W ?7,"**"_PSADJD S PSADJSUP=1,PSADRG=0 58 ..I $P(PSANODE,"^",6)'="" S PSADJDV=$P(PSANODE,"^",6),PSADVDT=$P(PSANODE,"^",8),PSADVDUZ=$P(PSANODE,"^",9) 59 ..I $P(PSANODE,"^",2)'="" S PSADJDP=$P(PSANODE,"^",2),PSADPDT=$P(PSANODE,"^",4),PSADPDUZ=$P(PSANODE,"^",5) 60 .I '$G(PSADJ) D 61 ..S PSADRG=$S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):+$P(PSADATA,"^",2),1:0) 62 ..W ?9,$S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):$P(^PSDRUG(+$P(PSADATA,"^",2),0),"^"),1:"DRUG UNKNOWN") 63 CS .I +$P(PSADATA,"^",10) W " (CONTROLLED SUBS)" I $P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !?5,"*** INACTIVE IN MASTER VAULT ***" 64 .E I PSADRG,$P($G(^PSD(58.8,+$P(PSAIN,"^",5),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !?5,"*** INACTIVE IN PHARMACY LOCATION ***" 65 .I PSADRG,$D(^PSDRUG(+PSADRG,"I")) W !?5,"*** INACTIVE IN DRUG FILE ***" 66 .; 67 UPC .W:$P(PSADATA,"^",13)'="" !?9,"UPC: "_$P(PSADATA,"^",13) 68 NDC .S PSANDC=$P(PSADATA,"^",11) 69 .I $E(PSANDC)'="S" D PSANDC1^PSAHELP S PSANDC=PSANDCX K PSANDCX W !?9,PSANDC 70 .S PSASUB=$S(+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^",3):+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^",3),$G(PSANDC)'="":$S(+$O(^PSDRUG("C",PSANDC,+PSADRG,0)):+$O(^PSDRUG("C",PSANDC,+PSADRG,0)),1:0),1:0) 71 VSN .W ?25,$S($P(PSADATA,"^",12)'="":$P(PSADATA,"^",12),1:"VSN UNKNOWN") 72 .; 73 QTY .;No Adj. Qty 74 .S PSAIECST=PSAIECST+($P(PSADATA,"^",3)*$P(PSADATA,"^",5)) 75 .S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","P",0)) 76 .I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0)),PSAPRICE=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2)) 77 .I '$G(PSADJ) S PSAPRICE=$P(PSADATA,"^",5) 78 .S PSADJQ="",PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","Q",0)) 79 .I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0)),PSADJQ=$S($P(PSANODE,"^",6)'="":+$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 80 .;Adj. Qty 81 .I $G(PSADJQ) D 82 ..I $P(PSANODE,"^",6)'="" S PSADJQV=$P(PSANODE,"^",6),PSAQVREA=$P(PSANODE,"^",7),PSAQVDT=$P(PSANODE,"^",8),PSAQVDUZ=$P(PSANODE,"^",9) 83 ..I $P(PSANODE,"^",2)'="" S PSADJQP=$P(PSANODE,"^",2),PSAQPREA=$P(PSANODE,"^",3),PSAQPDT=$P(PSANODE,"^",4),PSAQPDUZ=$P(PSANODE,"^",5) 84 ..S PSAECOST=PSADJQ*PSAPRICE,PSAAECST=PSAAECST+PSAECOST 85 ..W ?40,$S($G(PSADJQV)'="":$J(PSADJQV,6),1:$J(PSADJQP,6))_"("_$P(PSADATA,"^",3)_")" 86 .I '$G(PSADJQ) W ?40,$J($P(PSADATA,"^",3),6) S PSAECOST=$P(PSADATA,"^",3)*PSAPRICE,PSAAECST=PSAAECST+PSAECOST 87 .; 88 OU .;Order Unit 89 .S PSAOU=$S(+$P(PSADATA,"^",4):$P($G(^DIC(51.5,+$P(PSADATA,"^",4),0)),"^"),+PSASUB&(+$P($G(^PSDRUG(PSADRG,1,+PSASUB,0)),"^",5)):$P($G(^DIC(51.5,+$P($G(^PSDRUG(PSADRG,1,+PSASUB,0)),"^",5),0)),"^"),1:"") 90 .S PSADJO="",PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","O",0)) 91 .I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0)),PSADJO=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 92 .;Adj. Order Unit 93 .I PSADJO'="" D 94 ..I $P(PSANODE,"^",6)'="" S PSADJOV=$P(PSANODE,"^",6),PSAOVDT=$P(PSANODE,"^",8),PSAOVDUZ=$P(PSANODE,"^",9) 95 ..I $P(PSANODE,"^",2)'="" S PSADJOP=$P(PSANODE,"^",2),PSAOPDT=$P(PSANODE,"^",4),PSAOPDUZ=$P(PSANODE,"^",5) 96 ..W ?53,$S(+PSADJO:$P($G(^DIC(51.5,+PSADJO,0)),"^"),1:"UNKNOWN")_" ("_$S(PSAOU'="":PSAOU,1:"")_")" 97 .I PSADJO="" W ?53,$S(PSAOU'="":PSAOU,1:"()") 98 .; 99 PRICE .;Unit price 100 .S PSADEC=$S($L($P($P(PSADATA,"^",5),".",2))>1:$L($P($P(PSADATA,"^",5),".",2)),1:2) 101 .S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","P",0)) 102 .I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0)),PSADJP=$S(+$P(PSANODE,"^",6):+$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2)) 103 .;Adj. Unit Price 104 .I $G(PSADJP) D 105 ..I +$P(PSANODE,"^",6) S PSADJPV=$P(PSANODE,"^",6),PSAPVDT=$P(PSANODE,"^",8),PSAPVDUZ=$P(PSANODE,"^",9) 106 ..I +$P(PSANODE,"^",2) S PSADJPP=$P(PSANODE,"^",2),PSAPPDT=$P(PSANODE,"^",4),PSAPPDUZ=$P(PSANODE,"^",5) 107 ..W ?60,$J(PSADJP,7,2)_" ("_$S(+$P(PSADATA,"^",5):$P(PSADATA,"^",5),$P(PSADATA,"^",5)=0:0,1:"")_")" 108 .I '$G(PSADJP) D 109 ..I +$P(PSADATA,"^",5)!($P(PSADATA,"^",5)=0) W ?60,$S(+$P(PSADATA,"^",5):$J($P(PSADATA,"^",5),7,PSADEC),1:0) Q 110 ..W ?65,"(Blank)" 111 .; 112 XCOST .;Extended cost 113 .W:PSADJP ?67,$J(PSAECOST,7,2) W:'PSADJP ?70,$J(PSAECOST,9,2) 114 .; 115 LEVELS .;DAVE B (PSA*3*3) 116 .S OU=$P($G(^PSDRUG(+PSADRG,660)),"^",2) I OU'="" S OU=$P($G(^DIC(51.5,OU,0)),"^",1) 117 .W !!,"Drug file Data - Dispense Unit: ",$P($G(^PSDRUG(+PSADRG,660)),"^",8),?40,"Order Unit : ",$G(OU) 118 .;W !,?20," Disp. Unit: ",$P($G(^PSDRUG(+PSADRG,660)),"^",8) 119 .W " DUOU: ",$P($G(^PSDRUG(+PSADRG,660)),"^",5) 120 .W !,"Invoiced ",?40,"Order Unit : ",$S($P(PSADATA,"^",4)=""!($P(PSADATA,"^",4)=0):"None Sent",1:$S($P(PSADATA,"^",4)["~":"Invalid: "_$P(PSADATA,"^",4),1:$P(^DIC(51.5,$P(PSADATA,"^",4),0),"^"))) 121 .W " DUOU: ",$S(+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^")'=0:$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^"),1:"nothing changed") 122 .K OU 123 .W:+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^",4)'=0 !?9,"STOCK LEVEL : "_$FN(+$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^",4),",") 124 .W:+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^",2)'=0 !?9,"REORDER LEVEL: "_$FN(+$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^",2),",") 125 .; 126 .;BGN 67 127 .D DISP2^PSAP67 128 .;END 67 129 .I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2 Q:PSAOUT D HEADER^PSAORDP2 D LINEHDR^PSAORDP2 130 .D ^PSAORDP2 Q:PSAOUT 131 .W ! 132 Q:PSAOUT 133 I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2 Q:PSAOUT D HEADER^PSAORDP2 134 W !,PSASLN 135 S PSADJSUP=$S($P($G(^PSD(58.811,PSAORD,1,PSAINV,0)),"^",13)=1:1,1:0) 136 I $G(PSAAECST)'=$G(PSAIECST) D 137 .W !?47,"TOTAL ADJUSTED COST",?67,$J(PSAAECST,12,2),! 138 .I +$O(^PSD(58.811,PSAORD,1,PSAINV,2,0)) D 139 ..S PSACIEN=0 F S PSACIEN=+$O(^PSD(58.811,PSAORD,1,PSAINV,2,PSACIEN)) Q:'PSACIEN D 140 ...Q:'$D(^PSD(58.811,PSAORD,1,PSAINV,2,PSACIEN,0)) 141 ...I $Y+3>IOSL D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2 Q:PSAOUT D HEADER^PSAORDP2 142 ...W:+$P(^PSD(58.811,PSAORD,1,PSAINV,2,PSACIEN,0),"^",3) ?55,"CREDIT MEMO "_$J($P(^(0),"^",3),12,2),! 143 W !?47,"TOTAL INVOICED COST",?67,$J(PSAIECST,12,2) 144 S PSAEND=1 145 I $E(IOST)'="C" D 146 .I PSADJDRG D:$Y+4>IOSL HEADER^PSAORDP2 W !!," * THE DRUG WAS MATCHED TO THE DRUG FILE.",! 147 .I PSADJSUP D:$Y+4>IOSL HEADER^PSAORDP2 W !,"** THE ITEM IS A SUPPLY ITEM.",! 148 D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2 149 W ! 150 Q 1 PSAORDP1 ;BIR/JMB-Print Orders - CONT'D ;9/19/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,21,61,65**; 10/24/97;Build 2 3 ;This routine prints invoices. 4 ; 5 ;References to global ^DIC(51.5 are covered by IA #1931 6 ;References to global ^PSDRUG( are covered by IA #2095 7 ;References to global ^PSDRUG("C" are covered by IA #2095 8 ; 9 DQ S IOM=80 D NOW^%DTC S Y=% D DD^%DT S PSARUN=$E(Y,1,18),PSAPAGE=1,$P(PSASLN,"-",80)="",$P(PSADLN,"=",80)="",(PSADJDRG,PSAOUT)=0,PSAFPG=1 10 S PSAEND=0,PSAORDER=$P(^PSD(58.811,PSAORD,0),"^") D HEADER^PSAORDP2 11 S PSAIN=$G(^PSD(58.811,PSAORD,1,PSAINV,0)),PSAINVN=$P(PSAIN,"^"),PSASTA=$P(PSAIN,"^",3),PSADEL=+$P(PSAIN,"^",6),PSAREC=+$P(PSAIN,"^",7) 12 START W !,"PRIME VENDOR : ",$S($P($G(^PSD(58.811,PSAORD,0)),"^",2)'="":$P($G(^(0)),"^",2),1:"UNKNOWN") 13 W !!,"ORDER# : "_PSAORDER,?40,"ORDER DATE : "_$$DATE($P(PSAIN,"^",4)) 14 W !,"INVOICE#: "_PSAINVN,?40,"INVOICE DATE : "_$$DATE($P(PSAIN,"^",2)) 15 W !,"STATUS : "_$S(PSASTA="P":"PROCESSED",PSASTA="V":"VERIFIED",PSASTA="L":"LOCKED VERIFYING",PSASTA="C":"COMPLETED",1:"UNKNOWN")_$S(+$P(PSAIN,"^",13):" (SUPPLY INVOICE)",1:"") ;;<*65 RJS> 16 W ?40,"DELIVERY DATE: "_$S(PSADEL:$$DATE(PSADEL),1:"UNKNOWN") 17 W !?40,"DATE RECEIVED: "_$S(PSAREC:$$DATE(PSAREC),PSADEL:$$DATE(PSADEL),1:"UNKNOWN"),! 18 S PSADJDRG=0 S (PSAIECST,PSAAECST)=0 D LINE 19 ; 20 EXIT ;Kills 21 K %,DIR,DIRUT,PSAAECST,PSACIEN,PSADATA,PSADATE,PSADEC,PSADEL,PSADJ,PSADJD,PSADJDP,PSADJDRG,PSADJSUP,PSADJDV,PSADPDT,PSADPDUZ,PSADVDT,PSADVDUZ,PSADJO,PSADJOP,PSADJOV 22 K PSADJP,PSADJPP,PSADJPV,PSADJQ,PSADJQP,PSADJQV,PSADLN,PSADRG,PSAECOST,PSAEND,PSAFPG,PSAICOST,PSAIECST,PSAIN,PSAINVN 23 K PSALN,PSAMORE,PSANDC,PSANODE,PSAOPDT,PSAOPDUZ,PSAORDER,PSAOU,PSAOVDT,PSAOVDUZ,PSAPAGE,PSAPPDT,PSAPPDUZ,PSAPRICE 24 K PSAPVDT,PSAPVDUZ,PSAQPDT,PSAQPDUZ,PSAQPREA,PSAQVDT,PSAQVDUZ,PSAQVREA,PSAREC,PSARUN,PSAS,PSASLN,PSASS,PSASTA,PSATOT,Y 25 Q 26 ; 27 DATE(PSADATE) ;convert date 28 S %=$E(PSADATE,4,5)_"/"_$E(PSADATE,6,7)_"/"_$E(PSADATE,2,3) 29 I $TR(%,"/")="" S %="UNKNOWN" 30 Q % 31 ; 32 LINE ;print line items 33 D LINEHDR^PSAORDP2 S (PSAICOST,PSALN,PSATOT)=0 34 F S PSALN=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN)) Q:'PSALN!(PSAOUT) D Q:PSAOUT 35 .Q:'$D(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,0)) 36 .S PSADATA=^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,0) 37 .K PSADJQP,PSAQPDUZ,PSAQPDT,PSAQPREA,PSADJQV,PSAQVDUZ,PSAQVDT,PSAQVREA 38 .K PSADJOP,PSAOPDUZ,PSAOPDT,PSADJOV,PSAOVDUZ,PSAOVDT 39 .K PSADJPP,PSAPPDUZ,PSAPPDT,PSADJPV,PSAPVDUZ,PSAPVDT 40 .K PSADJDP,PSADPDUZ,PSADPDT,PSADJDV,PSADVDUZ,PSADVDT 41 .S PSADJSUP=0 42 .I $D(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)) S PSAMORE=4 D 43 ..S:+$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^") PSAMORE=5 44 ..S:+$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^",2) PSAMORE=PSAMORE+1 45 .E S PSAMORE=4 46 .I ($Y+PSAMORE)>IOSL D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2 Q:PSAOUT D HEADER^PSAORDP2,LINEHDR^PSAORDP2 47 .W !,$P(PSADATA,"^") 48 DRUG .S PSADRG=0,PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","D",0)) 49 .I $G(PSADJ) D 50 ..S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0)) 51 ..S PSADJD=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 52 ..I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")'="" D Q 53 ...W ?8,"*"_$P($G(^PSDRUG(+PSADJD,0)),"^") S PSADJDRG=1,PSADRG=PSADJD 54 ...I $P(PSANODE,"^",6)'="" S PSADJDV=$P(PSANODE,"^",6),PSADVDT=$P(PSANODE,"^",8),PSADVDUZ=$P(PSANODE,"^",9) 55 ...I $P(PSANODE,"^",2)'="" S PSADJDP=$P(PSANODE,"^",2),PSADPDT=$P(PSANODE,"^",4),PSADPDUZ=$P(PSANODE,"^",5) 56 ..I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")="" S PSADJ=0 Q 57 ..W ?7,"**"_PSADJD S PSADJSUP=1,PSADRG=0 58 ..I $P(PSANODE,"^",6)'="" S PSADJDV=$P(PSANODE,"^",6),PSADVDT=$P(PSANODE,"^",8),PSADVDUZ=$P(PSANODE,"^",9) 59 ..I $P(PSANODE,"^",2)'="" S PSADJDP=$P(PSANODE,"^",2),PSADPDT=$P(PSANODE,"^",4),PSADPDUZ=$P(PSANODE,"^",5) 60 .I '$G(PSADJ) D 61 ..S PSADRG=$S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):+$P(PSADATA,"^",2),1:0) 62 ..W ?9,$S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):$P(^PSDRUG(+$P(PSADATA,"^",2),0),"^"),1:"DRUG UNKNOWN") 63 CS .I +$P(PSADATA,"^",10) W " (CONTROLLED SUBS)" I $P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !?5,"*** INACTIVE IN MASTER VAULT ***" 64 .E I PSADRG,$P($G(^PSD(58.8,+$P(PSAIN,"^",5),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !?5,"*** INACTIVE IN PHARMACY LOCATION ***" 65 .I PSADRG,$D(^PSDRUG(+PSADRG,"I")) W !?5,"*** INACTIVE IN DRUG FILE ***" 66 .; 67 UPC .W:$P(PSADATA,"^",13)'="" !?9,"UPC: "_$P(PSADATA,"^",13) 68 NDC .S PSANDC=$P(PSADATA,"^",11) 69 .I $E(PSANDC)'="S" D PSANDC1^PSAHELP S PSANDC=PSANDCX K PSANDCX W !?9,PSANDC 70 .S PSASUB=$S(+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^",3):+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^",3),$G(PSANDC)'="":$S(+$O(^PSDRUG("C",PSANDC,+PSADRG,0)):+$O(^PSDRUG("C",PSANDC,+PSADRG,0)),1:0),1:0) 71 VSN .W ?25,$S($P(PSADATA,"^",12)'="":$P(PSADATA,"^",12),1:"VSN UNKNOWN") 72 .; 73 QTY .;No Adj. Qty 74 .S PSAIECST=PSAIECST+($P(PSADATA,"^",3)*$P(PSADATA,"^",5)) 75 .S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","P",0)) 76 .I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0)),PSAPRICE=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2)) 77 .I '$G(PSADJ) S PSAPRICE=$P(PSADATA,"^",5) 78 .S PSADJQ="",PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","Q",0)) 79 .I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0)),PSADJQ=$S($P(PSANODE,"^",6)'="":+$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 80 .;Adj. Qty 81 .I $G(PSADJQ) D 82 ..I $P(PSANODE,"^",6)'="" S PSADJQV=$P(PSANODE,"^",6),PSAQVREA=$P(PSANODE,"^",7),PSAQVDT=$P(PSANODE,"^",8),PSAQVDUZ=$P(PSANODE,"^",9) 83 ..I $P(PSANODE,"^",2)'="" S PSADJQP=$P(PSANODE,"^",2),PSAQPREA=$P(PSANODE,"^",3),PSAQPDT=$P(PSANODE,"^",4),PSAQPDUZ=$P(PSANODE,"^",5) 84 ..S PSAECOST=PSADJQ*PSAPRICE,PSAAECST=PSAAECST+PSAECOST 85 ..W ?40,$S($G(PSADJQV)'="":$J(PSADJQV,6),1:$J(PSADJQP,6))_"("_$P(PSADATA,"^",3)_")" 86 .I '$G(PSADJQ) W ?40,$J($P(PSADATA,"^",3),6) S PSAECOST=$P(PSADATA,"^",3)*PSAPRICE,PSAAECST=PSAAECST+PSAECOST 87 .; 88 OU .;Order Unit 89 .S PSAOU=$S(+$P(PSADATA,"^",4):$P($G(^DIC(51.5,+$P(PSADATA,"^",4),0)),"^"),+PSASUB&(+$P($G(^PSDRUG(PSADRG,1,+PSASUB,0)),"^",5)):$P($G(^DIC(51.5,+$P($G(^PSDRUG(PSADRG,1,+PSASUB,0)),"^",5),0)),"^"),1:"") 90 .S PSADJO="",PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","O",0)) 91 .I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0)),PSADJO=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 92 .;Adj. Order Unit 93 .I PSADJO'="" D 94 ..I $P(PSANODE,"^",6)'="" S PSADJOV=$P(PSANODE,"^",6),PSAOVDT=$P(PSANODE,"^",8),PSAOVDUZ=$P(PSANODE,"^",9) 95 ..I $P(PSANODE,"^",2)'="" S PSADJOP=$P(PSANODE,"^",2),PSAOPDT=$P(PSANODE,"^",4),PSAOPDUZ=$P(PSANODE,"^",5) 96 ..W ?53,$S(+PSADJO:$P($G(^DIC(51.5,+PSADJO,0)),"^"),1:"UNKNOWN")_" ("_$S(PSAOU'="":PSAOU,1:"")_")" 97 .I PSADJO="" W ?53,$S(PSAOU'="":PSAOU,1:"()") 98 .; 99 PRICE .;Unit price 100 .S PSADEC=$S($L($P($P(PSADATA,"^",5),".",2))>1:$L($P($P(PSADATA,"^",5),".",2)),1:2) 101 .S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","P",0)) 102 .I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0)),PSADJP=$S(+$P(PSANODE,"^",6):+$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2)) 103 .;Adj. Unit Price 104 .I $G(PSADJP) D 105 ..I +$P(PSANODE,"^",6) S PSADJPV=$P(PSANODE,"^",6),PSAPVDT=$P(PSANODE,"^",8),PSAPVDUZ=$P(PSANODE,"^",9) 106 ..I +$P(PSANODE,"^",2) S PSADJPP=$P(PSANODE,"^",2),PSAPPDT=$P(PSANODE,"^",4),PSAPPDUZ=$P(PSANODE,"^",5) 107 ..W ?60,$J(PSADJP,7,2)_" ("_$S(+$P(PSADATA,"^",5):$P(PSADATA,"^",5),$P(PSADATA,"^",5)=0:0,1:"")_")" 108 .I '$G(PSADJP) D 109 ..I +$P(PSADATA,"^",5)!($P(PSADATA,"^",5)=0) W ?60,$S(+$P(PSADATA,"^",5):$J($P(PSADATA,"^",5),7,PSADEC),1:0) Q 110 ..W ?65,"(Blank)" 111 .; 112 XCOST .;Extended cost 113 .W:PSADJP ?67,$J(PSAECOST,7,2) W:'PSADJP ?70,$J(PSAECOST,9,2) 114 .; 115 LEVELS .;DAVE B (PSA*3*3) 116 .S OU=$P($G(^PSDRUG(+PSADRG,660)),"^",2) I OU'="" S OU=$P($G(^DIC(51.5,OU,0)),"^",1) 117 .W !!,"Drug file Data - Dispense Unit: ",$P($G(^PSDRUG(+PSADRG,660)),"^",8),?40,"Order Unit : ",$G(OU) 118 .;W !,?20," Disp. Unit: ",$P($G(^PSDRUG(+PSADRG,660)),"^",8) 119 .W " DUOU: ",$P($G(^PSDRUG(+PSADRG,660)),"^",5) 120 .W !,"Invoiced ",?40,"Order Unit : ",$S($P(PSADATA,"^",4)=""!($P(PSADATA,"^",4)=0):"None Sent",1:$S($P(PSADATA,"^",4)["~":"Invalid: "_$P(PSADATA,"^",4),1:$P(^DIC(51.5,$P(PSADATA,"^",4),0),"^"))) 121 .W " DUOU: ",$S(+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^")'=0:$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^"),1:"nothing changed") 122 .K OU 123 .W:+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^",4)'=0 !?9,"STOCK LEVEL : "_$FN(+$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^",4),",") 124 .W:+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^",2)'=0 !?9,"REORDER LEVEL: "_$FN(+$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^",2),",") 125 .; 126 .I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2 Q:PSAOUT D HEADER^PSAORDP2 D LINEHDR^PSAORDP2 127 .D ^PSAORDP2 Q:PSAOUT 128 .W ! 129 Q:PSAOUT 130 I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2 Q:PSAOUT D HEADER^PSAORDP2 131 W !,PSASLN 132 S PSADJSUP=$S($P($G(^PSD(58.811,PSAORD,1,PSAINV,0)),"^",13)=1:1,1:0) 133 I $G(PSAAECST)'=$G(PSAIECST) D 134 .W !?47,"TOTAL ADJUSTED COST",?67,$J(PSAAECST,12,2),! 135 .I +$O(^PSD(58.811,PSAORD,1,PSAINV,2,0)) D 136 ..S PSACIEN=0 F S PSACIEN=+$O(^PSD(58.811,PSAORD,1,PSAINV,2,PSACIEN)) Q:'PSACIEN D 137 ...Q:'$D(^PSD(58.811,PSAORD,1,PSAINV,2,PSACIEN,0)) 138 ...I $Y+3>IOSL D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2 Q:PSAOUT D HEADER^PSAORDP2 139 ...W:+$P(^PSD(58.811,PSAORD,1,PSAINV,2,PSACIEN,0),"^",3) ?55,"CREDIT MEMO "_$J($P(^(0),"^",3),12,2),! 140 W !?47,"TOTAL INVOICED COST",?67,$J(PSAIECST,12,2) 141 S PSAEND=1 142 I $E(IOST)'="C" D 143 .I PSADJDRG D:$Y+4>IOSL HEADER^PSAORDP2 W !!," * THE DRUG WAS MATCHED TO THE DRUG FILE.",! 144 .I PSADJSUP D:$Y+4>IOSL HEADER^PSAORDP2 W !,"** THE ITEM IS A SUPPLY ITEM.",! 145 D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2 146 W ! 147 Q -
WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAPROC4.m
r613 r623 1 PSAPROC4 ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;7/23/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21,63**; 10/24/97;Build 10 3 ;References to ^PSDRUG( are covered by IA #2095 4 ;References to ^DIC(51.5 are covered by IA #1931 5 ;This routine allows the user to edit invoices with errors or missing 6 ;data. 7 ; 8 MANYNDCS ;List drug synonym data & ask user which on to use 9 K PSADIFF,PSASAME S (PSACNT,PSAFND,PSAIEN50)=0,PSANDC=$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4),"~") 10 F S PSAIEN50=$O(^PSDRUG("C",PSANDC,PSAIEN50)) Q:'PSAIEN50 S PSASYN=0 D 11 .F S PSASYN=$O(^PSDRUG("C",PSANDC,PSAIEN50,PSASYN)) Q:'PSASYN D 12 ..Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0)) 13 ..;DAVE B (PSA*3*3) 14 ..Q:$D(^PSDRUG(PSAIEN50,"I")) 15 ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)=PSAVSN S PSAFND=PSAFND+1,PSASAME(PSAFND)=PSAIEN50_"^"_PSASYN 16 ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)'=PSAVSN S PSACNT=PSACNT+1,PSADIFF(PSACNT)=PSAIEN50_"^"_PSASYN 17 G:PSAFND SAME G:PSACNT DIFF 18 Q 19 ; 20 SAME ;If more than one drug with same VSN, assign to correct drug. 21 W !,"There is more than one item in the DRUG file",!,"with the same NDC and Vendor Stock Number.",! 22 S (PSACNT,PSAMENU)=0 F S PSACNT=$O(PSASAME(PSACNT)) Q:'PSACNT D 23 .S PSAIEN50=$P(PSASAME(PSACNT),"^"),PSASYN=$P(PSASAME(PSACNT),"^",2),PSANODE=^PSDRUG(PSAIEN50,1,PSASYN,0) S PSAMENU=PSAMENU+1 24 .Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0)) 25 .D LIST Q:PSAOUT 26 D CHOOSE Q:PSAOUT!(Y="") 27 I PSAPICK=PSAMENU D ASKDRUG^PSANDF G KILL 28 I PSAPICK<PSAMENU D 29 .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC,$P(^(PSALINE),"^",7)=$P(PSASAME(PSAPICK),"^",2),$P(^(PSALINE),"^",5)=$P($P(^(PSALINE),"^",5),"~"),PSANEXT=1,PSADATA=^(PSALINE) 30 .I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$P(PSASAME(PSAPICK),"^") D 31 ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$P(PSASAME(PSAPICK),"^"),$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSANEXT=1,PSADATA=^(PSALINE) 32 ..I $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP" S $P(^("IN"),"^",13)="",PSAIN=^XTMP("PSAPV",PSACTRL,"IN") 33 ..D HDR^PSAPROC6,EDIT1^PSAUTL1 34 G KILL 35 ; 36 DIFF ;If more than one drug with different VSN, assign to correct drug. 37 W !,"There is more than one item in the DRUG file with the same NDC.",! 38 S (PSACNT,PSAMENU)=0 F S PSACNT=$O(PSADIFF(PSACNT)) Q:'PSACNT D 39 .S PSAIEN50=$P(PSADIFF(PSACNT),"^"),PSASYN=$P(PSADIFF(PSACNT),"^",2),PSANODE=^PSDRUG(PSAIEN50,1,PSASYN,0),PSAMENU=PSAMENU+1 40 .Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0)) 41 .D LIST Q:PSAOUT 42 D CHOOSE Q:PSAOUT!(Y="") 43 I PSAPICK=PSAMENU D ASKDRUG^PSANDF G KILL 44 I PSAPICK<PSAMENU D 45 .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC,$P(^(PSALINE),"^",7)=$P(PSADIFF(PSAPICK),"^",2),PSANEXT=1,PSADATA=^(PSALINE) 46 .I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$P(PSADIFF(PSAPICK),"^") D 47 ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$P(PSADIFF(PSAPICK),"^"),$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSANEXT=1,PSADATA=^(PSALINE) 48 ..I $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP" S $P(^("IN"),"^",13)="",PSAIN=^XTMP("PSAPV",PSACTRL,"IN") 49 ..D HDR^PSAPROC6,EDIT1^PSAUTL1 50 KILL K PSASAME,PSAFND 51 Q 52 ; 53 LIST Q:PSANODE=""!($P($G(^PSDRUG(PSAIEN50,0)),"^")="") 54 ;3*63 RJS 55 N PSAPPOU,PSADUOU,PSAPPDU,PSAVEND,PSAOU,PSACPPDU,X,PSANDC,PSADU,PSASYNM,PSAVSN 56 S X=PSANODE 57 S PSASYNM=$P(X,U,1),PSANDC=$P(X,U,2),PSAVSN=$P(X,U,4),PSAOU=+$P(X,U,5),PSAPPOU=$P(X,U,6) 58 S PSADUOU=$P(X,U,7),PSAPPDU=$P(X,U,8),PSAVEND=$P(X,U,9) 59 S PSADU=$$GET1^DIQ(50,PSAIEN50,14.5),PSAOU=$P($G(^DIC(51.5,PSAOU,0)),"^") 60 S PSACPPDU=$S('PSADUOU:"BLANK",1:(PSAPPOU*1000/PSADUOU\1/1000)) ;recalculate PPDU, file doesn't reset PPDU 61 W !?1,PSAMENU_".",?4,$P($G(^PSDRUG(PSAIEN50,0)),"^") I $D(^PSDRUG(PSAIEN50,"I")) W ?60,"(INACTIVE)" 62 I PSANDC="",PSAVSN="" W !,?19,"SYN #",PSASYN,": ",PSASYNM,! Q 63 W !,?4,"NDC: ",PSANDC,?25,"Order Unit: ",PSAOU,?46,"Price Per Order Unit: $",$FN(PSAPPOU,",",2) 64 W !,?4,"VSN: ",PSAVSN,?19,"SYN #",PSASYN,": ",PSASYNM,?42,"Dose Unit Per Order Unit: ",PSADUOU 65 W !,?4,"Vendor: ",PSAVEND,?47,"Price Per Dose Unit: ",$FN(PSACPPDU,","),! 66 ;3*63 end 67 Q 68 ; 69 CHOOSE S PSAMENU=PSAMENU+1 70 W !?1,PSAMENU,".",?4,"Select another drug." 71 W ! S DIR(0)="N^1:"_PSAMENU,DIR("A")="Select the invoiced drug",DIR("?")="Select the drug from the list for which you were invoiced.",DIR("??")="^D NDCHELP^PSAPROC4" 72 D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q 73 S PSAPICK=+Y 74 Q 75 ; 76 MANYVSNS ;List drug synonym data & ask user which on to use 77 K PSADIFF,PSASAME S (PSACNT,PSAFND,PSAIEN50)=0,PSAVSN=$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5),"~") 78 F S PSAIEN50=$O(^PSDRUG("AVSN",PSAVSN,PSAIEN50)) Q:'PSAIEN50 S PSASYN=0 D 79 .F S PSASYN=$O(^PSDRUG("AVSN",PSAVSN,PSAIEN50,PSASYN)) Q:'PSASYN D 80 ..Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0)) 81 ..;DAVE B (PSA*3*3) 82 ..Q:$D(^PSDRUG(PSAIEN50,"I")) 83 ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^")=PSANDC S PSAFND=PSAFND+1,PSASAME(PSAFND)=PSAIEN50_"^"_PSASYN 84 ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^")'=PSANDC S PSACNT=PSACNT+1,PSADIFF(PSACNT)=PSAIEN50_"^"_PSASYN 85 G:PSAFND SAMEV G:PSACNT DIFFV 86 Q 87 ; 88 SAMEV ;If more than one drug with same NDC, assign to correct drug. 89 W !,"There is more than one item in the DRUG file",!,"with the same NDC and Vendor Stock Number.",! 90 S (PSACNT,PSAMENU)=0 F S PSACNT=$O(PSASAME(PSACNT)) Q:'PSACNT D 91 .S PSAIEN50=$P(PSASAME(PSACNT),"^"),PSASYN=$P(PSASAME(PSACNT),"^",2),PSANODE=^PSDRUG(PSAIEN50,1,PSASYN,0),PSAMENU=PSAMENU+1 92 .Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0)) 93 .D LIST Q:PSAOUT 94 D CHOOSE Q:PSAOUT!(Y="") 95 I PSAPICK=PSAMENU D ASKDRUG^PSANDF G KILL 96 I PSAPICK<PSAMENU D 97 .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN,$P(^(PSALINE),"^",7)=$P(PSASAME(PSAPICK),"^",2),PSANEXT=1,PSADATA=^(PSALINE) 98 .I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$P(PSASAME(PSAPICK),"^") D 99 ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$P(PSASAME(PSAPICK),"^"),$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSANEXT=1,PSADATA=^(PSALINE) 100 ..I $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP" S $P(^("IN"),"^",13)="",PSAIN=^XTMP("PSAPV",PSACTRL,"IN") 101 ..D HDR^PSAPROC6,EDIT1^PSAUTL1 102 G KILL 103 ; 104 DIFFV ;If more than one drug with different VSN, assign to correct drug. 105 W !,"There is more than one item in the DRUG file with the same VSN.",! 106 S (PSACNT,PSAMENU)=0 F S PSACNT=$O(PSADIFF(PSACNT)) Q:'PSACNT D 107 .S PSAIEN50=$P(PSADIFF(PSACNT),"^"),PSASYN=$P(PSADIFF(PSACNT),"^",2),PSANODE=$G(^PSDRUG(PSAIEN50,1,PSASYN,0)),PSAMENU=PSAMENU+1 108 .Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0)) 109 .D LIST Q:PSAOUT 110 D CHOOSE Q:PSAOUT!(Y="") 111 I PSAPICK=PSAMENU D ASKDRUG^PSANDF G KILL 112 I PSAPICK<PSAMENU D 113 .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN,$P(^(PSALINE),"^",7)=$P(PSADIFF(PSAPICK),"^",2),PSANEXT=1 114 .I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$P(PSADIFF(PSAPICK),"^") D 115 ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$P(PSADIFF(PSAPICK),"^"),$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSADATA=^(PSALINE) 116 ..S PSANDC=$P($G(^PSDRUG(+$P(PSADIFF(PSAPICK),"^"),1,+$P(PSADIFF(PSAPICK),"^",2),0)),"^"),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC 117 ..I $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP" S $P(^("IN"),"^",13)="",PSAIN=^XTMP("PSAPV",PSACTRL,"IN") 118 ..D HDR^PSAPROC6,EDIT1^PSAUTL1 119 G KILL 120 ; 121 NDCHELP ;Extended help for selecting invoiced drug 122 W !?5,"Enter the number to the left of the invoiced drug. If you select a drug",!?5,"from the list, the invoiced drug will be matched to that drug. If you" 123 W !?5,"choose to select another drug, you can select the invoiced drug from the",!?5,"DRUG file or flag this item as a supply item." 124 Q 1 PSAPROC4 ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;7/23/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21**; 10/24/97 3 ;References to ^PSDRUG( are covered by IA #2095 4 ;References to ^DIC(51.5 are covered by IA #1931 5 ;This routine allows the user to edit invoices with errors or missing 6 ;data. 7 ; 8 MANYNDCS ;List drug synonym data & ask user which on to use 9 K PSADIFF,PSASAME S (PSACNT,PSAFND,PSAIEN50)=0,PSANDC=$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4),"~") 10 F S PSAIEN50=$O(^PSDRUG("C",PSANDC,PSAIEN50)) Q:'PSAIEN50 S PSASYN=0 D 11 .F S PSASYN=$O(^PSDRUG("C",PSANDC,PSAIEN50,PSASYN)) Q:'PSASYN D 12 ..Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0)) 13 ..;DAVE B (PSA*3*3) 14 ..Q:$D(^PSDRUG(PSAIEN50,"I")) 15 ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)=PSAVSN S PSAFND=PSAFND+1,PSASAME(PSAFND)=PSAIEN50_"^"_PSASYN 16 ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)'=PSAVSN S PSACNT=PSACNT+1,PSADIFF(PSACNT)=PSAIEN50_"^"_PSASYN 17 G:PSAFND SAME G:PSACNT DIFF 18 Q 19 ; 20 SAME ;If more than one drug with same VSN, assign to correct drug. 21 W !,"There is more than one item in the DRUG file",!,"with the same NDC and Vendor Stock Number.",! 22 S (PSACNT,PSAMENU)=0 F S PSACNT=$O(PSASAME(PSACNT)) Q:'PSACNT D 23 .S PSAIEN50=$P(PSASAME(PSACNT),"^"),PSASYN=$P(PSASAME(PSACNT),"^",2),PSANODE=^PSDRUG(PSAIEN50,1,PSASYN,0) S PSAMENU=PSAMENU+1 24 .Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0)) 25 .D LIST Q:PSAOUT 26 D CHOOSE Q:PSAOUT!(Y="") 27 I PSAPICK=PSAMENU D ASKDRUG^PSANDF G KILL 28 I PSAPICK<PSAMENU D 29 .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC,$P(^(PSALINE),"^",7)=$P(PSASAME(PSAPICK),"^",2),$P(^(PSALINE),"^",5)=$P($P(^(PSALINE),"^",5),"~"),PSANEXT=1,PSADATA=^(PSALINE) 30 .I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$P(PSASAME(PSAPICK),"^") D 31 ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$P(PSASAME(PSAPICK),"^"),$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSANEXT=1,PSADATA=^(PSALINE) 32 ..I $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP" S $P(^("IN"),"^",13)="",PSAIN=^XTMP("PSAPV",PSACTRL,"IN") 33 ..D HDR^PSAPROC6,EDIT1^PSAUTL1 34 G KILL 35 ; 36 DIFF ;If more than one drug with different VSN, assign to correct drug. 37 W !,"There is more than one item in the DRUG file with the same NDC.",! 38 S (PSACNT,PSAMENU)=0 F S PSACNT=$O(PSADIFF(PSACNT)) Q:'PSACNT D 39 .S PSAIEN50=$P(PSADIFF(PSACNT),"^"),PSASYN=$P(PSADIFF(PSACNT),"^",2),PSANODE=^PSDRUG(PSAIEN50,1,PSASYN,0),PSAMENU=PSAMENU+1 40 .Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0)) 41 .D LIST Q:PSAOUT 42 D CHOOSE Q:PSAOUT!(Y="") 43 I PSAPICK=PSAMENU D ASKDRUG^PSANDF G KILL 44 I PSAPICK<PSAMENU D 45 .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC,$P(^(PSALINE),"^",7)=$P(PSADIFF(PSAPICK),"^",2),PSANEXT=1,PSADATA=^(PSALINE) 46 .I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$P(PSADIFF(PSAPICK),"^") D 47 ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$P(PSADIFF(PSAPICK),"^"),$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSANEXT=1,PSADATA=^(PSALINE) 48 ..I $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP" S $P(^("IN"),"^",13)="",PSAIN=^XTMP("PSAPV",PSACTRL,"IN") 49 ..D HDR^PSAPROC6,EDIT1^PSAUTL1 50 KILL K PSASAME,PSAFND 51 Q 52 ; 53 LIST Q:PSANODE=""!($P($G(^PSDRUG(PSAIEN50,0)),"^")="") 54 W !?1,PSAMENU_".",?4,$P($G(^PSDRUG(PSAIEN50,0)),"^") I $D(^PSDRUG(PSAIEN50,"I")) W ?60,"(INACTIVE)" 55 ;NOIS CTX-1200-71091 (PSA*3*21 Dave B) 56 I $P(PSANODE,"^",2)'="" W !,?4,"NDC : "_$P(PSANODE,"^",2) 57 I +$P(PSANODE,"^",5),$P($G(^DIC(51.5,+$P(PSANODE,"^",5),0)),"^")'="" W !?4,"Order Unit: "_$P(^DIC(51.5,+$P(PSANODE,"^",5),0),"^"),?45,"Price Per Order Unit : $"_$S(+$P(PSANODE,"^",6):$P(PSANODE,"^",6),1:"(Blank)") 58 E I +$P(PSANODE,"^",6) W !?4,"Price Per Order Unit: $"_$P(PSANODE,"^",6) 59 I $P(PSANODE,"^",9)'="" W !?4,"Vendor: "_$P(PSANODE,"^",9),?45,"VSN: "_$S($P(PSANODE,"^",4)'="":$P(PSANODE,"^",4),1:"(Blank)") 60 E I $P(PSANODE,"^",4)'="" W !?4,"VSN: "_$S($P(PSANODE,"^",4)'="":$P(PSANODE,"^",4),1:"(Blank)") 61 Q 62 ; 63 CHOOSE S PSAMENU=PSAMENU+1 64 W !?1,PSAMENU,".",?4,"Select another drug." 65 W ! S DIR(0)="N^1:"_PSAMENU,DIR("A")="Select the invoiced drug",DIR("?")="Select the drug from the list for which you were invoiced.",DIR("??")="^D NDCHELP^PSAPROC4" 66 D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q 67 S PSAPICK=+Y 68 Q 69 ; 70 MANYVSNS ;List drug synonym data & ask user which on to use 71 K PSADIFF,PSASAME S (PSACNT,PSAFND,PSAIEN50)=0,PSAVSN=$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5),"~") 72 F S PSAIEN50=$O(^PSDRUG("AVSN",PSAVSN,PSAIEN50)) Q:'PSAIEN50 S PSASYN=0 D 73 .F S PSASYN=$O(^PSDRUG("AVSN",PSAVSN,PSAIEN50,PSASYN)) Q:'PSASYN D 74 ..Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0)) 75 ..;DAVE B (PSA*3*3) 76 ..Q:$D(^PSDRUG(PSAIEN50,"I")) 77 ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^")=PSANDC S PSAFND=PSAFND+1,PSASAME(PSAFND)=PSAIEN50_"^"_PSASYN 78 ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^")'=PSANDC S PSACNT=PSACNT+1,PSADIFF(PSACNT)=PSAIEN50_"^"_PSASYN 79 G:PSAFND SAMEV G:PSACNT DIFFV 80 Q 81 ; 82 SAMEV ;If more than one drug with same NDC, assign to correct drug. 83 W !,"There is more than one item in the DRUG file",!,"with the same NDC and Vendor Stock Number.",! 84 S (PSACNT,PSAMENU)=0 F S PSACNT=$O(PSASAME(PSACNT)) Q:'PSACNT D 85 .S PSAIEN50=$P(PSASAME(PSACNT),"^"),PSASYN=$P(PSASAME(PSACNT),"^",2),PSANODE=^PSDRUG(PSAIEN50,1,PSASYN,0),PSAMENU=PSAMENU+1 86 .Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0)) 87 .D LIST Q:PSAOUT 88 D CHOOSE Q:PSAOUT!(Y="") 89 I PSAPICK=PSAMENU D ASKDRUG^PSANDF G KILL 90 I PSAPICK<PSAMENU D 91 .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN,$P(^(PSALINE),"^",7)=$P(PSASAME(PSAPICK),"^",2),PSANEXT=1,PSADATA=^(PSALINE) 92 .I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$P(PSASAME(PSAPICK),"^") D 93 ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$P(PSASAME(PSAPICK),"^"),$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSANEXT=1,PSADATA=^(PSALINE) 94 ..I $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP" S $P(^("IN"),"^",13)="",PSAIN=^XTMP("PSAPV",PSACTRL,"IN") 95 ..D HDR^PSAPROC6,EDIT1^PSAUTL1 96 G KILL 97 ; 98 DIFFV ;If more than one drug with different VSN, assign to correct drug. 99 W !,"There is more than one item in the DRUG file with the same VSN.",! 100 S (PSACNT,PSAMENU)=0 F S PSACNT=$O(PSADIFF(PSACNT)) Q:'PSACNT D 101 .S PSAIEN50=$P(PSADIFF(PSACNT),"^"),PSASYN=$P(PSADIFF(PSACNT),"^",2),PSANODE=$G(^PSDRUG(PSAIEN50,1,PSASYN,0)),PSAMENU=PSAMENU+1 102 .Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0)) 103 .D LIST Q:PSAOUT 104 D CHOOSE Q:PSAOUT!(Y="") 105 I PSAPICK=PSAMENU D ASKDRUG^PSANDF G KILL 106 I PSAPICK<PSAMENU D 107 .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN,$P(^(PSALINE),"^",7)=$P(PSADIFF(PSAPICK),"^",2),PSANEXT=1 108 .I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$P(PSADIFF(PSAPICK),"^") D 109 ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$P(PSADIFF(PSAPICK),"^"),$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSADATA=^(PSALINE) 110 ..S PSANDC=$P($G(^PSDRUG(+$P(PSADIFF(PSAPICK),"^"),1,+$P(PSADIFF(PSAPICK),"^",2),0)),"^"),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC 111 ..I $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP" S $P(^("IN"),"^",13)="",PSAIN=^XTMP("PSAPV",PSACTRL,"IN") 112 ..D HDR^PSAPROC6,EDIT1^PSAUTL1 113 G KILL 114 ; 115 NDCHELP ;Extended help for selecting invoiced drug 116 W !?5,"Enter the number to the left of the invoiced drug. If you select a drug",!?5,"from the list, the invoiced drug will be matched to that drug. If you" 117 W !?5,"choose to select another drug, you can select the invoiced drug from the",!?5,"DRUG file or flag this item as a supply item." 118 Q -
WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAPROC7.m
r613 r623 1 PSAPROC7 ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;9/6/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,27,21,42,61,64,67**; 10/24/97;Build 15 3 ;This routine takes the data in XTMP and moves it to DA ORDERS file. 4 ;It deletes the data in XTMP after it is copies. 5 ; 6 ;References to ^PSDRUG( are covered by IA #2095 7 INVOICE ;PSA*3*21 (3JAN01) - FILE INVOICE IMMEDIATELY 8 ; 9 S PSAIN=$G(^XTMP("PSAPV",PSACTRL,"IN")) Q:PSAIN="" 10 Q:$P(PSAIN,"^",8)'="P" 11 S PSAORD=$P(PSAIN,"^",4),PSAIEN=+$O(^PSD(58.811,"B",PSAORD,0)),PSACRED=0 12 I 'PSAIEN D 13 .F L +^PSD(58.811,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 14 .;(PSA*3*24 - Dave B. Jun 2 00 - Improper DIC call) 15 .;(PSA*3*61 - add N DO. DICN will use DO if defined, we do not want to use it since DIC is defined. 16 .N DO S DIC="^PSD(58.811,",DIC(0)="L",X=PSAORD D FILE^DICN K DIC L -^PSD(58.811,0) S PSAIEN=+Y 17 F L +^PSD(58.811,PSAIEN,0):10 I Q 18 S:'$D(^PSD(58.811,PSAIEN,1,0)) DIC("P")=$P(^DD(58.811,2,0),"^",2) 19 S DA(1)=PSAIEN,DIC="^PSD(58.811,"_DA(1)_",1,",DIC(0)="L",X=$P(PSAIN,"^",2),DLAYGO=58.811 D ^DIC K DA,DLAYGO S PSAIEN1=+Y 20 S DA(1)=PSAIEN,DA=PSAIEN1,DIE=DIC K DIC 21 S PSALOCDR=$P($G(PSAIN),"^",7) 22 S PSADELDR=$P($G(PSAIN),"^",6) 23 S PSACSDR=$S($P(PSAIN,"^",10)="ALL CS":"A",$P(PSAIN,"^",9)="CS":"S",1:"N") 24 S PSARECD=$P($G(PSAIN),"^",11) 25 S PSAMV=$S(+$P(PSAIN,"^",12):$P(PSAIN,"^",12),1:"") 26 S PSASUP=$S($P(PSAIN,"^",13)="SUP":1,1:"") 27 ;DAVE B ( PSA*3*12) Invalid Concatenation of zero node 28 S ^PSD(58.811,DA(1),1,DA,0)=$P(^(0),"^")_"^"_$P(PSAIN,"^",1)_"^P^"_$P(PSAIN,"^",3)_"^"_$G(PSALOCDR)_"^"_$G(PSADELDR)_"^"_$G(PSARECD)_"^"_$G(PSACSDR)_"^^"_DUZ_"^^"_$G(PSAMV)_"^"_$G(PSASUP) 29 S DIK=DIE D IX^DIK 30 K ^TMP($J,"PSADIF"),PSADIFLC ;*42 pre verify storage for OU, DUOU, Cost, NDC changes 31 S PSALINE=0 F S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:PSALINE="" D LINE 32 D SCANDIF,MM ;*42 look for differences to drug file SEND EMAIL 33 I PSACRED K DA S DA(1)=PSAIEN,DA=PSAIEN1,DIE="^PSD(58.811,"_DA(1)_",1,",DR="10///^S X=1" D ^DIE K DIE 34 S $P(^PSD(58.811,PSAIEN,0),"^",2)=$P($G(^XTMP("PSAPV",PSACTRL,"DS")),"^") 35 L -^PSD(58.811,PSAIEN,0) 36 K ^XTMP("PSAPV",PSACTRL) 37 Q 38 ; 39 LINE ;Files line items. 40 S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE) S:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,0)) DIC("P")=$P(^DD(58.8112,5,0),"^",2) 41 ;PSA*3*31 Dave B - Check for invoice already in file 42 S DA(2)=PSAIEN,DA(1)=PSAIEN1,(DA,X)=PSALINE,DIC="^PSD(58.811,"_DA(2)_",1,"_DA(1)_",1,",DIC(0)="L",DLAYGO=58.811 D ^DIC S PSAIEN2=+Y K DA,DIC,DLAYGO 43 ; 44 ;DAVEB PSA*3*3 (5may98) 45 S PSADRG=$P($G(PSADATA),"^",6) 46 S PSASYN=$P($G(PSADATA),"^",7) 47 K PSAUNIT 48 I $G(PSASYN)'="",$G(PSADRG)'="" S PSAUNIT=+$P($G(^PSDRUG(PSADRG,1,PSASYN,0)),"^",5) 49 ; 50 ;DAVE B (PSA*3*12) Assignment of order unit didn't take into 51 ;account the adjusted order unit. 52 S PSAUNIT=$S($D(PSAUNIT):PSAUNIT,$P(PSADATA,"^",12)'="":$P(PSADATA,"^",12),+$P($P(PSADATA,"^",2),"~",2):+$P($P(PSADATA,"^",2),"~",2),1:0) 53 S PSACS=$S($P(PSADATA,"^",19)="CS":1,1:0),PSANDC=$P($P(PSADATA,"^",4),"~"),PSAVSN=$P($P(PSADATA,"^",5),"~"),PSAUPC=$P($P(PSADATA,"^",26),"~") 54 I PSANDC="",$P($P(PSADATA,"^",26),"~")'="" S PSANDC="S"_$P($P(PSADATA,"^",26),"~") 55 S DA(2)=PSAIEN,DA(1)=PSAIEN1,DA=$S($D(PSAIEN2):PSAIEN2,1:PSALINE),DIE="^PSD(58.811,"_DA(2)_",1,"_DA(1)_",1," 56 ;DaveB (4may98) hard code filing data 57 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",3)=+PSADATA 58 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",11)=PSANDC 59 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",12)=PSAVSN 60 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",13)=PSAUPC 61 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",10)=PSACS 62 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",2)=PSADRG 63 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",4)=PSAUNIT 64 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",5)=$P(PSADATA,"^",3) 65 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",6)=DT 66 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",7)=DUZ 67 ;BGN 67 68 S $P(^PSD(58.811,DA(2),1,DA(1),3,DA,0),"^",1)=$P(PSADATA,"^",28) 69 S $P(^PSD(58.811,DA(2),1,DA(1),3,DA,0),"^",2)=$P(PSADATA,"^",29) 70 S $P(^PSD(58.811,DA(2),1,DA(1),3,DA,0),"^",3)=$P(PSADATA,"^",30) 71 S $P(^PSD(58.811,DA(2),1,DA(1),3,DA,0),"^",4)=$P(PSADATA,"^",31) 72 ;END 67 73 S DIK=DIE D IX^DIK 74 ;End PSA*3*7 75 ; 76 I +$P(PSADATA,"^",15)!($D(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"))) D ADJDRUG 77 I $P(PSADATA,"^",8)'="" D QTY 78 I +$P(PSADATA,"^",12) D OU 79 I +$P(PSADATA,"^",23) D PRICE 80 ;Adds the reorder level and/or dispense units per order unit 81 I +$P(PSADATA,"^",7)!(+$P(PSADATA,"^",20))!(+$P(PSADATA,"^",21))!(+$P(PSADATA,"^",27)) D 82 .S ^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSAIEN2,2)=$P(PSADATA,"^",20)_"^"_$P(PSADATA,"^",21)_"^"_$S(+$P(PSADATA,"^",7):+$P(PSADATA,"^",7),1:0)_"^"_+$P(PSADATA,"^",27) 83 ;Bgn 67 84 I $P(PSADATA,"^",5)'="" S ^XTMP("PSAVSN",$P(PSADATA,"^",5))=$P(PSADATA,"^",28)_"^"_$P(PSADATA,"^",29)_"^"_$P(PSADATA,"^",30)_"^"_$P(PSADATA,"^",31) 85 ;End 67 86 K ^XTMP("PSAPV",PSACTRL,"IT",PSALINE) 87 Q 88 ADJDRUG ;Records adjusted drug received 89 S PSAFLD="D" 90 I +$P(PSADATA,"^",15) S PSADJ=+$P(PSADATA,"^",15),PSADUZ=+$P(PSADATA,"^",16),PSADT=+$P(PSADATA,"^",17),PSAREA="" D RECORD Q 91 I $D(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")) S PSASNODE=^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"),PSADJ=$P(PSASNODE,"^",3),PSADUZ=+$P(PSASNODE,"^"),PSADT=+$P(PSASNODE,"^",2),PSAREA="" D RECORD 92 Q 93 OU ;Records adjusted order unit 94 S PSAFLD="O",PSADJ=+$P(PSADATA,"^",12),PSADUZ=+$P(PSADATA,"^",13),PSADT=+$P(PSADATA,"^",14),PSAREA="" 95 D RECORD 96 Q 97 PRICE ;Records adjusted price per order unit 98 S PSAFLD="P",PSADJ=+$P(PSADATA,"^",23),PSADUZ=+$P(PSADATA,"^",24),PSADT=+$P(PSADATA,"^",25),PSAREA="" 99 S:PSADJ'=+$P(PSADATA,"^",3) PSACRED=1 100 D RECORD 101 Q 102 QTY ;Records adjusted quantity received. 103 S PSAFLD="Q",PSADJ=+$P(PSADATA,"^",8),PSADUZ=+$P(PSADATA,"^",9),PSADT=+$P(PSADATA,"^",10),PSAREA=$P(PSADATA,"^",11) 104 S:PSADJ'=+$P(PSADATA,"^") PSACRED=1 105 D RECORD 106 Q 107 RECORD ;Adds adjusted data to DA ORDERS file 108 K DA S DA(3)=PSAIEN,DA(2)=PSAIEN1,DA(1)=PSAIEN2,X=PSAFLD 109 S:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSAIEN2,1,0)) DIC("P")=$P(^DD(58.81125,9,0),"^",2) 110 ;PSA*3*27 (DAVE B) removed killing of DA variable on next line 111 S DIC="^PSD(58.811,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,",DIC(0)="L",DLAYGO=58.811 D ^DIC S PSAIEN3=+Y K DLAYGO 112 ; 113 ;PSA*3*3 114 ;DAVEB Hard code filing 115 S DIE=DIC,DA=PSAIEN3 116 S $P(^PSD(58.811,DA(3),1,DA(2),1,DA(1),1,DA,0),"^",2)=PSADJ 117 S $P(^PSD(58.811,DA(3),1,DA(2),1,DA(1),1,DA,0),"^",3)=$G(PSAREA) 118 S $P(^PSD(58.811,DA(3),1,DA(2),1,DA(1),1,DA,0),"^",4)=DT 119 S $P(^PSD(58.811,DA(3),1,DA(2),1,DA(1),1,DA,0),"^",5)=DUZ 120 ; 121 ;S DIE=DIC,DA=PSAIEN3,DR="1///"_PSADJ_$S(PSAREA'="":";2////^S X=PSAREA",1:"")_";3///^S X="_PSADT_";4///^S X="_PSADUZ K DIC D ^DIE 122 S DIK=DIE,DA=PSAIEN3 D IX1^DIK K DA,DIE,DIK,PSAFLD 123 Q 124 ;*42 CHANGES 125 SCANDIF ; inspect invoice for noted differences in OU,DUOU,PPDU,NDC 126 ;NEEDS PSAIEN, PSAIEN1 127 K ^TMP($J,"PSADIF"),PSADIFLC 128 S PSALINE=0 F S PSALINE=$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE)) Q:PSALINE'>0 D CHECK 129 Q 130 MM ; 131 I $D(^TMP($J,"PSADIF")) D MESSAGE 132 Q 133 CHECK ;Check line item for differences to drug file *42 134 N ITM,ITMI,DRG,DRIEN,DIF,ZZ,XX,XXX,PCNT,PDIF,T,IENS 135 ; use new API call to retrieve item fields see PSAUTL6 136 D ITEM^PSAUTL6(PSAIEN,PSAIEN1,PSALINE,.ITM) 137 D ITEM^PSAUTL6(PSAIEN,PSAIEN1,PSALINE,.ITMI,"I") 138 I ITM(2)'>0 Q ;zero quantity will not be filed 139 S ITM("OU")=ITM(3),ITM("DUOU")=ITM(10),ITM("NDC")=ITM(13),ITM("PPOU")=ITM(4),ITM("PPDU")=$J(ITM("PPOU")/ITM("DUOU"),1,4) 140 S DRIEN=+ITMI(1) 141 S DRG("OU")=$$GET1^DIQ(50,DRIEN,12),DRG("DUOU")=$$GET1^DIQ(50,DRIEN,15),DRG("NDC")=$$GET1^DIQ(50,DRIEN,31),DRG("PPDU")=$$GET1^DIQ(50,DRIEN,16) 142 K DIF 143 F XX="OU","DUOU","NDC" I ITM(XX)'=DRG(XX) S DIF(XX)="" 144 I ITM("PPDU")'=DRG("PPDU") S PCNT=.05*DRG("PPDU"),PDIF=DRG("PPDU")-ITM("PPDU") S:PDIF<0 PDIF=-1*PDIF S:PDIF>PCNT DIF("PPDU")="" 145 I $D(DIF) D 146 . F ZZ=" ",$J(ITM(.01),3)_" "_ITM(1) D SET 147 . S XXX="" F S XXX=$O(DIF(XXX)) Q:XXX="" D 148 .. S ZZ=" ",T=XXX,ZZ=$$SETSTR^VALM1(T,ZZ,4,$L(T)) 149 .. S T="Old: "_DRG(XXX),ZZ=$$SETSTR^VALM1(T,ZZ,13,$L(T)) 150 .. S T="New: "_ITM(XXX),ZZ=$$SETSTR^VALM1(T,ZZ,36,$L(T)) 151 .. D SET 152 Q 153 SET ;set differences into ^TMP 154 S:'$G(PSADIFLC) PSADIFLC=3 155 S ^TMP($J,"PSADIF",PSADIFLC,0)=ZZ,PSADIFLC=PSADIFLC+1 156 Q 157 MESSAGE ;differences found, notify user and send message to g.PSA NDC UPDATES. 158 K DIR N IENS 159 S PSAORD=$$GET1^DIQ(58.811,PSAIEN,.01),IENS=PSAIEN1_","_PSAIEN 160 S PSAINV=$$GET1^DIQ(58.8112,IENS,.01) 161 S XMSUB="PRE Verify "_PSAORD_" : "_PSAINV_" Variance Report" 162 S ^TMP($J,"PSADIF",1,0)=XMSUB,^TMP($J,"PSADIF",2,0)=" " 163 W !,XMSUB,! 164 W !,"Noted differences between the invoice line items and the drug file have",!,"been found. A mail message is being sent to G.PSA NDC UPDATES." 165 W !!," Please check the message for accuracy.",! 166 K DIR S DIR(0)="E",DIR("A")="<cr> - continue" D ^DIR 167 K DIR 168 S XMTEXT="^TMP($J,""PSADIF"",",XMY("G.PSA NDC UPDATES")="" 169 D ^XMD 170 K PSADIFLC,^TMP($J,"PSADIF") 171 Q 1 PSAPROC7 ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;9/6/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,27,21,42,61,64**; 10/24/97;Build 4 3 ;This routine takes the data in XTMP and moves it to DA ORDERS file. 4 ;It deletes the data in XTMP after it is copies. 5 ; 6 ;References to ^PSDRUG( are covered by IA #2095 7 INVOICE ;PSA*3*21 (3JAN01) - FILE INVOICE IMMEDIATELY 8 ; 9 S PSAIN=$G(^XTMP("PSAPV",PSACTRL,"IN")) Q:PSAIN="" 10 Q:$P(PSAIN,"^",8)'="P" 11 S PSAORD=$P(PSAIN,"^",4),PSAIEN=+$O(^PSD(58.811,"B",PSAORD,0)),PSACRED=0 12 I 'PSAIEN D 13 .F L +^PSD(58.811,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 14 .;(PSA*3*24 - Dave B. Jun 2 00 - Improper DIC call) 15 .;(PSA*3*61 - add N DO. DICN will use DO if defined, we do not want to use it since DIC is defined. 16 .N DO S DIC="^PSD(58.811,",DIC(0)="L",X=PSAORD D FILE^DICN K DIC L -^PSD(58.811,0) S PSAIEN=+Y 17 F L +^PSD(58.811,PSAIEN,0):10 I Q 18 S:'$D(^PSD(58.811,PSAIEN,1,0)) DIC("P")=$P(^DD(58.811,2,0),"^",2) 19 S DA(1)=PSAIEN,DIC="^PSD(58.811,"_DA(1)_",1,",DIC(0)="L",X=$P(PSAIN,"^",2),DLAYGO=58.811 D ^DIC K DA,DLAYGO S PSAIEN1=+Y 20 S DA(1)=PSAIEN,DA=PSAIEN1,DIE=DIC K DIC 21 S PSALOCDR=$P($G(PSAIN),"^",7) 22 S PSADELDR=$P($G(PSAIN),"^",6) 23 S PSACSDR=$S($P(PSAIN,"^",10)="ALL CS":"A",$P(PSAIN,"^",9)="CS":"S",1:"N") 24 S PSARECD=$P($G(PSAIN),"^",11) 25 S PSAMV=$S(+$P(PSAIN,"^",12):$P(PSAIN,"^",12),1:"") 26 S PSASUP=$S($P(PSAIN,"^",13)="SUP":1,1:"") 27 ;DAVE B ( PSA*3*12) Invalid Concatenation of zero node 28 S ^PSD(58.811,DA(1),1,DA,0)=$P(^(0),"^")_"^"_$P(PSAIN,"^",1)_"^P^"_$P(PSAIN,"^",3)_"^"_$G(PSALOCDR)_"^"_$G(PSADELDR)_"^"_$G(PSARECD)_"^"_$G(PSACSDR)_"^^"_DUZ_"^^"_$G(PSAMV)_"^"_$G(PSASUP) 29 S DIK=DIE D IX^DIK 30 K ^TMP($J,"PSADIF"),PSADIFLC ;*42 pre verify storage for OU, DUOU, Cost, NDC changes 31 S PSALINE=0 F S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:PSALINE="" D LINE 32 D SCANDIF,MM ;*42 look for differences to drug file SEND EMAIL 33 I PSACRED K DA S DA(1)=PSAIEN,DA=PSAIEN1,DIE="^PSD(58.811,"_DA(1)_",1,",DR="10///^S X=1" D ^DIE K DIE 34 S $P(^PSD(58.811,PSAIEN,0),"^",2)=$P($G(^XTMP("PSAPV",PSACTRL,"DS")),"^") 35 L -^PSD(58.811,PSAIEN,0) 36 K ^XTMP("PSAPV",PSACTRL) 37 Q 38 ; 39 LINE ;Files line items. 40 S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE) S:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,0)) DIC("P")=$P(^DD(58.8112,5,0),"^",2) 41 ;PSA*3*31 Dave B - Check for invoice already in file 42 S DA(2)=PSAIEN,DA(1)=PSAIEN1,(DA,X)=PSALINE,DIC="^PSD(58.811,"_DA(2)_",1,"_DA(1)_",1,",DIC(0)="L",DLAYGO=58.811 D ^DIC S PSAIEN2=+Y K DA,DIC,DLAYGO 43 ; 44 ;DAVEB PSA*3*3 (5may98) 45 S PSADRG=$P($G(PSADATA),"^",6) 46 S PSASYN=$P($G(PSADATA),"^",7) 47 K PSAUNIT 48 I $G(PSASYN)'="",$G(PSADRG)'="" S PSAUNIT=+$P($G(^PSDRUG(PSADRG,1,PSASYN,0)),"^",5) 49 ; 50 ;DAVE B (PSA*3*12) Assignment of order unit didn't take into 51 ;account the adjusted order unit. 52 S PSAUNIT=$S($D(PSAUNIT):PSAUNIT,$P(PSADATA,"^",12)'="":$P(PSADATA,"^",12),+$P($P(PSADATA,"^",2),"~",2):+$P($P(PSADATA,"^",2),"~",2),1:0) 53 S PSACS=$S($P(PSADATA,"^",19)="CS":1,1:0),PSANDC=$P($P(PSADATA,"^",4),"~"),PSAVSN=$P($P(PSADATA,"^",5),"~"),PSAUPC=$P($P(PSADATA,"^",26),"~") 54 I PSANDC="",$P($P(PSADATA,"^",26),"~")'="" S PSANDC="S"_$P($P(PSADATA,"^",26),"~") 55 S DA(2)=PSAIEN,DA(1)=PSAIEN1,DA=$S($D(PSAIEN2):PSAIEN2,1:PSALINE),DIE="^PSD(58.811,"_DA(2)_",1,"_DA(1)_",1," 56 ;DaveB (4may98) hard code filing data 57 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",3)=+PSADATA 58 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",11)=PSANDC 59 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",12)=PSAVSN 60 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",13)=PSAUPC 61 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",10)=PSACS 62 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",2)=PSADRG 63 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",4)=PSAUNIT 64 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",5)=$P(PSADATA,"^",3) 65 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",6)=DT 66 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",7)=DUZ 67 S DIK=DIE D IX^DIK 68 ;End PSA*3*7 69 ; 70 I +$P(PSADATA,"^",15)!($D(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"))) D ADJDRUG 71 I $P(PSADATA,"^",8)'="" D QTY 72 I +$P(PSADATA,"^",12) D OU 73 I +$P(PSADATA,"^",23) D PRICE 74 ;Adds the reorder level and/or dispense units per order unit 75 I +$P(PSADATA,"^",7)!(+$P(PSADATA,"^",20))!(+$P(PSADATA,"^",21))!(+$P(PSADATA,"^",27)) D 76 .S ^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSAIEN2,2)=$P(PSADATA,"^",20)_"^"_$P(PSADATA,"^",21)_"^"_$S(+$P(PSADATA,"^",7):+$P(PSADATA,"^",7),1:0)_"^"_+$P(PSADATA,"^",27) 77 K ^XTMP("PSAPV",PSACTRL,"IT",PSALINE) 78 Q 79 ADJDRUG ;Records adjusted drug received 80 S PSAFLD="D" 81 I +$P(PSADATA,"^",15) S PSADJ=+$P(PSADATA,"^",15),PSADUZ=+$P(PSADATA,"^",16),PSADT=+$P(PSADATA,"^",17),PSAREA="" D RECORD Q 82 I $D(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")) S PSASNODE=^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"),PSADJ=$P(PSASNODE,"^",3),PSADUZ=+$P(PSASNODE,"^"),PSADT=+$P(PSASNODE,"^",2),PSAREA="" D RECORD 83 Q 84 OU ;Records adjusted order unit 85 S PSAFLD="O",PSADJ=+$P(PSADATA,"^",12),PSADUZ=+$P(PSADATA,"^",13),PSADT=+$P(PSADATA,"^",14),PSAREA="" 86 D RECORD 87 Q 88 PRICE ;Records adjusted price per order unit 89 S PSAFLD="P",PSADJ=+$P(PSADATA,"^",23),PSADUZ=+$P(PSADATA,"^",24),PSADT=+$P(PSADATA,"^",25),PSAREA="" 90 S:PSADJ'=+$P(PSADATA,"^",3) PSACRED=1 91 D RECORD 92 Q 93 QTY ;Records adjusted quantity received. 94 S PSAFLD="Q",PSADJ=+$P(PSADATA,"^",8),PSADUZ=+$P(PSADATA,"^",9),PSADT=+$P(PSADATA,"^",10),PSAREA=$P(PSADATA,"^",11) 95 S:PSADJ'=+$P(PSADATA,"^") PSACRED=1 96 D RECORD 97 Q 98 RECORD ;Adds adjusted data to DA ORDERS file 99 K DA S DA(3)=PSAIEN,DA(2)=PSAIEN1,DA(1)=PSAIEN2,X=PSAFLD 100 S:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSAIEN2,1,0)) DIC("P")=$P(^DD(58.81125,9,0),"^",2) 101 ;PSA*3*27 (DAVE B) removed killing of DA variable on next line 102 S DIC="^PSD(58.811,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,",DIC(0)="L",DLAYGO=58.811 D ^DIC S PSAIEN3=+Y K DLAYGO 103 ; 104 ;PSA*3*3 105 ;DAVEB Hard code filing 106 S DIE=DIC,DA=PSAIEN3 107 S $P(^PSD(58.811,DA(3),1,DA(2),1,DA(1),1,DA,0),"^",2)=PSADJ 108 S $P(^PSD(58.811,DA(3),1,DA(2),1,DA(1),1,DA,0),"^",3)=$G(PSAREA) 109 S $P(^PSD(58.811,DA(3),1,DA(2),1,DA(1),1,DA,0),"^",4)=DT 110 S $P(^PSD(58.811,DA(3),1,DA(2),1,DA(1),1,DA,0),"^",5)=DUZ 111 ; 112 ;S DIE=DIC,DA=PSAIEN3,DR="1///"_PSADJ_$S(PSAREA'="":";2////^S X=PSAREA",1:"")_";3///^S X="_PSADT_";4///^S X="_PSADUZ K DIC D ^DIE 113 S DIK=DIE,DA=PSAIEN3 D IX1^DIK K DA,DIE,DIK,PSAFLD 114 Q 115 ;*42 CHANGES 116 SCANDIF ; inspect invoice for noted differences in OU,DUOU,PPDU,NDC 117 ;NEEDS PSAIEN, PSAIEN1 118 K ^TMP($J,"PSADIF"),PSADIFLC 119 S PSALINE=0 F S PSALINE=$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE)) Q:PSALINE'>0 D CHECK 120 Q 121 MM ; 122 I $D(^TMP($J,"PSADIF")) D MESSAGE 123 Q 124 CHECK ;Check line item for differences to drug file *42 125 N ITM,ITMI,DRG,DRIEN,DIF,ZZ,XX,XXX,PCNT,PDIF,T,IENS 126 ; use new API call to retrieve item fields see PSAUTL6 127 D ITEM^PSAUTL6(PSAIEN,PSAIEN1,PSALINE,.ITM) 128 D ITEM^PSAUTL6(PSAIEN,PSAIEN1,PSALINE,.ITMI,"I") 129 I ITM(2)'>0 Q ;zero quantity will not be filed 130 S ITM("OU")=ITM(3),ITM("DUOU")=ITM(10),ITM("NDC")=ITM(13),ITM("PPOU")=ITM(4),ITM("PPDU")=$J(ITM("PPOU")/ITM("DUOU"),1,4) 131 S DRIEN=+ITMI(1) 132 S DRG("OU")=$$GET1^DIQ(50,DRIEN,12),DRG("DUOU")=$$GET1^DIQ(50,DRIEN,15),DRG("NDC")=$$GET1^DIQ(50,DRIEN,31),DRG("PPDU")=$$GET1^DIQ(50,DRIEN,16) 133 K DIF 134 F XX="OU","DUOU","NDC" I ITM(XX)'=DRG(XX) S DIF(XX)="" 135 I ITM("PPDU")'=DRG("PPDU") S PCNT=.05*DRG("PPDU"),PDIF=DRG("PPDU")-ITM("PPDU") S:PDIF<0 PDIF=-1*PDIF S:PDIF>PCNT DIF("PPDU")="" 136 I $D(DIF) D 137 . F ZZ=" ",$J(ITM(.01),3)_" "_ITM(1) D SET 138 . S XXX="" F S XXX=$O(DIF(XXX)) Q:XXX="" D 139 .. S ZZ=" ",T=XXX,ZZ=$$SETSTR^VALM1(T,ZZ,4,$L(T)) 140 .. S T="Old: "_DRG(XXX),ZZ=$$SETSTR^VALM1(T,ZZ,13,$L(T)) 141 .. S T="New: "_ITM(XXX),ZZ=$$SETSTR^VALM1(T,ZZ,36,$L(T)) 142 .. D SET 143 Q 144 SET ;set differences into ^TMP 145 S:'$G(PSADIFLC) PSADIFLC=3 146 S ^TMP($J,"PSADIF",PSADIFLC,0)=ZZ,PSADIFLC=PSADIFLC+1 147 Q 148 MESSAGE ;differences found, notify user and send message to g.PSA NDC UPDATES. 149 K DIR N IENS 150 S PSAORD=$$GET1^DIQ(58.811,PSAIEN,.01),IENS=PSAIEN1_","_PSAIEN 151 S PSAINV=$$GET1^DIQ(58.8112,IENS,.01) 152 S XMSUB="PRE Verify "_PSAORD_" : "_PSAINV_" Variance Report" 153 S ^TMP($J,"PSADIF",1,0)=XMSUB,^TMP($J,"PSADIF",2,0)=" " 154 W !,XMSUB,! 155 W !,"Noted differences between the invoice line items and the drug file have",!,"been found. A mail message is being sent to G.PSA NDC UPDATES." 156 W !!," Please check the message for accuracy.",! 157 K DIR S DIR(0)="E",DIR("A")="<cr> - continue" D ^DIR 158 K DIR 159 S XMTEXT="^TMP($J,""PSADIF"",",XMY("G.PSA NDC UPDATES")="" 160 D ^XMD 161 K PSADIFLC,^TMP($J,"PSADIF") 162 Q -
WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAUDP.m
r613 r623 1 PSAUDP ;BIR/LTL,JMB-Nightly Background Job - CONT'D ;7/23/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**6,3,12,14,25,64,66**; 10/24/97;Build 2 3 ; 4 ;Reference to ^PS(57.6 are covered by IA #772 5 PICKLST ;ask for parameters PSA*3*25 6 I '$D(^PSD(58.812,1,"T","B","UNIT DOSE"))!('$D(^PSD(58.812,1,"T"))) D 7 .S ^PSD(58.812,1,"T",0)="^58.8123A^1^1" 8 .S X="T-2W" D ^%DT S ^PSD(58.812,1,"T",1,0)="UNIT DOSE^"_Y_"^",X="T-1W" D ^%DT S $P(^PSD(58.812,1,"T",1,0),"^",3)=Y K X,Y 9 .S ^PSD(58.812,1,"T","B","UNIT DOSE",1)="" 10 S XX=$O(^PSD(58.812,1,"T","B","UNIT DOSE",0)) Q:XX'>0 S JOBIEN=XX D NOW^%DTC S STRTDATE=%,PARDATA=$G(^PSD(58.812,1,"T",JOBIEN,0)) 11 S PSABGN=$P(PARDATA,"^",2),PSAEND=$P(PARDATA,"^",3) 12 S X="T-7" D ^%DT I Y'=PSAEND G DONE 13 S $P(^PSD(58.812,1,"T",JOBIEN,0),"^",2)=PSAEND,X1=PSAEND,X2=7 D C^%DTC S $P(^PSD(58.812,1,"T",JOBIEN,0),"^",3)=X ;Reset date parameters 14 ;Go back two weeks, gather 1 weeks worth of data 15 S PSAD0=PSABGN-.000001 16 S PSAEND=PSAEND_".2359" 17 DATE ;Loop through dates 18 S PSAD0=$O(^PS(57.6,PSAD0)) G DONE:PSAD0'>0 G DONE:PSAD0>PSAEND K PSAD1 19 WRD S PSAD1=$S('$D(PSAD1):$O(^PS(57.6,PSAD0,1,0)),1:$O(^PS(57.6,PSAD0,1,PSAD1))) G DATE:PSAD1'>0 K PSAD2 20 PVDR ;Loop through providers 21 S PSAD2=$S('$D(PSAD2):$O(^PS(57.6,PSAD0,1,PSAD1,1,0)),1:$O(^PS(57.6,PSAD0,1,PSAD1,1,PSAD2))) G WRD:PSAD2'>0 K PSAD3 22 DRG S PSAD3=$S('$D(PSAD3):$O(^PS(57.6,PSAD0,1,PSAD1,1,PSAD2,1,0)),1:$O(^PS(57.6,PSAD0,1,PSAD1,1,PSAD2,1,PSAD3))) G PVDR:PSAD3'>0 S DATA=$G(^PS(57.6,PSAD0,1,PSAD1,1,PSAD2,1,PSAD3,0)) 23 S PSAIP=PSAD1,PSA50=PSAD3,PSADT=PSAD0 K PSALOC 24 LOC S PSALOC=$S('$D(PSALOC):$O(^PSD(58.8,"AB",PSAD1,0)),1:$O(^PSD(58.8,"AB",PSAD1,PSALOC))) G DRG:PSALOC'>0 I $D(^PSD(58.8,PSALOC,"I")),$P($G(^PSD(58.8,PSALOC,"I")),"^")'>DT G LOC 25 S PSAQTY=$P($G(DATA),"^",2)-$P($G(DATA),"^",4) 26 I $D(^PSD(58.8,PSALOC,1,PSA50)) D PROCESS 27 G LOC 28 ; 29 Q 30 DONE ; 31 END K DA,DATA,DIC,DIE,DR,PSA50,PSAD0,PSAD1,PSAD2,PSAD3,PSADT,PSAIP,PSALOC,PSANUM,PSAQTY,X,Y,PSABGN,PSAEND,PARDATA,JOBIEN,X 32 Q 33 PROCESS ;Stuff last UD dispensing fld with DT 34 F L +^PSD(58.8,PSALOC,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 35 S DIE="^PSD(58.8,",DA=PSALOC,DR="27////"_PSADT D ^DIE K DIE,DA,DR 36 ;Subtract dispensing from balance 37 S PSABAL=$P($G(^PSD(58.8,PSALOC,1,PSA50,0)),"^",4) 38 S $P(^PSD(58.8,PSALOC,1,PSA50,0),"^",4)=PSABAL-$G(PSAQTY) 39 ;If no monthly activity node, add node with beginning balance. 40 I '$D(^PSD(58.8,PSALOC,1,PSA50,5,+$E(PSADT,1,5)*100,0)) D 41 .S DIC="^PSD(58.8,PSALOC,1,PSA50,5,",DIC(0)="L",DIC("P")=$P(^DD(58.8001,20,0),U,2),(X,DINUM)=$E(PSADT,1,5)*100,DA(2)=PSALOC,DA(1)=PSA50 42 .S DIC("DR")="1////^S X=$G(PSABAL)",DLAYGO=58.8 D ^DIC K DIC,DLAYGO 43 .;Add current month's node and stuff beginning & ending balance. 44 .S DIC="^PSD(58.8,PSALOC,1,PSA50,5,",DIC(0)="L",(X,DINUM)=$E(PSADT-100-(+$E(PSADT,4,5)=1*8800),1,5)*100,DA(2)=PSALOC,DA(1)=PSA50,DLAYGO=58.8 D ^DIC K DIC,DLAYGO S DA=+Y 45 .S DIE="^PSD(58.8,PSALOC,1,PSA50,5,",DA(2)=PSALOC,DA(1)=PSA50,DR="3////^S X=$G(PSABAL)" D ^DIE K DIE 46 ;Stuff total dispensed 47 S DIE="^PSD(58.8,PSALOC,1,PSA50,5,",DA(2)=PSALOC,DA(1)=PSA50,DA=$E(PSADT,1,5)*100,DR="9////^S X=$P($G(^(0)),U,6)+PSAQTY" D ^DIE K DIE,DA 48 ;Get next transaction node number 49 F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q ;; << *66 RJS 50 FIND S PSANUM=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSANUM)) S $P(^PSD(58.81,0),"^",3)=$P(^PSD(58.81,0),"^",3)+1 G FIND 51 ;Add next transaction node with data. 52 S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSANUM D ^DIC K DIC,DLAYGO 53 S DIE="^PSD(58.81,",DA=PSANUM 54 S DR="1////2;2////^S X=PSALOC;3////^S X=PSADT;4////^S X=PSA50;5////^S X=PSAQTY;9////^S X=$G(PSABAL)" D ^DIE K DIE,DA 55 L -^PSD(58.81,0) ;; >> *66 RJS 56 ;Add activity node 57 S DIC="^PSD(58.8,PSALOC,1,PSA50,4,",DIC(0)="L",(X,DINUM)=PSANUM,DIC("P")=$P(^DD(58.8001,19,0),"^",2),DA(2)=PSALOC,DA(1)=PSA50,DLAYGO=58.8 D ^DIC K DA,DIC,DLAYGO 58 L -^PSD(58.8,PSALOC,0) 59 Q 1 PSAUDP ;BIR/LTL,JMB-Nightly Background Job - CONT'D ;7/23/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**6,3,12,14,25,64**; 10/24/97;Build 4 3 ; 4 ;Reference to ^PS(57.6 are covered by IA #772 5 PICKLST ;ask for parameters PSA*3*25 6 I '$D(^PSD(58.812,1,"T","B","UNIT DOSE"))!('$D(^PSD(58.812,1,"T"))) D 7 .S ^PSD(58.812,1,"T",0)="^58.8123A^1^1" 8 .S X="T-2W" D ^%DT S ^PSD(58.812,1,"T",1,0)="UNIT DOSE^"_Y_"^",X="T-1W" D ^%DT S $P(^PSD(58.812,1,"T",1,0),"^",3)=Y K X,Y 9 .S ^PSD(58.812,1,"T","B","UNIT DOSE",1)="" 10 S XX=$O(^PSD(58.812,1,"T","B","UNIT DOSE",0)) Q:XX'>0 S JOBIEN=XX D NOW^%DTC S STRTDATE=%,PARDATA=$G(^PSD(58.812,1,"T",JOBIEN,0)) 11 S PSABGN=$P(PARDATA,"^",2),PSAEND=$P(PARDATA,"^",3) 12 S X="T-7" D ^%DT I Y'=PSAEND G DONE 13 S $P(^PSD(58.812,1,"T",JOBIEN,0),"^",2)=PSAEND,X1=PSAEND,X2=7 D C^%DTC S $P(^PSD(58.812,1,"T",JOBIEN,0),"^",3)=X ;Reset date parameters 14 ;Go back two weeks, gather 1 weeks worth of data 15 S PSAD0=PSABGN-.000001 16 S PSAEND=PSAEND_".2359" 17 DATE ;Loop through dates 18 S PSAD0=$O(^PS(57.6,PSAD0)) G DONE:PSAD0'>0 G DONE:PSAD0>PSAEND K PSAD1 19 WRD S PSAD1=$S('$D(PSAD1):$O(^PS(57.6,PSAD0,1,0)),1:$O(^PS(57.6,PSAD0,1,PSAD1))) G DATE:PSAD1'>0 K PSAD2 20 PVDR ;Loop through providers 21 S PSAD2=$S('$D(PSAD2):$O(^PS(57.6,PSAD0,1,PSAD1,1,0)),1:$O(^PS(57.6,PSAD0,1,PSAD1,1,PSAD2))) G WRD:PSAD2'>0 K PSAD3 22 DRG S PSAD3=$S('$D(PSAD3):$O(^PS(57.6,PSAD0,1,PSAD1,1,PSAD2,1,0)),1:$O(^PS(57.6,PSAD0,1,PSAD1,1,PSAD2,1,PSAD3))) G PVDR:PSAD3'>0 S DATA=$G(^PS(57.6,PSAD0,1,PSAD1,1,PSAD2,1,PSAD3,0)) 23 S PSAIP=PSAD1,PSA50=PSAD3,PSADT=PSAD0 K PSALOC 24 LOC S PSALOC=$S('$D(PSALOC):$O(^PSD(58.8,"AB",PSAD1,0)),1:$O(^PSD(58.8,"AB",PSAD1,PSALOC))) G DRG:PSALOC'>0 I $D(^PSD(58.8,PSALOC,"I")),$P($G(^PSD(58.8,PSALOC,"I")),"^")'>DT G LOC 25 S PSAQTY=$P($G(DATA),"^",2)-$P($G(DATA),"^",4) 26 I $D(^PSD(58.8,PSALOC,1,PSA50)) D PROCESS 27 G LOC 28 ; 29 Q 30 DONE ; 31 END K DA,DATA,DIC,DIE,DR,PSA50,PSAD0,PSAD1,PSAD2,PSAD3,PSADT,PSAIP,PSALOC,PSANUM,PSAQTY,X,Y,PSABGN,PSAEND,PARDATA,JOBIEN,X 32 Q 33 PROCESS ;Stuff last UD dispensing fld with DT 34 F L +^PSD(58.8,PSALOC,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 35 S DIE="^PSD(58.8,",DA=PSALOC,DR="27////"_PSADT D ^DIE K DIE,DA,DR 36 ;Subtract dispensing from balance 37 S PSABAL=$P($G(^PSD(58.8,PSALOC,1,PSA50,0)),"^",4) 38 S $P(^PSD(58.8,PSALOC,1,PSA50,0),"^",4)=PSABAL-$G(PSAQTY) 39 ;If no monthly activity node, add node with beginning balance. 40 I '$D(^PSD(58.8,PSALOC,1,PSA50,5,+$E(PSADT,1,5)*100,0)) D 41 .S DIC="^PSD(58.8,PSALOC,1,PSA50,5,",DIC(0)="L",DIC("P")=$P(^DD(58.8001,20,0),U,2),(X,DINUM)=$E(PSADT,1,5)*100,DA(2)=PSALOC,DA(1)=PSA50 42 .S DIC("DR")="1////^S X=$G(PSABAL)",DLAYGO=58.8 D ^DIC K DIC,DLAYGO 43 .;Add current month's node and stuff beginning & ending balance. 44 .S DIC="^PSD(58.8,PSALOC,1,PSA50,5,",DIC(0)="L",(X,DINUM)=$E(PSADT-100-(+$E(PSADT,4,5)=1*8800),1,5)*100,DA(2)=PSALOC,DA(1)=PSA50,DLAYGO=58.8 D ^DIC K DIC,DLAYGO S DA=+Y 45 .S DIE="^PSD(58.8,PSALOC,1,PSA50,5,",DA(2)=PSALOC,DA(1)=PSA50,DR="3////^S X=$G(PSABAL)" D ^DIE K DIE 46 ;Stuff total dispensed 47 S DIE="^PSD(58.8,PSALOC,1,PSA50,5,",DA(2)=PSALOC,DA(1)=PSA50,DA=$E(PSADT,1,5)*100,DR="9////^S X=$P($G(^(0)),U,6)+PSAQTY" D ^DIE K DIE,DA 48 ;Get next transaction node number 49 FIND S PSANUM=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSANUM)) S $P(^PSD(58.81,0),"^",3)=$P(^PSD(58.81,0),"^",3)+1 G FIND 50 ;Add next transaction node with data. 51 S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSANUM D ^DIC K DIC,DLAYGO 52 S DIE="^PSD(58.81,",DA=PSANUM 53 S DR="1////2;2////^S X=PSALOC;3////^S X=PSADT;4////^S X=PSA50;5////^S X=PSAQTY;9////^S X=$G(PSABAL)" D ^DIE K DIE,DA 54 ;Add activity node 55 S DIC="^PSD(58.8,PSALOC,1,PSA50,4,",DIC(0)="L",(X,DINUM)=PSANUM,DIC("P")=$P(^DD(58.8001,19,0),"^",2),DA(2)=PSALOC,DA(1)=PSA50,DLAYGO=58.8 D ^DIC K DA,DIC,DLAYGO 56 L -^PSD(58.8,PSALOC,0) 57 Q -
WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAUP4.m
r613 r623 1 PSAUP4 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data - CONT'D ;9/19/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,20,21,67**; 10/24/97;Build 15 3 ;This routine prints invoices from the ^XTMP global on the screen or 4 ;to a printer. 5 ; 6 ;References to ^PSDRUG( are covered by IA #2095 7 ;References to ^DIC(51.5( are covered by IA #1931 8 ; 9 W !!,"Enter the device which will be used to print",!,"the invoices with all items, errors, and adjustments.",! 10 S %ZIS="Q" D ^%ZIS I POP S PSAOUT=1 Q 11 I $D(IO("Q")) S ZTDESC="Drug Acct. - Prime Vendor Invoice Upload Report",ZTRTN="DQ^PSAUP4" D ^%ZTLOAD Q 12 ; 13 DQ ;queue starts here 14 S IOM=80 15 D NOW^%DTC S Y=% D DD^%DT S PSARUN=$E(Y,1,18),$P(PSASLN,"-",80)="",$P(PSADLN,"=",80)="",(PSADJDRG,PSADJSUP,PSAOUT)=0,PSAFPG=1 16 U IO 17 S PSACTRL=0 F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL=""!(PSAOUT) D START 18 W @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q") 19 ; 20 EXIT ;Kills printing variables only 21 K %,%ZIS,DIR,DIRUT,PSAAECST,PSABY,PSACS,PSACTRL,PSADATA,PSADATE,PSADEC,PSADRG,PSADJDRG,PSADJORD,PSADJQTY,PSADJSUP,PSADLN,PSADS,PSAECOST,PSAEND,PSAFPG,PSAICOST,PSAIECST 22 K PSAIN,PSALINE,PSANDC,PSAODT,PSAODUZ,PSAOREA,PSAOUT,PSAPAGE,PSAPHARM,PSAQDT,PSAQDUZ,PSAQREA,PSAMV,PSARUN,PSAS,PSASLN,PSASS,PSAST,PSASTA,PSATOT,Y,ZTDESC,ZTRTN,ZTSK 23 Q 24 ; 25 START S PSAPAGE=1,PSAEND=0 D HEADER S PSAIN=$G(^XTMP("PSAPV",PSACTRL,"IN")) 26 S (PSADJDRG,PSADJSUP,PSAIECST,PSAAECST)=0,PSAPHARM=$P(PSAIN,"^",7),PSAMV=$P(PSAIN,"^",12) 27 W !,"PRIME VENDOR : ",$S($P($G(^XTMP("PSAPV",PSACTRL,"DS")),"^")'="":$P($G(^("DS")),"^"),1:"UNKNOWN") 28 W !!,"ORDER# : "_$P(PSAIN,"^",4),?40,"ORDER DATE : "_$$DATE($P(PSAIN,"^",3)) 29 W !,"INVOICE#: "_$P(PSAIN,"^",2),?40,"INVOICE DATE: "_$$DATE(+PSAIN) 30 S PSASTA=$P(PSAIN,"^",8) 31 W !,"STATUS : "_$S(PSASTA="":"UPLOADED WITH ERRORS",PSASTA="OK":"UPLOADED WITHOUT ERRORS",PSASTA="P":"PROCESSED",1:"UNKNOWN")_$S($P(PSAIN,"^",13)="SUP":" (SUPPLY INVOICE)",1:"") 32 I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER 33 I $E(IOST,1,2)="C-" D LINE Q 34 W !!,"DELIVERY DATE REQUESTED: ",$$DATE($P(PSAIN,"^",5)) 35 W !,"DATE RECEIVED : "_$S(+$P(PSAIN,"^",11)&($$DATE(+$P(PSAIN,"^",11))):" ("_$$DATE($P(PSAIN,"^",6))_")",1:$$DATE($P(PSAIN,"^",6))) 36 I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:$G(PSAOUT) D HEADER 37 ; 38 BUYSHIP W !!,"BUYER INFORMATION:",?40,"SHIPPING INFORMATION:" 39 S PSABY=$G(^XTMP("PSAPV",PSACTRL,"BY")) 40 S PSAST=$G(^XTMP("PSAPV",PSACTRL,"ST")) 41 W !?2,$P(PSABY,"^"),?42,$P(PSAST,"^") 42 I $P(PSABY,"^",2)'=""!($P(PSAST,"^",2)'="") W ! W:$P(PSABY,"^",2)'="" ?2,$P(PSABY,"^",2) W:$P(PSAST,"^",2)'="" ?42,$P(PSAST,"^",2) 43 I $P(PSABY,"^",3)'=""!($P(PSAST,"^",3)'="") W ! W:$P(PSABY,"^",3)'="" ?2,$P(PSABY,"^",3) W:$P(PSAST,"^",3)'="" ?42,$P(PSAST,"^",3) 44 W !?2,$P(PSABY,"^",4)_" "_$P(PSABY,"^",5)_" ",$P(PSABY,"^",6) 45 W ?42,$P(PSAST,"^",4)_" "_$P(PSAST,"^",5)_" ",$P(PSAST,"^",6) 46 I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER 47 ; 48 DISTRIB W !!,"DISTRIBUTOR INFORMATION:" 49 S PSADS=$G(^XTMP("PSAPV",PSACTRL,"DS")) 50 W !?2,$P(PSADS,"^") 51 W:$P(PSADS,"^",2)'="" !?2,$P(PSADS,"^",2) 52 W:$P(PSADS,"^",3)'="" !?2,$P(PSADS,"^",3) 53 W !?2,$P(PSADS,"^",4)_" "_$P(PSADS,"^",5)_" ",$P(PSADS,"^",6) 54 I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER 55 D LINE 56 Q 57 ; 58 DATE(PSADATE) ;convert date 59 S %=$E(PSADATE,4,5)_"/"_$E(PSADATE,6,7)_"/"_$E(PSADATE,2,3) 60 I $TR(%,"/")="" S %="UNKNOWN" 61 Q % 62 ; 63 LINE ;print line items 64 D LINEHDR 65 S (PSAICOST,PSALINE,PSATOT)=0 F S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:'PSALINE!(PSAOUT) S PSADATA=^(PSALINE),PSADRG=0 D Q:PSAOUT 66 .I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER,LINEHDR 67 .K PSADJQTY,PSAQDUZ,PSAQDT,PSAQREA,PSADJORD,PSAODUZ,PSAODT,PSAOREA 68 .W !,PSALINE 69 DRUG .;Drug 70 .I +$P(PSADATA,"^",15) S PSADRG=+$P(PSADATA,"^",15) W ?8,"*"_$P($G(^PSDRUG(+$P(PSADATA,"^",15),0)),"^")_$S(+$P(PSADATA,"^",6)&($P($G(^PSDRUG(+$P(PSADATA,"^",6),0)),"^")'=""):" ("_$P(^PSDRUG(+$P(PSADATA,"^",6),0),"^")_")",1:"") S PSADJDRG=1 71 .I PSADRG,$D(^PSDRUG(PSADRG,"I")) W !,?5,"** INACTIVE IN DRUG FILE **" 72 .I '+$P(PSADATA,"^",15) D 73 ..I +$P(PSADATA,"^",6),$P($G(^PSDRUG(+$P(PSADATA,"^",6),0)),"^")'="" W ?9,$P(^PSDRUG(+$P(PSADATA,"^",6),0),"^") S PSADRG=+$P(PSADATA,"^",6) Q 74 ..I $P($G(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")),"^",3)'="" W ?7,"**"_$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"),"^",3) S PSADJSUP=1,PSADRG=0 Q 75 ..W ?9,"DRUG UNKNOWN" 76 .I $P(PSADATA,"^",19)="CS" W " (CONTROLLED SUBS)" I $P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !?5,"*** INACTIVE IN MASTER VAULT" 77 .E I PSADRG,$P($G(^PSD(58.8,+$P(PSAIN,"^",7),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !?5,"*** INACTIVE IN PHARMACY LOCATION" 78 .;UPC 79 .I $P($P(PSADATA,"^",26),"~")'="" W !?9,"UPC: "_$P($P(PSADATA,"^",26),"~") 80 .;NDC 81 .S PSANDC=$P($P(PSADATA,"^",4),"~") 82 .I $E(PSANDC)'="S" D 83 ..W !?9 D PSANDC1^PSAHELP S PSANDC=PSANDCX 84 ..I PSANDC'="" W PSANDC Q 85 ..W "NDC UNKNOWN" 86 .; 87 .;VSN 88 .W ?25,$S($P($P(PSADATA,"^",5),"~")'="":$E($P($P(PSADATA,"^",5),"~"),1,14),1:"VSN UNKNOWN") 89 .; 90 .;QTY 91 .;No Adjusted Qty 92 .S PSAIECST=PSAIECST+($P(PSADATA,"^")*$P(PSADATA,"^",3)) 93 .I $P(PSADATA,"^",8)="" W ?40,$J($P(PSADATA,"^"),6) S PSAECOST=$P(PSADATA,"^")*$P(PSADATA,"^",3),PSAAECST=PSAAECST+PSAECOST 94 .;Adj. Qty (P) 95 .I $P(PSADATA,"^",8)'="" D 96 ..S PSADJQTY=$P(PSADATA,"^",8),PSAQDUZ=$P(PSADATA,"^",9),PSAQDT=$P(PSADATA,"^",10),PSAQREA=$P(PSADATA,"^",11) 97 ..S PSAECOST=PSADJQTY*$P(PSADATA,"^",3),PSAAECST=PSAAECST+PSAECOST 98 ..W ?40,$J($P(PSADATA,"^",8),6)_"("_$P(PSADATA,"^")_")" 99 .; 100 OU .;Order Unit 101 .I '+$P(PSADATA,"^",12) D 102 ..I +$P($P(PSADATA,"^",2),"~",2),$P($G(^DIC(51.5,+$P($P(PSADATA,"^",2),"~",2),0)),"^")'="" W ?53,$P($G(^DIC(51.5,+$P($P(PSADATA,"^",2),"~",2),0)),"^") Q 103 ..I $P($G(PSADATA),"^",2)'="",$P($G(PSADATA),"^",2)'["~",'$D(^DIC(51.5,"B",$P(PSADATA,"^",2))) W ?48," ?-> "_$P(PSADATA,"^",2) 104 ..I $P($P(PSADATA,"^",2),"~")="" D ^PSAHELP 105 .;Adj. OU (P) 106 .I +$P(PSADATA,"^",12) S PSADJORD=$P(PSADATA,"^",12),PSAODUZ=$P(PSADATA,"^",13),PSAODT=$P(PSADATA,"^",14) W ?53,$P($G(^DIC(51.5,+$P(PSADATA,"^",12),0)),"^")_"("_$P($P(PSADATA,"^",2),"~")_")" 107 .;Unit price 108 .S PSADEC=$S($L($P($P(PSADATA,"^",3),".",2))>1:$L($P($P(PSADATA,"^",3),".",2)),1:2) 109 .W ?59,$J($P(PSADATA,"^",3),7,PSADEC) 110 .;Extended cost 111 .W ?67,$J(PSAECOST,12,2) 112 .I $Y+9>IOSL,+$P(PSADATA,"^",21),+$P(PSADATA,"^",27) D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER,LINEHDR 113 .I $G(PSADRG) D HAVEDRG 114 .I '$G(PSADRG) W !?9,"STOCK LEVEL : ",!?9,"REORDER LEVEL: "_$P(PSADATA,"^",21),!?9,"DISPENSE UNITS/ORDER UNIT: " D DISP^PSAP67 115 .; 116 .;Print Adj Qty 117 .I $G(PSADJQTY)'="" D 118 ..I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER,LINEHDR 119 ..W !!?9,"ADJUSTED QUANTITY: "_PSADJQTY,!?9,$$DATE(PSAQDT)_" "_$P($G(^VA(200,+PSAQDUZ,0)),"^"),!?11,PSAQREA 120 .;Print Adj OU 121 .I +$G(PSADJORD) D 122 ..I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER,LINEHDR 123 ..W !!,?9,"ADJUSTED ORDER UNIT: "_$P($G(^DIC(51.5,+PSADJORD,0)),"^") 124 ..W !?9,$$DATE(PSAODT)_" "_$P($G(^VA(200,+PSAODUZ,0)),"^")_" - "_$P($G(^DIC(51.5,PSADJORD,0)),"^") 125 .W ! 126 Q:PSAOUT 127 I $Y+6>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER 128 W !,PSASLN 129 W:$G(PSAAECST)'=$G(PSAIECST) !?48,"TOTAL ADUSTED COST",?67,$J(PSAAECST,12,2),! 130 W !?48,"TOTAL INVOICED COST",?67,$J(PSAIECST,12,2) 131 S PSAEND=1 132 I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER 133 I PSADJDRG,$E(IOST)'="C" W !!,"* THE DRUG WAS MATCHED TO THE DRUG FILE." 134 I PSADJSUP,$E(IOST)'="C" W !!,"* THE ITEM IS A SUPPLY ITEM." 135 D:$E(IOST,1,2)="C-" SCREEN 136 Q 137 ; 138 LINEHDR ;item header 139 W !?50,"ORDER",?62,"COST/",?71,"EXTENDED" 140 W !,"LINE#",?9,"NDC",?25,"VSN",?43,"QTY",?51,"UNIT",?62,"UNIT",?75,"COST",!,PSADLN,! 141 Q 142 ; 143 HEADER ;Page header 144 I PSAFPG&($E(IOST,1,2)="C-") W @IOF G HDR1 145 S PSAFPG=0 146 W:'PSAFPG @IOF 147 HDR1 W !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE" 148 W !?26,"PRIME VENDOR UPLOAD REPORT",! 149 W:PSAPAGE'=1 !,"ORDER#: "_$P(PSAIN,"^",4)_" INVOICE#: "_$P(PSAIN,"^",2) 150 I $E(IOST,1,2)="C-" W ?(74-$L(PSAPAGE)),"PAGE "_PSAPAGE,!,PSADLN 151 I $E(IOST)'="C" W !,"RUN: "_PSARUN,?(74-$L(PSAPAGE)),"PAGE "_PSAPAGE,!,PSADLN 152 S PSAPAGE=PSAPAGE+1 153 Q 154 SCREEN ;Hold on screen 155 S PSAS=20-$Y I PSAS F PSASS=1:1:PSAS W ! 156 I PSADJDRG,PSAEND W !," * THE DRUG WAS MATCHED TO THE DRUG FILE." 157 I PSADJSUP,PSAEND W !,"** THE ITEM IS A SUPPLY ITEM." 158 S DIR(0)="E" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 159 Q 160 ; 161 HAVEDRG ;Display data if drug is found. 162 ;DAVE B (PSA*3*20) 7SEP99 ADDED $G TO NEXT LINE 163 S PSACS=$S($P($G(^PSDRUG(PSADRG,2)),"^",3)["N":1,1:0) 164 I PSACS D 165 .I PSAMV,+$P($G(^PSD(58.8,PSAMV,0)),"^",14) D Q 166 ..W !?9,"STOCK LEVEL : "_$S(+$P(PSADATA,"^",27):+$P(PSADATA,"^",27),1:+$P($G(^PSD(58.8,PSAMV,1,PSADRG,0)),"^",3)) 167 ..W !?9,"REORDER LEVEL: "_$S(+$P(PSADATA,"^",21):+$P(PSADATA,"^",21),1:+$P($G(^PSD(58.8,PSAMV,1,PSADRG,0)),"^",5)) 168 .I 'PSAMV W !?9,"STOCK LEVEL : "_$P(PSADATA,"^",27),!?9,"REORDER LEVEL: "_$P(PSADATA,"^",21) 169 I 'PSACS D 170 .I PSAPHARM,+$P($G(^PSD(58.8,PSAPHARM,0)),"^",14) D 171 ..W !?9,"STOCK LEVEL : "_$S(+$P(PSADATA,"^",27):+$P(PSADATA,"^",27),1:+$P($G(^PSD(58.8,PSAPHARM,1,PSADRG,0)),"^",3)) 172 ..W !?9,"REORDER LEVEL: "_$S(+$P(PSADATA,"^",21):+$P(PSADATA,"^",21),1:+$P($G(^PSD(58.8,PSAPHARM,1,PSADRG,0)),"^",5)) 173 .I 'PSAPHARM W !?9,"STOCK LEVEL : "_$P(PSADATA,"^",27),!?9,"REORDER LEVEL: "_$P(PSADATA,"^",21) 174 W !?9,"DISPENSE UNITS/ORDER UNIT: " 175 W $S(+$P(PSADATA,"^",20):+$P(PSADATA,"^",20),+$P($G(^PSDRUG(PSADRG,1,+$P(PSADATA,"^",7),0)),"^",7):+$P($G(^PSDRUG(PSADRG,1,+$P(PSADATA,"^",7),0)),"^",7),1:"") 176 D DISP^PSAP67 177 Q 1 PSAUP4 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data - CONT'D ;9/19/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,20,21**; 10/24/97 3 ;This routine prints invoices from the ^XTMP global on the screen or 4 ;to a printer. 5 ; 6 ;References to ^PSDRUG( are covered by IA #2095 7 ;References to ^DIC(51.5( are covered by IA #1931 8 ; 9 W !!,"Enter the device which will be used to print",!,"the invoices with all items, errors, and adjustments.",! 10 S %ZIS="Q" D ^%ZIS I POP S PSAOUT=1 Q 11 I $D(IO("Q")) S ZTDESC="Drug Acct. - Prime Vendor Invoice Upload Report",ZTRTN="DQ^PSAUP4" D ^%ZTLOAD Q 12 ; 13 DQ ;queue starts here 14 S IOM=80 15 D NOW^%DTC S Y=% D DD^%DT S PSARUN=$E(Y,1,18),$P(PSASLN,"-",80)="",$P(PSADLN,"=",80)="",(PSADJDRG,PSADJSUP,PSAOUT)=0,PSAFPG=1 16 U IO 17 S PSACTRL=0 F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL=""!(PSAOUT) D START 18 W @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q") 19 ; 20 EXIT ;Kills printing variables only 21 K %,%ZIS,DIR,DIRUT,PSAAECST,PSABY,PSACS,PSACTRL,PSADATA,PSADATE,PSADEC,PSADRG,PSADJDRG,PSADJORD,PSADJQTY,PSADJSUP,PSADLN,PSADS,PSAECOST,PSAEND,PSAFPG,PSAICOST,PSAIECST 22 K PSAIN,PSALINE,PSANDC,PSAODT,PSAODUZ,PSAOREA,PSAOUT,PSAPAGE,PSAPHARM,PSAQDT,PSAQDUZ,PSAQREA,PSAMV,PSARUN,PSAS,PSASLN,PSASS,PSAST,PSASTA,PSATOT,Y,ZTDESC,ZTRTN,ZTSK 23 Q 24 ; 25 START S PSAPAGE=1,PSAEND=0 D HEADER S PSAIN=$G(^XTMP("PSAPV",PSACTRL,"IN")) 26 S (PSADJDRG,PSADJSUP,PSAIECST,PSAAECST)=0,PSAPHARM=$P(PSAIN,"^",7),PSAMV=$P(PSAIN,"^",12) 27 W !,"PRIME VENDOR : ",$S($P($G(^XTMP("PSAPV",PSACTRL,"DS")),"^")'="":$P($G(^("DS")),"^"),1:"UNKNOWN") 28 W !!,"ORDER# : "_$P(PSAIN,"^",4),?40,"ORDER DATE : "_$$DATE($P(PSAIN,"^",3)) 29 W !,"INVOICE#: "_$P(PSAIN,"^",2),?40,"INVOICE DATE: "_$$DATE(+PSAIN) 30 S PSASTA=$P(PSAIN,"^",8) 31 W !,"STATUS : "_$S(PSASTA="":"UPLOADED WITH ERRORS",PSASTA="OK":"UPLOADED WITHOUT ERRORS",PSASTA="P":"PROCESSED",1:"UNKNOWN")_$S($P(PSAIN,"^",13)="SUP":" (SUPPLY INVOICE)",1:"") 32 I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER 33 I $E(IOST,1,2)="C-" D LINE Q 34 W !!,"DELIVERY DATE REQUESTED: ",$$DATE($P(PSAIN,"^",5)) 35 W !,"DATE RECEIVED : "_$S(+$P(PSAIN,"^",11)&($$DATE(+$P(PSAIN,"^",11))):" ("_$$DATE($P(PSAIN,"^",6))_")",1:$$DATE($P(PSAIN,"^",6))) 36 I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:$G(PSAOUT) D HEADER 37 ; 38 BUYSHIP W !!,"BUYER INFORMATION:",?40,"SHIPPING INFORMATION:" 39 S PSABY=$G(^XTMP("PSAPV",PSACTRL,"BY")) 40 S PSAST=$G(^XTMP("PSAPV",PSACTRL,"ST")) 41 W !?2,$P(PSABY,"^"),?42,$P(PSAST,"^") 42 I $P(PSABY,"^",2)'=""!($P(PSAST,"^",2)'="") W ! W:$P(PSABY,"^",2)'="" ?2,$P(PSABY,"^",2) W:$P(PSAST,"^",2)'="" ?42,$P(PSAST,"^",2) 43 I $P(PSABY,"^",3)'=""!($P(PSAST,"^",3)'="") W ! W:$P(PSABY,"^",3)'="" ?2,$P(PSABY,"^",3) W:$P(PSAST,"^",3)'="" ?42,$P(PSAST,"^",3) 44 W !?2,$P(PSABY,"^",4)_" "_$P(PSABY,"^",5)_" ",$P(PSABY,"^",6) 45 W ?42,$P(PSAST,"^",4)_" "_$P(PSAST,"^",5)_" ",$P(PSAST,"^",6) 46 I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER 47 ; 48 DISTRIB W !!,"DISTRIBUTOR INFORMATION:" 49 S PSADS=$G(^XTMP("PSAPV",PSACTRL,"DS")) 50 W !?2,$P(PSADS,"^") 51 W:$P(PSADS,"^",2)'="" !?2,$P(PSADS,"^",2) 52 W:$P(PSADS,"^",3)'="" !?2,$P(PSADS,"^",3) 53 W !?2,$P(PSADS,"^",4)_" "_$P(PSADS,"^",5)_" ",$P(PSADS,"^",6) 54 I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER 55 D LINE 56 Q 57 ; 58 DATE(PSADATE) ;convert date 59 S %=$E(PSADATE,4,5)_"/"_$E(PSADATE,6,7)_"/"_$E(PSADATE,2,3) 60 I $TR(%,"/")="" S %="UNKNOWN" 61 Q % 62 ; 63 LINE ;print line items 64 D LINEHDR 65 S (PSAICOST,PSALINE,PSATOT)=0 F S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:'PSALINE!(PSAOUT) S PSADATA=^(PSALINE),PSADRG=0 D Q:PSAOUT 66 .I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER,LINEHDR 67 .K PSADJQTY,PSAQDUZ,PSAQDT,PSAQREA,PSADJORD,PSAODUZ,PSAODT,PSAOREA 68 .W !,PSALINE 69 DRUG .;Drug 70 .I +$P(PSADATA,"^",15) S PSADRG=+$P(PSADATA,"^",15) W ?8,"*"_$P($G(^PSDRUG(+$P(PSADATA,"^",15),0)),"^")_$S(+$P(PSADATA,"^",6)&($P($G(^PSDRUG(+$P(PSADATA,"^",6),0)),"^")'=""):" ("_$P(^PSDRUG(+$P(PSADATA,"^",6),0),"^")_")",1:"") S PSADJDRG=1 71 .I PSADRG,$D(^PSDRUG(PSADRG,"I")) W !,?5,"** INACTIVE IN DRUG FILE **" 72 .I '+$P(PSADATA,"^",15) D 73 ..I +$P(PSADATA,"^",6),$P($G(^PSDRUG(+$P(PSADATA,"^",6),0)),"^")'="" W ?9,$P(^PSDRUG(+$P(PSADATA,"^",6),0),"^") S PSADRG=+$P(PSADATA,"^",6) Q 74 ..I $P($G(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")),"^",3)'="" W ?7,"**"_$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"),"^",3) S PSADJSUP=1,PSADRG=0 Q 75 ..W ?9,"DRUG UNKNOWN" 76 .I $P(PSADATA,"^",19)="CS" W " (CONTROLLED SUBS)" I $P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !?5,"*** INACTIVE IN MASTER VAULT" 77 .E I PSADRG,$P($G(^PSD(58.8,+$P(PSAIN,"^",7),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !?5,"*** INACTIVE IN PHARMACY LOCATION" 78 .;UPC 79 .I $P($P(PSADATA,"^",26),"~")'="" W !?9,"UPC: "_$P($P(PSADATA,"^",26),"~") 80 .;NDC 81 .S PSANDC=$P($P(PSADATA,"^",4),"~") 82 .I $E(PSANDC)'="S" D 83 ..W !?9 D PSANDC1^PSAHELP S PSANDC=PSANDCX 84 ..I PSANDC'="" W PSANDC Q 85 ..W "NDC UNKNOWN" 86 .; 87 .;VSN 88 .W ?25,$S($P($P(PSADATA,"^",5),"~")'="":$E($P($P(PSADATA,"^",5),"~"),1,14),1:"VSN UNKNOWN") 89 .; 90 .;QTY 91 .;No Adjusted Qty 92 .S PSAIECST=PSAIECST+($P(PSADATA,"^")*$P(PSADATA,"^",3)) 93 .I $P(PSADATA,"^",8)="" W ?40,$J($P(PSADATA,"^"),6) S PSAECOST=$P(PSADATA,"^")*$P(PSADATA,"^",3),PSAAECST=PSAAECST+PSAECOST 94 .;Adj. Qty (P) 95 .I $P(PSADATA,"^",8)'="" D 96 ..S PSADJQTY=$P(PSADATA,"^",8),PSAQDUZ=$P(PSADATA,"^",9),PSAQDT=$P(PSADATA,"^",10),PSAQREA=$P(PSADATA,"^",11) 97 ..S PSAECOST=PSADJQTY*$P(PSADATA,"^",3),PSAAECST=PSAAECST+PSAECOST 98 ..W ?40,$J($P(PSADATA,"^",8),6)_"("_$P(PSADATA,"^")_")" 99 .; 100 OU .;Order Unit 101 .I '+$P(PSADATA,"^",12) D 102 ..I +$P($P(PSADATA,"^",2),"~",2),$P($G(^DIC(51.5,+$P($P(PSADATA,"^",2),"~",2),0)),"^")'="" W ?53,$P($G(^DIC(51.5,+$P($P(PSADATA,"^",2),"~",2),0)),"^") Q 103 ..I $P($G(PSADATA),"^",2)'="",$P($G(PSADATA),"^",2)'["~",'$D(^DIC(51.5,"B",$P(PSADATA,"^",2))) W ?48," ?-> "_$P(PSADATA,"^",2) 104 ..I $P($P(PSADATA,"^",2),"~")="" D ^PSAHELP 105 .;Adj. OU (P) 106 .I +$P(PSADATA,"^",12) S PSADJORD=$P(PSADATA,"^",12),PSAODUZ=$P(PSADATA,"^",13),PSAODT=$P(PSADATA,"^",14) W ?53,$P($G(^DIC(51.5,+$P(PSADATA,"^",12),0)),"^")_"("_$P($P(PSADATA,"^",2),"~")_")" 107 .;Unit price 108 .S PSADEC=$S($L($P($P(PSADATA,"^",3),".",2))>1:$L($P($P(PSADATA,"^",3),".",2)),1:2) 109 .W ?59,$J($P(PSADATA,"^",3),7,PSADEC) 110 .;Extended cost 111 .W ?67,$J(PSAECOST,12,2) 112 .I $Y+9>IOSL,+$P(PSADATA,"^",21),+$P(PSADATA,"^",27) D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER,LINEHDR 113 .I $G(PSADRG) D HAVEDRG 114 .I '$G(PSADRG) W !?9,"STOCK LEVEL : ",!?9,"REORDER LEVEL: "_$P(PSADATA,"^",21),!?9,"DISPENSE UNITS/ORDER UNIT: " 115 .; 116 .;Print Adj Qty 117 .I $G(PSADJQTY)'="" D 118 ..I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER,LINEHDR 119 ..W !!?9,"ADJUSTED QUANTITY: "_PSADJQTY,!?9,$$DATE(PSAQDT)_" "_$P($G(^VA(200,+PSAQDUZ,0)),"^"),!?11,PSAQREA 120 .;Print Adj OU 121 .I +$G(PSADJORD) D 122 ..I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER,LINEHDR 123 ..W !!,?9,"ADJUSTED ORDER UNIT: "_$P($G(^DIC(51.5,+PSADJORD,0)),"^") 124 ..W !?9,$$DATE(PSAODT)_" "_$P($G(^VA(200,+PSAODUZ,0)),"^")_" - "_$P($G(^DIC(51.5,PSADJORD,0)),"^") 125 .W ! 126 Q:PSAOUT 127 I $Y+6>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER 128 W !,PSASLN 129 W:$G(PSAAECST)'=$G(PSAIECST) !?48,"TOTAL ADUSTED COST",?67,$J(PSAAECST,12,2),! 130 W !?48,"TOTAL INVOICED COST",?67,$J(PSAIECST,12,2) 131 S PSAEND=1 132 I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER 133 I PSADJDRG,$E(IOST)'="C" W !!,"* THE DRUG WAS MATCHED TO THE DRUG FILE." 134 I PSADJSUP,$E(IOST)'="C" W !!,"* THE ITEM IS A SUPPLY ITEM." 135 D:$E(IOST,1,2)="C-" SCREEN 136 Q 137 ; 138 LINEHDR ;item header 139 W !?50,"ORDER",?62,"COST/",?71,"EXTENDED" 140 W !,"LINE#",?9,"NDC",?25,"VSN",?43,"QTY",?51,"UNIT",?62,"UNIT",?75,"COST",!,PSADLN,! 141 Q 142 ; 143 HEADER ;Page header 144 I PSAFPG&($E(IOST,1,2)="C-") W @IOF G HDR1 145 S PSAFPG=0 146 W:'PSAFPG @IOF 147 HDR1 W !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE" 148 W !?26,"PRIME VENDOR UPLOAD REPORT",! 149 W:PSAPAGE'=1 !,"ORDER#: "_$P(PSAIN,"^",4)_" INVOICE#: "_$P(PSAIN,"^",2) 150 I $E(IOST,1,2)="C-" W ?(74-$L(PSAPAGE)),"PAGE "_PSAPAGE,!,PSADLN 151 I $E(IOST)'="C" W !,"RUN: "_PSARUN,?(74-$L(PSAPAGE)),"PAGE "_PSAPAGE,!,PSADLN 152 S PSAPAGE=PSAPAGE+1 153 Q 154 SCREEN ;Hold on screen 155 S PSAS=20-$Y I PSAS F PSASS=1:1:PSAS W ! 156 I PSADJDRG,PSAEND W !," * THE DRUG WAS MATCHED TO THE DRUG FILE." 157 I PSADJSUP,PSAEND W !,"** THE ITEM IS A SUPPLY ITEM." 158 S DIR(0)="E" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 159 Q 160 ; 161 HAVEDRG ;Display data if drug is found. 162 ;DAVE B (PSA*3*20) 7SEP99 ADDED $G TO NEXT LINE 163 S PSACS=$S($P($G(^PSDRUG(PSADRG,2)),"^",3)["N":1,1:0) 164 I PSACS D 165 .I PSAMV,+$P($G(^PSD(58.8,PSAMV,0)),"^",14) D Q 166 ..W !?9,"STOCK LEVEL : "_$S(+$P(PSADATA,"^",27):+$P(PSADATA,"^",27),1:+$P($G(^PSD(58.8,PSAMV,1,PSADRG,0)),"^",3)) 167 ..W !?9,"REORDER LEVEL: "_$S(+$P(PSADATA,"^",21):+$P(PSADATA,"^",21),1:+$P($G(^PSD(58.8,PSAMV,1,PSADRG,0)),"^",5)) 168 .I 'PSAMV W !?9,"STOCK LEVEL : "_$P(PSADATA,"^",27),!?9,"REORDER LEVEL: "_$P(PSADATA,"^",21) 169 I 'PSACS D 170 .I PSAPHARM,+$P($G(^PSD(58.8,PSAPHARM,0)),"^",14) D 171 ..W !?9,"STOCK LEVEL : "_$S(+$P(PSADATA,"^",27):+$P(PSADATA,"^",27),1:+$P($G(^PSD(58.8,PSAPHARM,1,PSADRG,0)),"^",3)) 172 ..W !?9,"REORDER LEVEL: "_$S(+$P(PSADATA,"^",21):+$P(PSADATA,"^",21),1:+$P($G(^PSD(58.8,PSAPHARM,1,PSADRG,0)),"^",5)) 173 .I 'PSAPHARM W !?9,"STOCK LEVEL : "_$P(PSADATA,"^",27),!?9,"REORDER LEVEL: "_$P(PSADATA,"^",21) 174 W !?9,"DISPENSE UNITS/ORDER UNIT: " 175 W $S(+$P(PSADATA,"^",20):+$P(PSADATA,"^",20),+$P($G(^PSDRUG(PSADRG,1,+$P(PSADATA,"^",7),0)),"^",7):+$P($G(^PSDRUG(PSADRG,1,+$P(PSADATA,"^",7),0)),"^",7),1:"") 176 Q -
WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAUTL1.m
r613 r623 1 PSAUTL1 ;BIR/JMB-Prime Vendor Invoice Data Utility ;9/19/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,15,21,48,49,54,67**; 10/24/97;Build 15 3 ;This routine contains utilities to get the location name, display an 4 ;error-free item, display an item with errors, and display a line ready 5 ;for verification. 6 ;References to global ^PS(59.4, are covered under IA #2505 7 ;References to global ^DIC(51.5, are covered under IA #1931 8 ;References to global ^PS(59, are covered under IA #212 9 ;References to ^PSDRUG( are covered by IA #2095 10 ; 11 SITES ;Gets the combined IP/OP's IP & OP site names 12 ;PSA*3*22 (DAVE B) no location defined 13 I $G(PSALOC)'>0 S (PSAISITN,PSAOSITN)="Unknown",PSACOMB=" No location identified" Q 14 ;End PSA*3*22 15 S PSAISIT=+$P($G(^PSD(58.8,PSALOC,0)),"^",3) D OPSITE 16 I $G(PSAOSIT)="" S PSAOSIT=0 17 S PSAISITN=$S($P($G(^PS(59.4,PSAISIT,0)),"^")'="":$P($G(^PS(59.4,PSAISIT,0)),"^"),1:"UNKNOWN") 18 I PSAISIT,PSAOSIT S PSACOMB=": "_PSAISITN_" (IP) "_PSAOSITN_" (OP)" Q 19 I PSAISIT S PSACOMB=": "_PSAISITN_" (IP)" Q 20 I PSAOSIT S PSACOMB=": "_PSAOSITN_" (OP)" Q 21 ;DAVE B (PSA*3*12) no DA sites defined 22 S PSACOMB="No Inpatient or Outpatient Sites defined" 23 Q 24 OPSITE ;PSA*3*25 - check for multiple OP sites 25 ;VMP OIFO BAY PINES;ELR;PSA*3*49 ADDED THE FOLLOWING LINE 26 S (PSAOSIT,PSAOSITN)="" 27 K PSAOSITC 28 Q:'$D(PSALOC) 29 I '$D(^PSD(58.8,+PSALOC,7)),$P(^PSD(58.8,+PSALOC,0),"^",10)'="" S PSAOSIT=$P(^PSD(58.8,+PSALOC,0),"^",10),PSAOSITN=$P($G(^PS(59,PSAOSIT,0)),"^"),PSAOSITN=$S($G(PSAOSITN)="":"Unknown",1:PSAOSITN) 30 S XX=0 F S XX=$O(^PSD(58.8,+PSALOC,7,XX)) Q:XX'>0 S PSAOSIT=XX,PSAOSITC=$G(PSAOSITC)+1,SN=$P($G(^PS(59,XX,0)),"^") D 31 .I PSAOSITC=1 S PSAOSITN=SN Q 32 .S PSAOSITN=PSAOSITN_" & "_SN 33 I $G(PSAOSITN)="",$P(^PSD(58.8,+PSALOC,0),"^",10)'="" S PSAOSIT=$P(^PSD(58.8,+PSALOC,0),"^",10),PSAOSITN=$P($G(^PS(59,+PSAOSIT,0)),"^") 34 S PSAOSITN=$S($G(PSAOSITN)="":"unknown",1:PSAOSITN) 35 Q 36 ; 37 DISPLAY ;Displays an error-free line item 38 S PSADISP=1 39 S PSAIEN=$P(PSADATA,"^",6),PSASUB=$P($P(PSADATA,"^",7),"~"),PSANDC=$P($P(PSADATA,"^",4),"~"),PSAVSN=$P($P(PSADATA,"^",5),"~") 40 W !,PSALINE_" "_$S($P($G(^PSDRUG(PSAIEN,0)),"^")'="":$P(^PSDRUG(PSAIEN,0),"^"),1:"UNKNOWN") 41 I PSAIEN D 42 .I $P($G(^PSDRUG(PSAIEN,2)),"^",3)["N" W " (Controlled Substance)" I $P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSAIEN,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !,$C(7),$C(7),"** INACTIVE IN MASTER VAULT **" Q 43 .I $P($G(^PSD(58.8,+$P(PSAIN,"^",7),1,PSAIEN,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !,$C(7),$C(7),"** INACTIVE IN PHARMACY LOCATION **" 44 .I $D(^PSDRUG(PSAIEN,"I")) W !?5,"** INACTIVE IN DRUG FILE **" 45 W !,"Qty Invoiced: "_+$P(PSADATA,"^") 46 W:$P($P(PSADATA,"^",26),"~")'="" ?38,"UPC: "_$P($P(PSADATA,"^",26),"~") 47 W !,"Order Unit : " 48 S PSAOU=$S(+$P(PSADATA,"^",12):+$P(PSADATA,"^",12),+$P($P(PSADATA,"^",2),"~",2):+$P($P(PSADATA,"^",2),"~",2),PSAIEN&(PSASUB)&(+$P($G(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",5)):+$P(^PSDRUG(PSAIEN,1,PSASUB,0),"^",5),1:0) 49 W $S(PSAOU:$P($G(^DIC(51.5,+PSAOU,0)),"^"),1:"UNKNOWN") 50 W:$E(PSANDC)'="S" ?38,"NDC: " D PSANDC1^PSAHELP W PSANDCX K PSANDCX 51 W !,"Unit Price : $"_$P(PSADATA,"^",3),?38,"VSN: "_$S(PSAVSN'="":PSAVSN,1:"Blank"),! 52 I $P(PSADATA,U,13)=.5 D ;*48 AUTO OU UPDATE FOR MCKESSON 53 .W !,"*****>",!,"Note: The order unit was changed from EACH to ",$P($G(^DIC(51.5,+PSAOU,0)),"^")," by Drug Accountability" 54 .W !," during the upload of the invoiced data. Adjustments may be necessary.",!,"*****<" 55 ;bgn *67 56 W !,"PV-Drug-Description : ",$S($P(PSADATA,"^",28)'="":$P(PSADATA,"^",28),1:"Unknown") 57 W ?55,"PV-DUOU : ",$S($P(PSADATA,"^",31)'="":$P(PSADATA,"^",31),1:"Unknown") 58 W !,"PV-Drug-Generic Name : ",$S($P(PSADATA,"^",29)'="":$P(PSADATA,"^",29),1:"Unknown") 59 W ?55,"PV-UNITS : ",$S($P(PSADATA,"^",30)'="":$P(PSADATA,"^",30),1:"Unknown"),! 60 ;end *67 61 W !,"Dispense Units: "_$S(+PSAIEN&($P($G(^PSDRUG(+PSAIEN,660)),"^",8)'=""):$P($G(^PSDRUG(+PSAIEN,660)),"^",8),1:"Blank") 62 W !,"Dispense Units Per Order Unit: "_$S($P(PSADATA,"^",20):+$P(PSADATA,"^",20),+PSASUB&(+$P($G(^PSDRUG(+PSAIEN,1,PSASUB,0)),"^",7)):+$P($G(^PSDRUG(+PSAIEN,1,PSASUB,0)),"^",7),1:"Blank") 63 S PSALOC=$S($P(PSADATA,"^",19)="":+$P(PSAIN,"^",7),1:+$P(PSAIN,"^",12)) 64 Q:'+$P($G(^PSD(58.8,+PSALOC,0)),"^",14)!('$G(PSAIEN)) 65 S PSASTOCK=$S(+$P(PSADATA,"^",27):+$P(PSADATA,"^",27),+$P($G(^PSD(58.8,+PSALOC,1,+PSAIEN,0)),"^",3):+$P($G(^PSD(58.8,+PSALOC,1,+PSAIEN,0)),"^",3),1:"Blank") 66 W !,"Stock Level : "_PSASTOCK 67 S PSAREORD=$S(+$P(PSADATA,"^",21):+$P(PSADATA,"^",21),+$P($G(^PSD(58.8,+PSALOC,1,+PSAIEN,0)),"^",5):+$P($G(^PSD(58.8,+PSALOC,1,+PSAIEN,0)),"^",5),1:"Blank") ;*48 68 W !,"Reorder Level : "_PSAREORD,! 69 Q 70 ; 71 EDITDISP ;Displays a line item with errors. 72 W @IOF,!?23,"<<< PROCESS LINE ITEM SCREEN >>>",!,"Order#: "_$P(PSAIN,"^",4)_" Invoice#: "_$P(PSAIN,"^",2)_" Invoice Date: "_$$FMTE^XLFDT(+PSAIN),!,PSASLN 73 EDIT1 S PSADATA=$G(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) 74 S PSASUB=+$P(PSADATA,"^",7) ;*54 75 S PSAIEN=+$P(PSADATA,"^",15) I PSAIEN ;*54 76 E S PSAIEN=+$P(PSADATA,"^",6) ;*54 77 S PSALOC=$S($P(PSADATA,"^",19)="":+$P(PSAIN,"^",7),1:+$P(PSAIN,"^",12)) 78 W !,PSALINE_" "_$S($D(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")):$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"),"^",3),PSAIEN&($P($G(^PSDRUG(PSAIEN,0)),"^")'=""):$P(^PSDRUG(PSAIEN,0),"^"),1:"UNKNOWN ITEM") 79 I PSAIEN D 80 .I $P($G(^PSDRUG(PSAIEN,2)),"^",3)["N" W " (Controlled Substance)" I $P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSAIEN,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !,$C(7),$C(7),"** INACTIVE IN MASTER VAULT **" Q 81 .I $P($G(^PSD(58.8,+$P(PSAIN,"^",7),1,PSAIEN,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !,$C(7),$C(7),"** INACTIVE IN PHARMACY LOCATION **" 82 ; 83 W !,"Qty Invoiced: " 84 I $P(PSADATA,"^",8)'="" W $P(PSADATA,"^",8)_" ("_$S(+PSADATA:+PSADATA,$P(PSADATA,"^")=0:0,1:"Blank")_")" 85 I $P(PSADATA,"^",8)="" W $S(+PSADATA:+PSADATA,$P(PSADATA,"^")=0:0,1:"Blank") 86 W:$P($P(PSADATA,"^",26),"~")'="" ?38,"UPC: "_$P($P(PSADATA,"^",26),"~") 87 ; 88 W !,"Order Unit : " 89 I +$P(PSADATA,"^",12) D 90 .W $P($G(^DIC(51.5,+$P(PSADATA,"^",12),0)),"^") 91 .W " ("_$S($P($P(PSADATA,"^",2),"~")'="":$P($P(PSADATA,"^",2),"~"),$P($G(^DIC(51.5,+$P($P(PSADATA,"^",2),"~",3),0)),"^")'="":$P($G(^DIC(51.5,+$P($P(PSADATA,"^",2),"~",3),0)),"^"),1:"Blank")_")" 92 I '+$P(PSADATA,"^",12) D 93 .W $S(+$P($P(PSADATA,"^",2),"~",2):$P($P(PSADATA,"^",2),"~"),PSAIEN&(PSASUB)&(+$P($G(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",5)):$P($G(^DIC(51.5,+$P(^PSDRUG(PSAIEN,1,PSASUB,0),"^",5),0)),"^"),1:"Blank") 94 ; 95 W:$E(PSANDC)'="S" ?38,"NDC: " D PSANDC1^PSAHELP W PSANDCX K PSANDCX 96 S PSAPRICE=$P(PSADATA,"^",3) 97 I +PSAPRICE,$L($P(PSAPRICE,".",2))<2 S PSAPRICE=$P(PSAPRICE,".")_"."_$P(PSAPRICE,".",2)_$E("00",1,(2-$L($P(PSAPRICE,".",2)))) 98 W !,"Unit Price : $"_$S($G(PSAPRICE):PSAPRICE,PSAPRICE=0:0,1:"Blank"),?38,"VSN: "_$S(PSAVSN'="":PSAVSN,1:"Blank"),! 99 I $P(PSADATA,U,13)=.5 D ;*48 AUTO OU UPDATE FOR MCKESSON 100 .N PSAOU S PSAOU=$P(PSADATA,U,12) 101 .W !,"*****>",!,"Note: The order unit was changed from EACH to ",$P($G(^DIC(51.5,+PSAOU,0)),"^")," by Drug Accountability" 102 .W !," during the upload of the invoiced data. Adjustments may be necessary.",!,"*****<" 103 ;bgn *67 104 W !,"PV-Drug-Description : ",$S($P(PSADATA,"^",28)'="":$P(PSADATA,"^",28),1:"Unknown") 105 W ?55,"PV-DUOU : ",$S($P(PSADATA,"^",31)'="":$P(PSADATA,"^",31),1:"Unknown") 106 W !,"PV-Drug-Generic Name : ",$S($P(PSADATA,"^",29)'="":$P(PSADATA,"^",29),1:"Unknown") 107 W ?55,"PV-UNITS : ",$S($P(PSADATA,"^",30)'="":$P(PSADATA,"^",30),1:"Unknown"),! 108 ;end *67 109 S PSAIN=^XTMP("PSAPV",PSACTRL,"IN"),PSALOC=$S($P(PSADATA,"^",19)="CS":+$P(PSAIN,"^",12),1:+$P(PSAIN,"^",7)) 110 DU W !,"Dispense Units: "_$S(+PSAIEN&($P($G(^PSDRUG(+PSAIEN,660)),"^",8)'=""):$P($G(^PSDRUG(+PSAIEN,660)),"^",8),1:"Blank") 111 DUOU W !,"Dispense Units Per Order Unit: "_$S($P(PSADATA,"^",20):+$P(PSADATA,"^",20),+PSASUB&(+$P($G(^PSDRUG(+PSAIEN,1,PSASUB,0)),"^",7)):+$P($G(^PSDRUG(+PSAIEN,1,PSASUB,0)),"^",7),1:"Blank"),! 112 ; 113 Q:'+$P($G(^PSD(58.8,+PSALOC,0)),"^",14) 114 ; 115 S PSASTOCK=$S(+$P(PSADATA,"^",27):+$P(PSADATA,"^",27),+$P($G(^PSD(58.8,+PSALOC,1,+PSAIEN,0)),"^",3):+$P($G(^PSD(58.8,+PSALOC,1,+PSAIEN,0)),"^",3),1:"Blank") 116 W "Stock Level : "_PSASTOCK 117 S PSAREORD=$S(+$P(PSADATA,"^",21):+$P(PSADATA,"^",21),+$P($G(^PSD(58.8,+PSALOC,1,+PSAIEN,0)),"^",5):+$P($G(^PSD(58.8,+PSALOC,1,+PSAIEN,0)),"^",5),1:"Blank") 118 W !,"Reorder Level : "_PSAREORD,! 119 Q 1 PSAUTL1 ;BIR/JMB-Prime Vendor Invoice Data Utility ;9/19/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,15,21,48,49,54**; 10/24/97 3 ;This routine contains utilities to get the location name, display an 4 ;error-free item, display an item with errors, and display a line ready 5 ;for verification. 6 ;References to global ^PS(59.4, are covered under IA #2505 7 ;References to global ^DIC(51.5, are covered under IA #1931 8 ;References to global ^PS(59, are covered under IA #212 9 ;References to ^PSDRUG( are covered by IA #2095 10 ; 11 SITES ;Gets the combined IP/OP's IP & OP site names 12 ;PSA*3*22 (DAVE B) no location defined 13 I $G(PSALOC)'>0 S (PSAISITN,PSAOSITN)="Unknown",PSACOMB=" No location identified" Q 14 ;End PSA*3*22 15 S PSAISIT=+$P($G(^PSD(58.8,PSALOC,0)),"^",3) D OPSITE 16 I $G(PSAOSIT)="" S PSAOSIT=0 17 S PSAISITN=$S($P($G(^PS(59.4,PSAISIT,0)),"^")'="":$P($G(^PS(59.4,PSAISIT,0)),"^"),1:"UNKNOWN") 18 I PSAISIT,PSAOSIT S PSACOMB=": "_PSAISITN_" (IP) "_PSAOSITN_" (OP)" Q 19 I PSAISIT S PSACOMB=": "_PSAISITN_" (IP)" Q 20 I PSAOSIT S PSACOMB=": "_PSAOSITN_" (OP)" Q 21 ;DAVE B (PSA*3*12) no DA sites defined 22 S PSACOMB="No Inpatient or Outpatient Sites defined" 23 Q 24 OPSITE ;PSA*3*25 - check for multiple OP sites 25 ;VMP OIFO BAY PINES;ELR;PSA*3*49 ADDED THE FOLLOWING LINE 26 S (PSAOSIT,PSAOSITN)="" 27 K PSAOSITC 28 Q:'$D(PSALOC) 29 I '$D(^PSD(58.8,+PSALOC,7)),$P(^PSD(58.8,+PSALOC,0),"^",10)'="" S PSAOSIT=$P(^PSD(58.8,+PSALOC,0),"^",10),PSAOSITN=$P($G(^PS(59,PSAOSIT,0)),"^"),PSAOSITN=$S($G(PSAOSITN)="":"Unknown",1:PSAOSITN) 30 S XX=0 F S XX=$O(^PSD(58.8,+PSALOC,7,XX)) Q:XX'>0 S PSAOSIT=XX,PSAOSITC=$G(PSAOSITC)+1,SN=$P($G(^PS(59,XX,0)),"^") D 31 .I PSAOSITC=1 S PSAOSITN=SN Q 32 .S PSAOSITN=PSAOSITN_" & "_SN 33 I $G(PSAOSITN)="",$P(^PSD(58.8,+PSALOC,0),"^",10)'="" S PSAOSIT=$P(^PSD(58.8,+PSALOC,0),"^",10),PSAOSITN=$P($G(^PS(59,+PSAOSIT,0)),"^") 34 S PSAOSITN=$S($G(PSAOSITN)="":"unknown",1:PSAOSITN) 35 Q 36 ; 37 DISPLAY ;Displays an error-free line item 38 S PSADISP=1 39 S PSAIEN=$P(PSADATA,"^",6),PSASUB=$P($P(PSADATA,"^",7),"~"),PSANDC=$P($P(PSADATA,"^",4),"~"),PSAVSN=$P($P(PSADATA,"^",5),"~") 40 W !,PSALINE_" "_$S($P($G(^PSDRUG(PSAIEN,0)),"^")'="":$P(^PSDRUG(PSAIEN,0),"^"),1:"UNKNOWN") 41 I PSAIEN D 42 .I $P($G(^PSDRUG(PSAIEN,2)),"^",3)["N" W " (Controlled Substance)" I $P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSAIEN,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !,$C(7),$C(7),"** INACTIVE IN MASTER VAULT **" Q 43 .I $P($G(^PSD(58.8,+$P(PSAIN,"^",7),1,PSAIEN,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !,$C(7),$C(7),"** INACTIVE IN PHARMACY LOCATION **" 44 .I $D(^PSDRUG(PSAIEN,"I")) W !?5,"** INACTIVE IN DRUG FILE **" 45 W !,"Qty Invoiced: "_+$P(PSADATA,"^") 46 W:$P($P(PSADATA,"^",26),"~")'="" ?38,"UPC: "_$P($P(PSADATA,"^",26),"~") 47 W !,"Order Unit : " 48 S PSAOU=$S(+$P(PSADATA,"^",12):+$P(PSADATA,"^",12),+$P($P(PSADATA,"^",2),"~",2):+$P($P(PSADATA,"^",2),"~",2),PSAIEN&(PSASUB)&(+$P($G(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",5)):+$P(^PSDRUG(PSAIEN,1,PSASUB,0),"^",5),1:0) 49 W $S(PSAOU:$P($G(^DIC(51.5,+PSAOU,0)),"^"),1:"UNKNOWN") 50 W:$E(PSANDC)'="S" ?38,"NDC: " D PSANDC1^PSAHELP W PSANDCX K PSANDCX 51 W !,"Unit Price : $"_$P(PSADATA,"^",3),?38,"VSN: "_$S(PSAVSN'="":PSAVSN,1:"Blank"),! 52 I $P(PSADATA,U,13)=.5 D ;*48 AUTO OU UPDATE FOR MCKESSON 53 . W !,"*****>",!,"Note: The order unit was changed from EACH to ",$P($G(^DIC(51.5,+PSAOU,0)),"^")," by Drug Accountability" 54 . W !," during the upload of the invoiced data. Adjustments may be necessary.",!,"*****<" 55 ;*54 display VSN XTMP Drug Description and DUOU >==> 56 N PSAFLDT S PSAFLDT="February 2006" 57 N XXX S XXX=$G(^XTMP("PSAVSN",PSAVSN)) D 58 . I $G(^XTMP("PSAVSN",0)) S PSAFLDT=$P(^XTMP("PSAVSN",0),"^",4) 59 . W !,"PV-Drug-Descrip: " 60 . I '$L(XXX) W "Not Available. Item is OTC or new after ",PSAFLDT,! Q 61 . W ?20,$P(XXX,"~",2),?55,"PV-DUOU: ",+XXX,! 62 ;*54 display VSN XTMP Drug Description and DUOU <==< 63 W !,"Dispense Units: "_$S(+PSAIEN&($P($G(^PSDRUG(+PSAIEN,660)),"^",8)'=""):$P($G(^PSDRUG(+PSAIEN,660)),"^",8),1:"Blank") 64 W !,"Dispense Units Per Order Unit: "_$S($P(PSADATA,"^",20):+$P(PSADATA,"^",20),+PSASUB&(+$P($G(^PSDRUG(+PSAIEN,1,PSASUB,0)),"^",7)):+$P($G(^PSDRUG(+PSAIEN,1,PSASUB,0)),"^",7),1:"Blank") 65 S PSALOC=$S($P(PSADATA,"^",19)="":+$P(PSAIN,"^",7),1:+$P(PSAIN,"^",12)) 66 Q:'+$P($G(^PSD(58.8,+PSALOC,0)),"^",14)!('$G(PSAIEN)) 67 S PSASTOCK=$S(+$P(PSADATA,"^",27):+$P(PSADATA,"^",27),+$P($G(^PSD(58.8,+PSALOC,1,+PSAIEN,0)),"^",3):+$P($G(^PSD(58.8,+PSALOC,1,+PSAIEN,0)),"^",3),1:"Blank") 68 W !,"Stock Level : "_PSASTOCK 69 S PSAREORD=$S(+$P(PSADATA,"^",21):+$P(PSADATA,"^",21),+$P($G(^PSD(58.8,+PSALOC,1,+PSAIEN,0)),"^",5):+$P($G(^PSD(58.8,+PSALOC,1,+PSAIEN,0)),"^",5),1:"Blank") ;*48 70 W !,"Reorder Level : "_PSAREORD,! 71 Q 72 ; 73 EDITDISP ;Displays a line item with errors. 74 W @IOF,!?23,"<<< PROCESS LINE ITEM SCREEN >>>",!,"Order#: "_$P(PSAIN,"^",4)_" Invoice#: "_$P(PSAIN,"^",2)_" Invoice Date: "_$$FMTE^XLFDT(+PSAIN),!,PSASLN 75 EDIT1 S PSADATA=$G(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) 76 S PSASUB=+$P(PSADATA,"^",7) ;*54 77 S PSAIEN=+$P(PSADATA,"^",15) I PSAIEN ;*54 78 E S PSAIEN=+$P(PSADATA,"^",6) ;*54 79 S PSALOC=$S($P(PSADATA,"^",19)="":+$P(PSAIN,"^",7),1:+$P(PSAIN,"^",12)) 80 W !,PSALINE_" "_$S($D(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")):$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"),"^",3),PSAIEN&($P($G(^PSDRUG(PSAIEN,0)),"^")'=""):$P(^PSDRUG(PSAIEN,0),"^"),1:"UNKNOWN ITEM") 81 I PSAIEN D 82 .I $P($G(^PSDRUG(PSAIEN,2)),"^",3)["N" W " (Controlled Substance)" I $P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSAIEN,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !,$C(7),$C(7),"** INACTIVE IN MASTER VAULT **" Q 83 .I $P($G(^PSD(58.8,+$P(PSAIN,"^",7),1,PSAIEN,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !,$C(7),$C(7),"** INACTIVE IN PHARMACY LOCATION **" 84 ; 85 W !,"Qty Invoiced: " 86 I $P(PSADATA,"^",8)'="" W $P(PSADATA,"^",8)_" ("_$S(+PSADATA:+PSADATA,$P(PSADATA,"^")=0:0,1:"Blank")_")" 87 I $P(PSADATA,"^",8)="" W $S(+PSADATA:+PSADATA,$P(PSADATA,"^")=0:0,1:"Blank") 88 W:$P($P(PSADATA,"^",26),"~")'="" ?38,"UPC: "_$P($P(PSADATA,"^",26),"~") 89 ; 90 W !,"Order Unit : " 91 I +$P(PSADATA,"^",12) D 92 .W $P($G(^DIC(51.5,+$P(PSADATA,"^",12),0)),"^") 93 .W " ("_$S($P($P(PSADATA,"^",2),"~")'="":$P($P(PSADATA,"^",2),"~"),$P($G(^DIC(51.5,+$P($P(PSADATA,"^",2),"~",3),0)),"^")'="":$P($G(^DIC(51.5,+$P($P(PSADATA,"^",2),"~",3),0)),"^"),1:"Blank")_")" 94 I '+$P(PSADATA,"^",12) D 95 .W $S(+$P($P(PSADATA,"^",2),"~",2):$P($P(PSADATA,"^",2),"~"),PSAIEN&(PSASUB)&(+$P($G(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",5)):$P($G(^DIC(51.5,+$P(^PSDRUG(PSAIEN,1,PSASUB,0),"^",5),0)),"^"),1:"Blank") 96 ; 97 W:$E(PSANDC)'="S" ?38,"NDC: " D PSANDC1^PSAHELP W PSANDCX K PSANDCX 98 S PSAPRICE=$P(PSADATA,"^",3) 99 I +PSAPRICE,$L($P(PSAPRICE,".",2))<2 S PSAPRICE=$P(PSAPRICE,".")_"."_$P(PSAPRICE,".",2)_$E("00",1,(2-$L($P(PSAPRICE,".",2)))) 100 W !,"Unit Price : $"_$S($G(PSAPRICE):PSAPRICE,PSAPRICE=0:0,1:"Blank"),?38,"VSN: "_$S(PSAVSN'="":PSAVSN,1:"Blank"),! 101 I $P(PSADATA,U,13)=.5 D ;*48 AUTO OU UPDATE FOR MCKESSON 102 . N PSAOU S PSAOU=$P(PSADATA,U,12) 103 . W !,"*****>",!,"Note: The order unit was changed from EACH to ",$P($G(^DIC(51.5,+PSAOU,0)),"^")," by Drug Accountability" 104 . W !," during the upload of the invoiced data. Adjustments may be necessary.",!,"*****<" 105 N PSAFLDT S PSAFLDT="February 2006" 106 N XXX S XXX=$G(^XTMP("PSAVSN",PSAVSN)) D 107 .I $G(^XTMP("PSAVSN",0)) S PSAFLDT=$P(^XTMP("PSAVSN",0),"^",4) 108 . W !,"PV-Drug-Descrip: " 109 . I '$L(XXX) W "Not Available. Item is OTC or new after ",PSAFLDT,! Q 110 . W ?20,$P(XXX,"~",2),?55,"PV-DUOU: ",+XXX,! 111 ;*54 display VSN XTMP Drug Description and DUOU <==< 112 S PSAIN=^XTMP("PSAPV",PSACTRL,"IN"),PSALOC=$S($P(PSADATA,"^",19)="CS":+$P(PSAIN,"^",12),1:+$P(PSAIN,"^",7)) 113 DU W !,"Dispense Units: "_$S(+PSAIEN&($P($G(^PSDRUG(+PSAIEN,660)),"^",8)'=""):$P($G(^PSDRUG(+PSAIEN,660)),"^",8),1:"Blank") 114 DUOU W !,"Dispense Units Per Order Unit: "_$S($P(PSADATA,"^",20):+$P(PSADATA,"^",20),+PSASUB&(+$P($G(^PSDRUG(+PSAIEN,1,PSASUB,0)),"^",7)):+$P($G(^PSDRUG(+PSAIEN,1,PSASUB,0)),"^",7),1:"Blank"),! 115 ; 116 Q:'+$P($G(^PSD(58.8,+PSALOC,0)),"^",14) 117 ; 118 S PSASTOCK=$S(+$P(PSADATA,"^",27):+$P(PSADATA,"^",27),+$P($G(^PSD(58.8,+PSALOC,1,+PSAIEN,0)),"^",3):+$P($G(^PSD(58.8,+PSALOC,1,+PSAIEN,0)),"^",3),1:"Blank") 119 W "Stock Level : "_PSASTOCK 120 S PSAREORD=$S(+$P(PSADATA,"^",21):+$P(PSADATA,"^",21),+$P($G(^PSD(58.8,+PSALOC,1,+PSAIEN,0)),"^",5):+$P($G(^PSD(58.8,+PSALOC,1,+PSAIEN,0)),"^",5),1:"Blank") 121 W !,"Reorder Level : "_PSAREORD,! 122 Q -
WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAUTL4.m
r613 r623 1 PSAUTL4 ;BIR ISC/JMB-Verify Invoices Utility ; 8/19/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21,48,54,61,67**; 10/24/97;Build 15 3 ; 4 ;References to ^DIC(51.5 are covered by IA #1931 5 ;References to ^PSDRUG( are covered by IA #2095 6 I $G(PSADICW)=1 S PSALINE=Y 7 ;This routine contains a utility to display a line item ready for 8 ;verification. It is called by PSAVER1 and PSAVER2. 9 ; 10 VERDISP ;Displays a line item on a processed or verified invoice 11 W PSALINEN_" " 12 DRUG S PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","D",0)) 13 I $G(PSADJ) D 14 .S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)) 15 .S PSADJD=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 16 .I PSADJD'?1.N S PSASUP=1 17 .S PSADRG=$S(PSADJ&('PSASUP):$G(PSADJD),PSADJ&(PSASUP):0,1:+$P(PSADATA,"^",2)) 18 .I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")'="" W "*"_$P($G(^PSDRUG(+PSADJD,0)),"^") S (PSADRG,PSA50IEN)=+PSADJD Q 19 .I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")="" S (PSADJ,PSADRG)=0 Q 20 .W ?7,"**"_PSADJD S PSADJSUP=1,(PSADRG,PSA50IEN)=PSADJD 21 I '$G(PSADJ) D 22 .S (PSA50IEN,PSADRG)=$S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):+$P(PSADATA,"^",2),1:0) 23 .W $S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):$P(^PSDRUG(+$P(PSADATA,"^",2),0),"^"),1:"DRUG UNKNOWN") 24 I PSADRG D 25 .I $P($G(^PSDRUG(PSADRG,2)),"^",3)["N" W " (Controlled Substance)" I $P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !,$C(7),$C(7),"** INACTIVE IN MASTER VAULT **" 26 .I $D(^PSDRUG(PSADRG,"I")) W !?5,"** INACTIVE IN DRUG FILE **" Q 27 .I $P($G(^PSD(58.8,+$P(PSAIN,"^",5),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !,$C(7),$C(7),"** INACTIVE IN PHARMACY LOCATION **" 28 QTY W !,"Qty Invoiced: " 29 ;No Adj. Qty 30 S PSADJQ="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","Q",0)) 31 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJQ=$S($P(PSANODE,"^",6)'="":+$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 32 ;Adj. Qty 33 I $G(PSADJQ) S PSAQTY=PSADJQ W PSAQTY_" ("_$S($P(PSADATA,"^",3):$P(PSADATA,"^",3),$P(PSADATA,"^",3)=0:0,1:"Blank")_")" 34 I '$G(PSADJQ) W $P(PSADATA,"^",3) S PSAQTY=$P(PSADATA,"^",3) 35 UPC S PSAUPC=$P(PSADATA,U,13) W:PSAUPC'="" ?38,"UPC: "_PSAUPC 36 OU W !,"Order Unit : " 37 S PSAOU=$S(+$P(PSADATA,"^",4)&($P($G(^DIC(51.5,+$P(PSADATA,"^",4),0)),"^")'=""):+$P(PSADATA,"^",4),1:"") 38 S PSATEMP=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2)) 39 I +$P(PSATEMP,"^",3),PSADRG,+$P($G(^PSDRUG(PSADRG,1,+$P(PSATEMP,"^",3),0)),"^",5) S PSAOU=+$P(^PSDRUG(PSADRG,1,+$P(PSATEMP,"^",3),0),"^",5) 40 S PSADJO="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","O",0)) 41 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJO=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 42 ;Adj. Order Unit 43 I PSADJO'="" W $S(+PSADJO&($P($G(^DIC(51.5,+PSADJO,0)),"^")'=""):$P($G(^DIC(51.5,+PSADJO,0)),"^"),1:"UNKNOWN")_" ("_$S(PSAOU:$P($G(^DIC(51.5,+PSAOU,0)),"^"),1:"Blank")_")" S PSAOU=+PSADJO 44 I PSADJO="" W $S(+PSAOU:$P($G(^DIC(51.5,+PSAOU,0)),"^"),1:"Blank") 45 ; 46 NDC S PSANDC=$P(PSADATA,"^",11) 47 I $E(PSANDC)'="S" W ?38,"NDC: " D PSANDC1^PSAHELP W PSANDCX K PSANDCX 48 ; 49 PRICE W !,"Unit Price : $" 50 S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","P",0)) 51 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJP=$S(+$P(PSANODE,"^",6):+$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2)) 52 ;Adj. Unit Price 53 I $G(PSADJP) D 54 .I $L($P(PSADJP,".",2))<2 S PSADJP=$P(PSADJP,".")_"."_$P(PSADJP,".",2)_$E("00",1,(2-$L($P(PSADJP,".",2)))) 55 .W $FN(PSADJP,",")_" ($"_$S(+$P(PSADATA,"^",5):$FN($P(PSADATA,"^",5),","),$P(PSADATA,"^",5)=0:"0.00",1:"")_")" 56 .S PSAPRICE=PSADJP 57 I '$G(PSADJP) D 58 .S PSAPRICE=+$P(PSADATA,"^",5) 59 .I $G(PSAPRICE)!(PSAPRICE=0) W $S($G(PSAPRICE):PSAPRICE,1:"0.00") Q 60 .W "Blank" 61 ; 62 VSN S:$D(PSADATA) PSAVSN=$P(PSADATA,"^",12) ;*48 63 W ?38,"VSN: "_$S(PSAVSN'="":PSAVSN,1:"Blank"),! 64 ;bgn *67 65 S PSAP67=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,3,PSALINE,0)) 66 W !,"PV-Drug-Description : ",$S($P(PSAP67,"^",1)'="":$P(PSAP67,"^",1),1:"Unknown") 67 W ?55,"PV-DUOU : ",$S($P(PSAP67,"^",4)'="":$P(PSAP67,"^",4),1:"Unknown") 68 W !,"PV-Drug-Generic Name : ",$S($P(PSAP67,"^",2)'="":$P(PSAP67,"^",2),1:"Unknown") 69 W ?55,"PV-UNITS : ",$S($P(PSAP67,"^",3)'="":$P(PSAP67,"^",3),1:"Unknown"),! 70 ;end *67 71 VDU S PSADUOU=+$P(PSATEMP,"^"),PSAREORD=+$P(PSATEMP,"^",2),PSASUB=+$P(PSATEMP,"^",3),PSASTOCK=+$P(PSATEMP,"^",4) 72 W !,"Dispense Units: "_$S($P($G(^PSDRUG(+PSADRG,660)),"^",8)'="":$P($G(^PSDRUG(+PSADRG,660)),"^",8),1:"Blank") 73 VDUOU W !,"Dispense Units Per Order Unit: "_$S(+PSADUOU:+PSADUOU,+PSASUB&(+$P($G(^PSDRUG(+PSADRG,1,PSASUB,0)),"^",7)):+$P($G(^PSDRUG(+PSADRG,1,PSASUB,0)),"^",7),1:"Blank"),! 74 ; 75 Q:'+$P($G(^PSD(58.8,+PSALOC,0)),"^",14) 76 ; 77 STOCK S PSASTOCK=$S(+PSASTOCK:+PSASTOCK,+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3):+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3),1:"Blank") 78 W "Stock Level : "_PSASTOCK 79 REORDER S PSAREORD=$S(+PSAREORD:+PSAREORD,+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5):+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5),1:"Blank") 80 W !,"Reorder Level : "_PSAREORD,! 81 Q 1 PSAUTL4 ;BIR ISC/JMB-Verify Invoices Utility ; 8/19/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21,48,54,61**; 10/24/97;Build 1 3 ; 4 ;References to ^DIC(51.5 are covered by IA #1931 5 ;References to ^PSDRUG( are covered by IA #2095 6 I $G(PSADICW)=1 S PSALINE=Y 7 ;This routine contains a utility to display a line item ready for 8 ;verification. It is called by PSAVER1 and PSAVER2. 9 ; 10 VERDISP ;Displays a line item on a processed or verified invoice 11 W PSALINEN_" " 12 DRUG S PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","D",0)) 13 I $G(PSADJ) D 14 .S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)) 15 .S PSADJD=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 16 .I PSADJD'?1.N S PSASUP=1 17 .S PSADRG=$S(PSADJ&('PSASUP):$G(PSADJD),PSADJ&(PSASUP):0,1:+$P(PSADATA,"^",2)) 18 .I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")'="" W "*"_$P($G(^PSDRUG(+PSADJD,0)),"^") S (PSADRG,PSA50IEN)=+PSADJD Q 19 .I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")="" S (PSADJ,PSADRG)=0 Q 20 .W ?7,"**"_PSADJD S PSADJSUP=1,(PSADRG,PSA50IEN)=PSADJD 21 I '$G(PSADJ) D 22 .S (PSA50IEN,PSADRG)=$S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):+$P(PSADATA,"^",2),1:0) 23 .W $S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):$P(^PSDRUG(+$P(PSADATA,"^",2),0),"^"),1:"DRUG UNKNOWN") 24 I PSADRG D 25 .I $P($G(^PSDRUG(PSADRG,2)),"^",3)["N" W " (Controlled Substance)" I $P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !,$C(7),$C(7),"** INACTIVE IN MASTER VAULT **" 26 .I $D(^PSDRUG(PSADRG,"I")) W !?5,"** INACTIVE IN DRUG FILE **" Q 27 .I $P($G(^PSD(58.8,+$P(PSAIN,"^",5),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !,$C(7),$C(7),"** INACTIVE IN PHARMACY LOCATION **" 28 QTY W !,"Qty Invoiced: " 29 ;No Adj. Qty 30 S PSADJQ="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","Q",0)) 31 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJQ=$S($P(PSANODE,"^",6)'="":+$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 32 ;Adj. Qty 33 I $G(PSADJQ) S PSAQTY=PSADJQ W PSAQTY_" ("_$S($P(PSADATA,"^",3):$P(PSADATA,"^",3),$P(PSADATA,"^",3)=0:0,1:"Blank")_")" 34 I '$G(PSADJQ) W $P(PSADATA,"^",3) S PSAQTY=$P(PSADATA,"^",3) 35 UPC S PSAUPC=$P(PSADATA,U,13) W:PSAUPC'="" ?38,"UPC: "_PSAUPC 36 OU W !,"Order Unit : " 37 S PSAOU=$S(+$P(PSADATA,"^",4)&($P($G(^DIC(51.5,+$P(PSADATA,"^",4),0)),"^")'=""):+$P(PSADATA,"^",4),1:"") 38 S PSATEMP=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2)) 39 I +$P(PSATEMP,"^",3),PSADRG,+$P($G(^PSDRUG(PSADRG,1,+$P(PSATEMP,"^",3),0)),"^",5) S PSAOU=+$P(^PSDRUG(PSADRG,1,+$P(PSATEMP,"^",3),0),"^",5) 40 S PSADJO="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","O",0)) 41 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJO=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 42 ;Adj. Order Unit 43 I PSADJO'="" W $S(+PSADJO&($P($G(^DIC(51.5,+PSADJO,0)),"^")'=""):$P($G(^DIC(51.5,+PSADJO,0)),"^"),1:"UNKNOWN")_" ("_$S(PSAOU:$P($G(^DIC(51.5,+PSAOU,0)),"^"),1:"Blank")_")" S PSAOU=+PSADJO 44 I PSADJO="" W $S(+PSAOU:$P($G(^DIC(51.5,+PSAOU,0)),"^"),1:"Blank") 45 ; 46 NDC S PSANDC=$P(PSADATA,"^",11) 47 I $E(PSANDC)'="S" W ?38,"NDC: " D PSANDC1^PSAHELP W PSANDCX K PSANDCX 48 ; 49 PRICE W !,"Unit Price : $" 50 S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","P",0)) 51 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJP=$S(+$P(PSANODE,"^",6):+$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2)) 52 ;Adj. Unit Price 53 I $G(PSADJP) D 54 .I $L($P(PSADJP,".",2))<2 S PSADJP=$P(PSADJP,".")_"."_$P(PSADJP,".",2)_$E("00",1,(2-$L($P(PSADJP,".",2)))) 55 .W $FN(PSADJP,",")_" ($"_$S(+$P(PSADATA,"^",5):$FN($P(PSADATA,"^",5),","),$P(PSADATA,"^",5)=0:"0.00",1:"")_")" 56 .S PSAPRICE=PSADJP 57 I '$G(PSADJP) D 58 .S PSAPRICE=+$P(PSADATA,"^",5) 59 .I $G(PSAPRICE)!(PSAPRICE=0) W $S($G(PSAPRICE):PSAPRICE,1:"0.00") Q 60 .W "Blank" 61 ; 62 VSN S:$D(PSADATA) PSAVSN=$P(PSADATA,"^",12) ;*48 63 W ?38,"VSN: "_$S(PSAVSN'="":PSAVSN,1:"Blank"),! 64 ;*54 display VSN XTMP Drug Description and DUOU |==> 65 N PSAFLDT S PSAFLDT="February 2006" 66 N XXX I PSAVSN'="" S XXX=$G(^XTMP("PSAVSN",PSAVSN)) D 67 . I $G(^XTMP("PSAVSN",0)) S PSAFLDT=$P(^XTMP("PSAVSN",0),"^",4) 68 . W !,"PV-Drug-Descrip: " 69 . I '$L(XXX) W "Not Available. Item is OTC or new after ",PSAFLDT,! Q 70 . W ?20,$P(XXX,"~",2),?55,"PV-DUOU: ",+XXX,! 71 ;*54 display VSN XTMP Drug Description and DUOU <==| 72 VDU S PSADUOU=+$P(PSATEMP,"^"),PSAREORD=+$P(PSATEMP,"^",2),PSASUB=+$P(PSATEMP,"^",3),PSASTOCK=+$P(PSATEMP,"^",4) 73 W !,"Dispense Units: "_$S($P($G(^PSDRUG(+PSADRG,660)),"^",8)'="":$P($G(^PSDRUG(+PSADRG,660)),"^",8),1:"Blank") 74 VDUOU W !,"Dispense Units Per Order Unit: "_$S(+PSADUOU:+PSADUOU,+PSASUB&(+$P($G(^PSDRUG(+PSADRG,1,PSASUB,0)),"^",7)):+$P($G(^PSDRUG(+PSADRG,1,PSASUB,0)),"^",7),1:"Blank"),! 75 ; 76 Q:'+$P($G(^PSD(58.8,+PSALOC,0)),"^",14) 77 ; 78 STOCK S PSASTOCK=$S(+PSASTOCK:+PSASTOCK,+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3):+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3),1:"Blank") 79 W "Stock Level : "_PSASTOCK 80 REORDER S PSAREORD=$S(+PSAREORD:+PSAREORD,+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5):+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5),1:"Blank") 81 W !,"Reorder Level : "_PSAREORD,! 82 Q -
WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAVER7.m
r613 r623 1 PSAVER7 ;BIR/JMB-Verify Invoices - CONT'D ;7/23/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**12,21,42,56,64,66**; 10/24/97;Build 2 3 ;Background Job 4 ;This routine increments pharmacy location and master vault balances 5 ;in 58.8 after invoices have been verified. This routine is called 6 ;by PSAVER6. 7 ; 8 ;References to ^PSDRUG( are covered by IA #2095 9 TR ;File transaction data in 58.81 10 I $D(PSADUREC),'PSADUREC Q ;*56 block '0' quantity edits 11 I $D(PSAQTY),'PSAQTY Q ;*56 block '0' quantity edits 12 F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 13 FIND S PSAT=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSAT)) S $P(^PSD(58.81,0),"^",3)=$P(^PSD(58.81,0),"^",3)+1 G FIND 14 S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSAT D ^DIC K DIC,DINUM,DLAYGO L -^PSD(58.81,0) 15 S DIE="^PSD(58.81,",DA=PSAT,DR="1////1;2////^S X=PSALOC;3////^S X=PSADT;4////^S X=PSADRG;5////^S X=PSADUREC;6////^S X=PSAVDUZ;9////^S X=PSABAL;71////^S X=PSAINV;106////^S X=PSAORD" 16 I $G(PSACS) S DR=DR_";100////^S X=PSACS" 17 F L +^PSD(58.81,DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 18 D ^DIE L -^PSD(58.81,DA,0) K DIE 19 S:'$D(^PSD(58.8,PSALOC,1,PSADRG,4,0)) DIC("P")=$P(^DD(58.8001,19,0),"^",2) 20 S DA(2)=PSALOC,DA(1)=PSADRG,(X,DINUM)=PSAT,DIC="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",4,",DIC(0)="L",DLAYGO=58.8 21 F L +^PSD(58.8,PSALOC,1,PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 22 D ^DIC L -^PSD(58.8,PSALOC,1,PSADRG,0) K DIC,DINUM,DLAYGO 23 ; 24 50 S PSAODASH=$P($G(^PSDRUG(PSADRG,2)),"^",4) 25 S PSAONDC=$P(PSAODASH,"-")_$P(PSAODASH,"-",2)_$P(PSAODASH,"-",3) 26 ;(PSA*3*21) NDC & PRICING UPDATES (DAVE BLOCKER 10NOV99) 27 S PSADUOU=$S($G(PSADUOU)'>0:1,1:PSADUOU) 28 S PSADUREC=(PSAQTY*PSADUOU) 29 S DIE="^PSDRUG(",DA=PSADRG,DR="50////^S X="_(PSADUREC+$G(^PSDRUG(PSADRG,660.1))) 30 F L +^PSDRUG(DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 31 D ^DIE L -^PSDRUG(DA,0) K DIE,DA,DR 32 ;This section replaces most of the routine 33 ;PSAOU = order unit from invoice 34 ;PSAPOU & PSANPOU = Price of Order Unit from invoice 35 ;PSADUOU=Dispense Units per OU form invoice data 36 ;PSANPDU= Price of Dispense Units per Order Unit 37 ; 38 ;Drug file Information 39 K DRUG 40 S PSANODE=$G(^PSDRUG(PSADRG,660)) 41 F X=2,3,5,6 S DRUG(X)=$P($G(PSANODE),"^",X) 42 ; 43 S PSANPDU=$J(($G(PSAPOU)/$G(PSADUOU)),0,3) ;Price of Order Unit divide by Disp. Units per Order Unit 44 ;PSA*3*42 |> (let changes happen and file, put changes into mail message) 45 S DIE="^PSDRUG(",(DA,OLDDA)=PSADRG,DR="12////^S X=PSAOU;15////^S X=PSADUOU;Q;13////^S X=PSAPOU" ;*42;*56 46 F L +^PSDRUG(DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 47 D ^DIE K DIE,DA,DR 48 ; <| PSA*42 49 PTCH21 ;PSA*3*21 (Vendor's VSN changing to 8 digits, check also) 50 ;If NDC or VSN changes should it create to synonym entry ? 51 I $G(^PSDRUG(PSADRG,1,PSASUB,0))="" G NDC 52 I $G(^PSDRUG(PSADRG,1,PSASUB,0)) S PSAEDTT=0,DATA=^PSDRUG(PSADRG,1,PSASUB,0) D 53 .I PSAVSN'=$P(DATA,"^",4) S PSAEDTT=1 ;VSN 54 .I PSAPOU'=$P(DATA,"^",6) S PSAEDTT=1 ;Price per order unit 55 .I PSADUOU'=$P(DATA,"^",7) S PSAEDTT=1 ;Dispense Units per Order Unit 56 .I PSANPDU'=$P(DATA,"^",8) S PSAEDTT=1 ;New Price per dispense unit 57 .I $G(PSAEDTT)>0 D 58 ..S DA=PSASUB,DA(1)=PSADRG,DIE="^PSDRUG("_DA(1)_",1," 59 ..S DR="2////^S X=PSADASH"_$S(PSACS:";1////C",1:";1////D")_";400////^S X=PSAVSN;401////^S X=PSAOU"_$S(+PSAPOU:";402////^S X=PSAPOU",1:"")_";403////^S X=PSADUOU"_";404///^S X=PSANPDU"_";405///^S X=PSAVEND" 60 ..D ^DIE K DIE,DR,DA 61 NDC ;NDC UPDATE 62 I PSANDC'="",PSANDC'=PSAONDC D ;*42 63 .S DIE="^PSDRUG(",DA=PSADRG,DR="31////^S X=PSADASH" 64 .F L +^PSDRUG(DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 65 .D ^DIE L -^PSDRUG(DA,0) K DIE,DA,DR 66 SYNONYM ;Adds/edits the SYNONYM multiple in DRUG file >>*66 RJS 67 G:PSANDC="" END 68 S DA(1)=PSADRG ;; << *66 RJS 69 ; 70 S PSANPDU=$J(($G(PSAPOU)/$G(PSADUOU)),0,3) ;Price of Order Unit divide by Disp. Units per Order Unit 71 S:'$D(^PSDRUG(PSADRG,1,0)) DIC("P")="50.1A" 72 ; *56 Search for earliest best match of synonyms, start at bottom go up 73 ; if VSN use it, if several VSNs use the first, IF VSN match NDCs must match also. 74 ; if no VSN, make a new synonym 75 ; no "B" synonym index exists 76 T0 N PSYNDA,PSYN0,PSTNDC,PSTVSN,PSMNDC,PSMBTH S (PSMNDC,PSMBTH)=0 77 S PSYNDA="" F S PSYNDA=$O(^PSDRUG(PSADRG,1,PSYNDA),-1) Q:PSYNDA'>0 D 78 . S PSYN0=^PSDRUG(PSADRG,1,PSYNDA,0),PSTNDC=$P(PSYN0,U),PSTVSN=$P(PSYN0,U,4) ;zero node, test values of NDC VSN 79 . I PSTNDC'=PSANDC Q 80 . I PSTVSN=PSAVSN S PSMBTH=PSYNDA Q ;both VSN & NDC matches 81 T1 S PSASUB=$S(PSMBTH:PSMBTH,1:0) ;PSAMBTH Match both vsn,ndc 82 ;end *56 83 I 'PSASUB!(PSASUB&('$D(^PSDRUG(PSADRG,1,PSASUB,0)))) D 84 .S DIC="^PSDRUG("_DA(1)_",1,",DIC(0)="Z",X=PSANDC,DLAYGO=50 85 .F L +^PSDRUG(PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 86 .D FILE^DICN L -^PSDRUG(PSADRG,0) K DIC,DLAYGO S PSASUB=+Y 87 .K DIC,DA,DR,DIE 88 I PSASUB,$D(^PSDRUG(PSADRG,1,PSASUB,0)) S DA=PSASUB 89 S DA(1)=PSADRG,DIE="^PSDRUG("_DA(1)_",1," 90 S DR="2////^S X=PSADASH"_$S($G(PSACS)>0:";1////C",1:";1////D")_";400////^S X=PSAVSN;401////^S X=PSAOU"_$S(+PSAPOU:";402////^S X=PSAPOU",1:"")_";403////^S X=PSADUOU"_";404///^S X=PSANPDU;405///^S X=PSAVEND" 91 F L +^PSDRUG(PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 92 D ^DIE L -^PSDRUG(PSADRG,0) 93 K DIE,DR,X1,X2,DATA 94 END ; FINAL CLEANUP << *66 RJS 95 L -^PSDRUG(OLDDA,0) K OLDDA ;; >> *66 RJS 96 Q 1 PSAVER7 ;BIR/JMB-Verify Invoices - CONT'D ;7/23/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**12,21,42,56,64**; 10/24/97;Build 4 3 ;Background Job 4 ;This routine increments pharmacy location and master vault balances 5 ;in 58.8 after invoices have been verified. This routine is called 6 ;by PSAVER6. 7 ; 8 ;References to ^PSDRUG( are covered by IA #2095 9 TR ;File transaction data in 58.81 10 I $D(PSADUREC),'PSADUREC Q ;*56 block '0' quantity edits 11 I $D(PSAQTY),'PSAQTY Q ;*56 block '0' quantity edits 12 F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 13 FIND S PSAT=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSAT)) S $P(^PSD(58.81,0),"^",3)=$P(^PSD(58.81,0),"^",3)+1 G FIND 14 S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSAT D ^DIC K DIC,DINUM,DLAYGO L -^PSD(58.81,0) 15 S DIE="^PSD(58.81,",DA=PSAT,DR="1////1;2////^S X=PSALOC;3////^S X=PSADT;4////^S X=PSADRG;5////^S X=PSADUREC;6////^S X=PSAVDUZ;9////^S X=PSABAL;71////^S X=PSAINV;106////^S X=PSAORD" 16 I $G(PSACS) S DR=DR_";100////^S X=PSACS" 17 F L +^PSD(58.81,DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 18 D ^DIE L -^PSD(58.81,DA,0) K DIE 19 S:'$D(^PSD(58.8,PSALOC,1,PSADRG,4,0)) DIC("P")=$P(^DD(58.8001,19,0),"^",2) 20 S DA(2)=PSALOC,DA(1)=PSADRG,(X,DINUM)=PSAT,DIC="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",4,",DIC(0)="L",DLAYGO=58.8 21 F L +^PSD(58.8,PSALOC,1,PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 22 D ^DIC L -^PSD(58.8,PSALOC,1,PSADRG,0) K DIC,DINUM,DLAYGO 23 ; 24 50 S PSAODASH=$P($G(^PSDRUG(PSADRG,2)),"^",4) 25 S PSAONDC=$P(PSAODASH,"-")_$P(PSAODASH,"-",2)_$P(PSAODASH,"-",3) 26 ;(PSA*3*21) NDC & PRICING UPDATES (DAVE BLOCKER 10NOV99) 27 S PSADUOU=$S($G(PSADUOU)'>0:1,1:PSADUOU) 28 S PSADUREC=(PSAQTY*PSADUOU) 29 S DIE="^PSDRUG(",DA=PSADRG,DR="50////^S X="_(PSADUREC+$G(^PSDRUG(PSADRG,660.1))) 30 F L +^PSDRUG(DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 31 D ^DIE L -^PSDRUG(DA,0) K DIE,DA,DR 32 ;This section replaces most of the routine 33 ;PSAOU = order unit from invoice 34 ;PSAPOU & PSANPOU = Price of Order Unit from invoice 35 ;PSADUOU=Dispense Units per OU form invoice data 36 ;PSANPDU= Price of Dispense Units per Order Unit 37 ; 38 ;Drug file Information 39 K DRUG 40 S PSANODE=$G(^PSDRUG(PSADRG,660)) 41 F X=2,3,5,6 S DRUG(X)=$P($G(PSANODE),"^",X) 42 ; 43 S PSANPDU=$J(($G(PSAPOU)/$G(PSADUOU)),0,3) ;Price of Order Unit divide by Disp. Units per Order Unit 44 ;PSA*3*42 |> (let changes happen and file, put changes into mail message) 45 S DIE="^PSDRUG(",DA=PSADRG,DR="12////^S X=PSAOU;15////^S X=PSADUOU;Q;13////^S X=PSAPOU" ;*42;*56 46 F L +^PSDRUG(DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 47 D ^DIE K DIE,DA,DR 48 ; <| PSA*42 49 PTCH21 ;PSA*3*21 (Vendor's VSN changing to 8 digits, check also) 50 ;If NDC or VSN changes should it create to synonym entry ? 51 I $G(^PSDRUG(PSADRG,1,PSASUB,0))="" G NDC 52 I $G(^PSDRUG(PSADRG,1,PSASUB,0)) S PSAEDTT=0,DATA=^PSDRUG(PSADRG,1,PSASUB,0) D 53 .I PSAVSN'=$P(DATA,"^",4) S PSAEDTT=1 ;VSN 54 .I PSAPOU'=$P(DATA,"^",6) S PSAEDTT=1 ;Price per order unit 55 .I PSADUOU'=$P(DATA,"^",7) S PSAEDTT=1 ;Dispense Units per Order Unit 56 .I PSANPDU'=$P(DATA,"^",8) S PSAEDTT=1 ;New Price per dispense unit 57 .I $G(PSAEDTT)>0 D 58 ..S DA=PSASUB,DA(1)=PSADRG,DIE="^PSDRUG("_DA(1)_",1," 59 ..S DR="2////^S X=PSADASH"_$S(PSACS:";1////C",1:";1////D")_";400////^S X=PSAVSN;401////^S X=PSAOU"_$S(+PSAPOU:";402////^S X=PSAPOU",1:"")_";403////^S X=PSADUOU"_";404///^S X=PSANPDU"_";405///^S X=PSAVEND" 60 ..D ^DIE K DIE,DR,DA 61 NDC ;NDC UPDATE 62 I PSANDC'="",PSANDC'=PSAONDC D ;*42 63 .S DIE="^PSDRUG(",DA=PSADRG,DR="31////^S X=PSADASH" 64 .F L +^PSDRUG(DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 65 .D ^DIE L -^PSDRUG(DA,0) K DIE,DA,DR 66 SYNONYM ;Adds/edits the SYNONYM multiple in DRUG file 67 Q:PSANDC="" K DA,DR S DA(1)=PSADRG 68 ; 69 S PSANPDU=$J(($G(PSAPOU)/$G(PSADUOU)),0,3) ;Price of Order Unit divide by Disp. Units per Order Unit 70 S:'$D(^PSDRUG(PSADRG,1,0)) DIC("P")="50.1A" 71 ; *56 Search for earliest best match of synonyms, start at bottom go up 72 ; if VSN use it, if several VSNs use the first, IF VSN match NDCs must match also. 73 ; if no VSN, make a new synonym 74 ; no "B" synonym index exists 75 T0 N PSYNDA,PSYN0,PSTNDC,PSTVSN,PSMNDC,PSMBTH S (PSMNDC,PSMBTH)=0 76 S PSYNDA="" F S PSYNDA=$O(^PSDRUG(PSADRG,1,PSYNDA),-1) Q:PSYNDA'>0 D 77 . S PSYN0=^PSDRUG(PSADRG,1,PSYNDA,0),PSTNDC=$P(PSYN0,U),PSTVSN=$P(PSYN0,U,4) ;zero node, test values of NDC VSN 78 . I PSTNDC'=PSANDC Q 79 . I PSTVSN=PSAVSN S PSMBTH=PSYNDA Q ;both VSN & NDC matches 80 T1 S PSASUB=$S(PSMBTH:PSMBTH,1:0) ;PSAMBTH Match both vsn,ndc 81 ;end *56 82 I 'PSASUB!(PSASUB&('$D(^PSDRUG(PSADRG,1,PSASUB,0)))) D 83 .S DIC="^PSDRUG("_DA(1)_",1,",DIC(0)="Z",X=PSANDC,DLAYGO=50 84 .F L +^PSDRUG(PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 85 .D FILE^DICN L -^PSDRUG(PSADRG,0) K DIC,DLAYGO S PSASUB=+Y 86 .K DIC,DA,DR,DIE 87 I PSASUB,$D(^PSDRUG(PSADRG,1,PSASUB,0)) S DA=PSASUB 88 S DA(1)=PSADRG,DIE="^PSDRUG("_DA(1)_",1," 89 S DR="2////^S X=PSADASH"_$S($G(PSACS)>0:";1////C",1:";1////D")_";400////^S X=PSAVSN;401////^S X=PSAOU"_$S(+PSAPOU:";402////^S X=PSAPOU",1:"")_";403////^S X=PSADUOU"_";404///^S X=PSANPDU;405///^S X=PSAVEND" 90 F L +^PSDRUG(PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 91 D ^DIE L -^PSDRUG(PSADRG,0) 92 K DIE,DR,X1,X2,DATA 93 Q -
WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAVERA.m
r613 r623 1 PSAVERA ;BHM/DBM - Change verified invoice data;16AUG05 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21,36,40,53,63**; 10/24/97;Build 10 3 ; 4 ;References to ^DIC(51.5 are covered by IA #1931 5 ;References to ^PSDRUG( are covered by IA #2095 6 D Q 7 D HOME^%ZIS S XX="VERIFIED INVOICE ALTERATION SCREEN" W @IOF,!!,?((IOM/2)-($L(XX)/2)),XX,!! 8 ORDR ;Get Order Number 9 S DIC(0)="AEQMZ",DIC("A")="Select Order Number: ",DIC="^PSD(58.811," D ^DIC K DIC G Q:+Y'>0 S PSAIEN=+Y,PSAORD=$P(Y,U,2) 10 ; 11 INV ;Get Invoice Number 12 S DIC(0)="AEQMZ",DIC("A")="Select Invoice Number: ",DIC="^PSD(58.811,"_PSAIEN_",1,",D="ASTAT" D ^DIC K DIC G Q:+Y'>0 S PSAIEN1=+Y,PSAINV=$P(Y,U,2) 13 S DATA=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,0)) 14 S PSALOC=$S($P(DATA,"^",12)'="":$P(DATA,"^",12),1:$P(DATA,"^",5)) I $G(PSALOC)="" S PSALOC="No Location identified" 15 D ^PSAVERA1 16 K DATA,PSAITM,LINENUM,X,X1,X2,X3,DIC,DA,DR D HDR 17 DISP S PSAITM=$S('$D(PSAITM):$O(INVARRAY(PSAORD,PSAINV,0)),1:$O(INVARRAY(PSAORD,PSAINV,PSAITM))) G LINEASK:PSAITM'>0 S LINENUM=$G(LINENUM)+1 18 S DATA=$G(INVARRAY(PSAORD,PSAINV,PSAITM)),PSAOU=$P(DATA,"^",4) I $G(PSAOU) S PSAOU(1)=$P($G(^DIC(51.5,$P(DATA,"^",4),0)),"^") ;Current Order Unit ;; <*63 RJS 19 W !,PSAITM,?10,$S($P($P(DATA,"^",1),"~",1)'>0:$P($P(DATA,"^",1),"~",1),1:$P($P(DATA,"^",1),"~",2)),?45,$S($G(PSAOU)="":"none",$G(PSAOU(1))'="":$G(PSAOU(1)),1:$G(PSAAOU)),?55,$J($P($G(DATA),"^",2),4),?61,$P(DATA,"^",5) ;; *63 RJS> 20 I IOST["C-",$Y>(IOSL-5) S DIR(0)="E" D ^DIR G Q:$G(DUOUT)=1 D HDR 21 G DISP 22 LINEASK ;ask for line number 23 W !,"Enter the corresponding item number to edit: " R AN:DTIME I AN["^"!(AN="") G Q 24 I AN<1!(AN>LINENUM) W !,"Enter a number between 1 & ",LINENUM,! G LINEASK 25 I "?"[AN W !,"Select the number that corresponds to the line item that needs editing",! K AN G LINEASK 26 S DATA=$G(INVARRAY(PSAORD,PSAINV,AN)) 27 S PSALINE=AN,PSAIN="NADA" I '$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)) W !,"Invalid line selection." G LINEASK 28 S PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),PSASUP=0 29 S PSACS=0 S:+$P(PSADATA,"^",10) PSACS=$G(PSACS)+1 30 S PSANDC=$P(PSADATA,"^",11) 31 S PSALINEN="" D VERDISP^PSAUTL4 W !,PSASLN,! 32 S PSAVEND=$P(^PSD(58.811,PSAIEN,0),"^",2) 33 S PSAODUOU=PSADUOU 34 ;; *63 35 S PSA581="" F S PSA581=$O(^PSD(58.81,"PV",PSAINV,PSA581)) Q:'PSA581 I $P(^PSD(58.81,PSA581,0),U,5)=PSADRG S PSABFR(581)=$G(^PSD(58.81,PSA581,0)) 36 S:$G(PSABFR(581)) PSDTRN=$P(PSABFR(581),U,1),PSABFR("Q")=$S($G(^PSD(58.81,PSDTRN,4)):$P(^PSD(58.81,PSDTRN,4),"^",3),1:$P(^PSD(58.81,PSDTRN,0),"^",6)) ; <*63 RJS > 37 DRG W !,"Select (D)rug or (O)rder Unit " R AN:DTIME G Q:AN["^"!(AN="") W $S("Dd"[AN:"rug","oO"[AN:"rder Unit",1:"??") I "DdOo"'[AN W !,"Enter a 'D' to edit the Drug, or 'O' to edit the order unit",! K AN G DRG 38 I "Dd"'[AN D ^PSAVERA3 G Q ;;*63 39 ;Get either new name of drug or supply item description 40 S PSABFR=$P(DATA,"~",1),PSABFR(1)=$S(PSABFR'?.N:PSABFR,1:$P($P(DATA,"^"),"~",2)),PSABFR("NDC")=$P(PSADATA,"^",11) ;;*63 41 DRGAGN D 42 .S X1=0 F S X1=$O(^PSDRUG(PSABFR,1,X1)) Q:X1'>0 S DATA=$G(^PSDRUG(PSABFR,1,X1,0)) I $P(DATA,"^",2)=PSABFR("NDC") S PSABFR("SYNNODE")=X1 ;;*63 43 D PSANDC1^PSAHELP S PSADASH=PSANDCX K PSANDCX 44 I $G(PSABFR("SYNNODE"))="",$E(PSABFR("NDC"))'="S" S PSABFR("NDC")="S"_PSABFR("NDC") G DRGAGN ;may be supply, try again 45 I $G(PSABFR("SYNNODE"))'="" S PSASUB=PSABFR("SYNNODE") D 46 .S DATA=$G(^PSDRUG(PSABFR,1,PSASUB,0)),PSAOU=$P(DATA,"^",5),PSAPOU=$P(DATA,"^",6),PSADUOU=$P(DATA,"^",7),PSAPDUOU=$P(DATA,"^",8) 47 .S PSADU=$P($G(^PSDRUG(PSABFR,660)),"^",8) 48 I ($G(PSAOU)=""!$G(PSAPOU)=""!$G(PSADUOU)=""!$G(PSAPDUOU)="") W !!,"Sorry, I could not find the necessary information to change the drug selection.",! G Q 49 W !,"Current Drug : ",PSABFR(1) 50 DRG1 S PSAGAIN=0,DIC("A")="Select name of Correct Drug: ",PSABFR=PSADRG,DIC(0)="AEQMZ",DIC="^PSDRUG(" D ^DIC K DIC G Q:PSAOUT 51 I $G(DTOUT)!($G(DUOT))!(Y<0) S PSAOUT=1 Q 52 S (PSADJ,PSADRG)=+Y 53 W !!,"Comparing drug file data..." 54 S PSAODU=$P($G(^PSDRUG(PSADRG,660)),"^",8),PSAXDUOU=$P($G(^PSDRUG(PSADRG,660)),"^",5) 55 I $P($G(^PSDRUG(PSADRG,660)),"^",2)'=$G(PSAOU) W !,"The Order Units are different between these two drugs." 56 I $P($G(^PSDRUG(PSADRG,660)),"^",8)'=$G(PSADU) W !,"Please Enter an appropriate Dispense Unit" S DIE="^PSDRUG(",DA=PSADRG,DR="14.5" D ^DIE S PSADU=$P(^PSDRUG(PSADRG,660),"^",8) 57 I $P($G(^PSDRUG(PSADRG,660)),"^",5)'=$G(PSADUOU) W !,"Please enter the appropriate Dispense Units per order unit" S DIE="^PSDRUG(",DA=PSADRG,DR="15" D ^DIE S PSADUOU=$P(^PSDRUG(PSADRG,660),"^",5) 58 K DIE,DA,DR 59 ASK R !!,"Are you sure about this ? NO// ",AN:DTIME G NOCHNG:AN["^"!(AN="") 60 S AN=$E(AN) I "yYnN"'[AN W !,"Answer yes, and the data on file for the current drug will be transferred",!,"to the new drug selection.",!,"That includes Order Unit, Dispense Unit, Dispense Units per Order Unit, etc.",!! G ASK 61 I "Nn"[AN G NOCHNG ;*53 62 S PSAAFTER=PSADRG,PSADRG=PSABFR 63 I $D(^PSDRUG(PSADRG))&$G(PSABFR(581)) D 64 .W !,"Removing "_PSABFR("Q")_" from "_PSABFR(1) 65 .S FMDATA=$P($G(^PSDRUG(PSADRG,660.1)),"^")-PSABFR("Q"),DIE="^PSDRUG(",DA=PSADRG,DR="50////^S X="_FMDATA 66 .F L +^PSDRUG(DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 67 .D ^DIE L -^PSDRUG(DA,0) K FMDATA 68 S PSADRG=PSAAFTER 69 I $G(PSAPOU)="",$G(PSAPRICE)'="" S PSAPOU=PSAPRICE 70 W !,"Adding "_($G(PSAQTY)*$G(PSADUOU))_" to "_$P($G(^PSDRUG(PSADRG,0)),"^") 71 W !,"Entering new drug selection as an adjustment." 72 S PSAREA="",PSADJFLD="D",PSADJ=PSADRG D RECORD^PSAVER2,50^PSAVER7 73 FILE ;File dispense units per order units into 58.811 74 S DIE="^PSD(58.811,"_PSAIEN_",1,"_PSAIEN1_",1,",DA=PSALINE,DA(1)=PSAIEN1,DA(2)=PSAIEN,DR="10///"_PSADUOU D ^DIE 75 G:$D(^PSD(58.811,"ASTAT","P",PSAIEN,PSAIEN1)) Q ;; *63 RJS 76 D UPDATE^PSAVERA1 G Q 77 ; 78 HDR W @IOF,!?25,"EDIT VERIFIED INVOICED ITEM SCREEN",!,PSASLN,! 79 W !,?44,"Order",!,"#",?10,"Drug/Item Name",?45,"Unit",?56,"Qnty.",?67,"NDC",!,PSASLN,! Q 80 Q K AN,D,DA,DATA,DIC,DIR,INVARRAY,LINENUM,POP,PSA50IEN,PSA581,PSAABAL,PSAAFTER,PSAAQTY,PSABAL,PSABFR,PSACS,PSADASH,PSADATA,PSADJ,PSADJD,PSADJFLD,PSADJO,PSADJP,PSADJQ,PSADRG,PSADRUGN,PSADT 81 K PSADU,PSADUOU,PSADUREC,PSAEDTT,PSAGAIN,PSAIEN,PSAIEN1,PSAIN,PSAINV,PSAITM,PSALINE,PSALINEN,PSALOC,PSANDC,PSANDUOU,PSANEW,PSANODE,PSANPDU,PSANQTY,PSAODASH,PSAODU,PSAODUOU,PSAONDC,PSAORD 82 K PSAOU,PSAOUT,PSAPOU,PSAPRICE,PSAQTY,PSAREA,PSAREORD,PSASET,PSASLN,PSASTOCK,PSASUB,PSASUP,PSASUPP,PSAT,PSATEMP,PSAUPC,PSAVDUZ,PSAVEND,PSAVER,PSAVSN,PSAXDUOU,PSDTRN,X,X1,X2,X3,XX,XXX,Y 83 Q 84 NOCHNG ;*53 said no to changes, backout the edits on the new drug choice. 85 K DIE,DR,DA 86 S DIE="^PSDRUG(",DA=PSADRG,DR="14.5////^S X=PSAODU;15////^S X=PSAXDUOU" D ^DIE 87 W !,"NO CHANGE",! G Q 1 PSAVERA ;BHM/DBM - Change verified invoice data;16AUG05 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21,36,40,53**; 10/24/97 3 ; 4 ;References to ^DIC(51.5 are covered by IA #1931 5 ;References to ^PSDRUG( are covered by IA #2095 6 D Q 7 D HOME^%ZIS S XX="VERIFIED INVOICE ALTERATION SCREEN" W @IOF,!!,?((IOM/2)-($L(XX)/2)),XX,!! 8 ORDR ;Get Order Number 9 S DIC(0)="AEQMZ",DIC("A")="Select Order Number: ",DIC="^PSD(58.811," D ^DIC K DIC G Q:+Y'>0 S PSAIEN=+Y,PSAORD=$P(Y,U,2) 10 ; 11 INV ;Get Invoice Number 12 S DIC(0)="AEQMZ",DIC("A")="Select Invoice Number: ",DIC="^PSD(58.811,"_PSAIEN_",1,",D="ASTAT" D ^DIC K DIC G Q:+Y'>0 S PSAIEN1=+Y,PSAINV=$P(Y,U,2) 13 ; 14 S DATA=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,0)) 15 S PSALOC=$S($P(DATA,"^",12)'="":$P(DATA,"^",12),1:$P(DATA,"^",5)) I $G(PSALOC)="" S PSALOC="No Location identified" 16 D ^PSAVERA1 17 ; 18 K DATA,PSAITM,LINENUM,X,X1,X2,X3,DIC,DA,DR D HDR 19 DISP S PSAITM=$S('$D(PSAITM):$O(INVARRAY(PSAORD,PSAINV,0)),1:$O(INVARRAY(PSAORD,PSAINV,PSAITM))) G LINEASK:PSAITM'>0 S LINENUM=$G(LINENUM)+1 20 S DATA=$G(INVARRAY(PSAORD,PSAINV,PSAITM)) 21 S PSAOU=$P(DATA,"^",4) I $G(PSAOU) S PSAOU(1)=$P($G(^DIC(51.5,$P(DATA,"^",4),0)),"^") ;Current Order Unit 22 W !,PSAITM,?10,$S($P($P(DATA,"^",1),"~",1)'>0:$P($P(DATA,"^",1),"~",1),1:$P($P(DATA,"^",1),"~",2)),?45,$S($G(PSAOU)="":"none",$G(PSAOU(1))'="":$G(PSAOU(1)),1:$G(PSAAOU)),?55,$J($P($G(DATA),"^",2),4),?61,$P(DATA,"^",5) 23 I IOST["C-",$Y>(IOSL-5) S DIR(0)="E" D ^DIR G Q:$G(DUOUT)=1 D HDR 24 G DISP 25 LINEASK ;ask for line number 26 W !,"Enter the corresponding item number to edit: " R AN:DTIME I AN["^"!(AN="") G Q 27 I AN<1!(AN>LINENUM) W !,"Enter a number between 1 & ",LINENUM,! G LINEASK 28 I "?"[AN W !,"Select the number that corresponds to the line item that needs editing",! K AN G LINEASK 29 S DATA=$G(INVARRAY(PSAORD,PSAINV,AN)) 30 S PSALINE=AN,PSAIN="NADA" I '$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)) W !,"Invalid line selection." G LINEASK 31 S PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),PSASUP=0 32 S PSACS=0 S:+$P(PSADATA,"^",10) PSACS=$G(PSACS)+1 33 S PSANDC=$P(PSADATA,"^",11) 34 S PSALINEN="" D VERDISP^PSAUTL4 W !,PSASLN,! 35 S PSAVEND=$P(^PSD(58.811,PSAIEN,0),"^",2) 36 ;VMP OIFO BAY PINES;VGF;PSA*3.0*40;GET ORIGINAL DISPENSE UNITS PER ORDER UNIT FOR SUBTRACTION 37 S PSAODUOU=PSADUOU 38 ; 39 DRG W !,"Select (D)rug or (O)rder Unit " R AN:DTIME G Q:AN["^"!(AN="") W $S("Dd"[AN:"rug","oO"[AN:"rder Unit",1:"??") I "DdOo"'[AN W !,"Enter a 'D' to edit the Drug, or 'O' to edit the order unit",! K AN G DRG 40 I "Dd"'[AN G ^PSAVERA3 41 ;Get either new name of drug or supply item description 42 S PSABEFOR=$P(DATA,"~",1),PSABEFOR(1)=$S(PSABEFOR'?.N:PSABEFOR,1:$P($P(DATA,"^"),"~",2)) 43 S PSABEFOR("NDC")=$P(PSADATA,"^",11) 44 DRGAGN D 45 .S X1=0 F S X1=$O(^PSDRUG(PSABEFOR,1,X1)) Q:X1'>0 S DATA=$G(^PSDRUG(PSABEFOR,1,X1,0)) I $P(DATA,"^",2)=PSABEFOR("NDC") S PSABEFOR("SYNNODE")=X1 46 D PSANDC1^PSAHELP S PSADASH=PSANDCX K PSANDCX 47 I $G(PSABEFOR("SYNNODE"))="",$E(PSABEFOR("NDC"))'="S" S PSABEFOR("NDC")="S"_PSABEFOR("NDC") G DRGAGN ;may be supply, try again 48 I $G(PSABEFOR("SYNNODE"))'="" S PSASUB=PSABEFOR("SYNNODE") D 49 .S DATA=$G(^PSDRUG(PSABEFOR,1,PSASUB,0)),PSAOU=$P(DATA,"^",5),PSAPOU=$P(DATA,"^",6),PSADUOU=$P(DATA,"^",7),PSAPDUOU=$P(DATA,"^",8) 50 .S PSADU=$P($G(^PSDRUG(PSABEFOR,660)),"^",8) 51 I ($G(PSAOU)=""!$G(PSAPOU)=""!$G(PSADUOU)=""!$G(PSAPDUOU)="") W !!,"Sorry, I could not find the necessary information to change the drug selection.",! G Q 52 W !,"Current Drug : ",PSABEFOR(1) 53 DRG1 S PSAGAIN=0,DIC("A")="Select name of Correct Drug: ",PSABEFOR=PSADRG,DIC(0)="AEQMZ",DIC="^PSDRUG(" D ^DIC K DIC G Q:PSAOUT 54 I $G(DTOUT)!($G(DUOT)) S PSAOUT=1 Q 55 S (PSADJ,PSADRG)=+Y 56 W !!,"Comparing drug file data..." 57 S PSAODU=$P($G(^PSDRUG(PSADRG,660)),"^",8),PSAXDUOU=$P($G(^PSDRUG(PSADRG,660)),"^",5) 58 I $P($G(^PSDRUG(PSADRG,660)),"^",2)'=$G(PSAOU) W !,"The Order Units are different between these two drugs." 59 I $P($G(^PSDRUG(PSADRG,660)),"^",8)'=$G(PSADU) W !,"Please Enter an appropriate Dispense Unit" S DIE="^PSDRUG(",DA=PSADRG,DR="14.5" D ^DIE S PSADU=$P(^PSDRUG(PSADRG,660),"^",8) 60 ;VMP OIFO BAY PINES;VGF;PSA*3.0*36 61 I $P($G(^PSDRUG(PSADRG,660)),"^",5)'=$G(PSADUOU) W !,"Please enter the appropriate Dispense Units per order unit" S DIE="^PSDRUG(",DA=PSADRG,DR="15" D ^DIE S PSADUOU=$P(^PSDRUG(PSADRG,660),"^",5) 62 K DIE,DA,DR 63 ASK R !!,"Are you sure about this ? NO// ",AN:DTIME G NOCHNG:AN["^"!(AN="") 64 S AN=$E(AN) I "yYnN"'[AN W !,"Answer yes, and the data on file for the current drug will be transferred",!,"to the new drug selection.",!,"That includes Order Unit, Dispense Unit, Dispense Units per Order Unit, etc.",!! G ASK 65 I "Nn"[AN G NOCHNG ;*53 66 ;VMP OIFO BAY PINES;VGF;PSA*3.0*36 67 S PSAAFTER=PSADRG,PSADRG=PSABEFOR 68 I $D(^PSDRUG(PSADRG)) D 69 .;VMP OIFO BAY PINES;VGF;PSA*3.0*40 70 .W !,"Removing "_($G(PSAQTY)*$G(PSAODUOU))_" from "_PSABEFOR(1) 71 .S FMDATA=$P($G(^PSDRUG(PSADRG,660.1)),"^")-(PSAODUOU*PSAQTY) 72 .S DIE="^PSDRUG(",DA=PSADRG,DR="50////^S X="_FMDATA 73 .F L +^PSDRUG(DA,0):0 I Q 74 .D ^DIE 75 .L -^PSDRUG(DA,0) 76 .K FMDATA 77 S PSADRG=PSAAFTER 78 I $G(PSAPOU)="",$G(PSAPRICE)'="" S PSAPOU=PSAPRICE 79 W !,"Adding "_($G(PSAQTY)*$G(PSADUOU))_" to "_$P($G(^PSDRUG(PSADRG,0)),"^") 80 W !,"Entering new drug selection as an adjustment." 81 S PSAREA="",PSADJFLD="D",PSADJ=PSADRG D RECORD^PSAVER2 82 D 50^PSAVER7 83 FILE ;File dispense units per order units into 58.811 84 S DIE="^PSD(58.811,"_PSAIEN_",1,"_PSAIEN1_",1," 85 S DA=PSALINE,DA(1)=PSAIEN1,DA(2)=PSAIEN 86 S DR="10///"_PSADUOU 87 D ^DIE 88 ;File data in 58.8 89 ;PSALOC= Either PSALOC or PSALOCB 90 ;VMP OIFO BAY PINES;VGF;PSA*3.0*40;UPDATE 91 S PSADRG=PSABEFOR 92 F L +^PSD(58.8,PSALOC,1,PSADRG,0):0 I Q 93 S PSADUREC=PSAQTY*$G(PSAODUOU) 94 S PSABAL=$P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",4) 95 S $P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",4)=PSABAL-PSADUREC 96 L -^PSD(58.8,PSALOC,1,PSADRG,0) 97 ;VMP OIFO BAY PINES;VGF;PSA*3.0*40;ADDED *$G(PSADUOU) 98 S PSADRG=PSAAFTER 99 S PSADUREC=PSAQTY*$G(PSADUOU) 100 D NOW^%DTC S PSADT=+$E(%,1,14) 101 I '$D(^PSD(58.8,PSALOC,1,PSADRG,0)) D 102 .S:'$D(^PSD(58.8,PSALOC,1,0)) DIC("P")=$P(^DD(58.8,10,0),"^",2) 103 .S DA(1)=PSALOC,DIC="^PSD(58.8,"_DA(1)_",1,",(DA,DINUM,X)=PSADRG,DIC(0)="L",DLAYGO=58.8 ;*53 104 .F L +^PSD(58.8,PSALOC,0):0 I Q 105 .D FILE^DICN L -^PSD(58.8,PSALOC,0) K DIC,DA,DLAYGO 106 F L +^PSD(58.8,PSALOC,1,PSADRG,0):0 I Q 107 S PSABAL=$P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",4) 108 I $P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",1)'=PSADRG S $P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",1)=PSADRG 109 S $P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",4)=PSADUREC+PSABAL 110 I +$P($G(^PSD(58.8,PSALOC,0)),"^",14) D 111 .I PSASTOCK'=$P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",3) S $P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",3)=PSASTOCK 112 .I PSAREORD'=$P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",5) S $P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",5)=PSAREORD 113 S:'$D(^PSD(58.8,PSALOC,1,PSADRG,5,0)) DIC("P")=$P(^DD(58.8001,20,0),"^",2) 114 I '$D(^PSD(58.8,PSALOC,1,PSADRG,5,$E(DT,1,5)*100,0)) D 115 .S DIC="^PSD(58.8,"_PSALOC_",1,"_PSADRG_",5,",DIC(0)="L",DIC("DR")="1////^S X=$G(PSABAL)",(X,DINUM)=$E(DT,1,5)*100,DA(2)=PSALOC,DA(1)=PSADRG,DLAYGO=58.8 D ^DIC K DIC 116 .S X="T-1M" D ^%DT S DIC="^PSD(58.8,"_PSALOC_",1,"_PSADRG_",5,",DIC(0)="L",(X,DINUM)=$E(Y,1,5)*100 D ^DIC K DIC,DLAYGO S DA=+Y 117 .S DA(2)=PSALOC,DA(1)=PSADRG,DIE="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",5,",DR="3////^S X=$G(PSABAL)" D ^DIE K DIE 118 S DA(2)=PSALOC,DA(1)=PSADRG,DIE="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",5,",DA=$E(DT,1,5)*100,DR="5////^S X="_($P($G(^(0)),"^",3)+PSADUREC) D ^DIE K DIE 119 L -^PSD(58.8,PSALOC,1,PSADRG,0) 120 W !,"updating pharmacy location file." 121 FILE581 ;Update transaction file 122 S PSAVDUZ=DUZ 123 FIND S PSAT=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSAT)) S $P(^PSD(58.81,0),"^",3)=$P(^PSD(58.81,0),"^",3)+1 G FIND 124 S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSAT D ^DIC K DIC,DINUM,DLAYGO L -^PSD(58.81,0) 125 S DIE="^PSD(58.81,",DA=PSAT,DR="1////1;2////^S X=PSALOC;3////^S X=PSADT;4////^S X=PSADRG;5////^S X=PSADUREC;6////^S X=PSAVDUZ;9////^S X=PSABAL;71////^S X=PSAINV;106////^S X=PSAORD" 126 I $G(PSACS)>0 S DR=DR_";100////^S X=PSACS" 127 F L +^PSD(58.81,DA,0):0 I Q 128 D ^DIE L -^PSD(58.81,DA,0) K DIE W !,"updating transaction file." Q 129 ; 130 HDR W @IOF,!?25,"EDIT VERIFIED INVOICED ITEM SCREEN",!,PSASLN,! 131 W !,?44,"Order",!,"#",?10,"Drug/Item Name",?45,"Unit",?56,"Qnty.",?67,"NDC",!,PSASLN,! Q 132 Q K AN,D,DA,DATA,DIC,DIR,INVARRAY,LINENUM,PSA50IEN,PSABAL,PSABEFOR,PSACS,PSADATA,PSADJ,PSADJFLD,PSADRG,PSADT,PSADUREC,PSAGAIN,PSAIEN,PSAIEN1,PSAIN,PSAINV,PSALINE,PSALINEN 133 K PSALOC,PSANDC,PSAORD,PSAOUT,PSAQTY,PSAREA,PSAREORD,PSASLN,PSASTOCK,PSASUB,PSASUP,PSASUPP,PSAT,PSAVER,X,X1,X2,X3,XX,XXX,Y,PSAODUOU 134 K PSAODU,PSAODUOU,PSAXDUOU 135 Q 136 NOCHNG ;*53 said no to changes, backout the edits on the new drug choice. 137 K DIE,DR,DA 138 S DIE="^PSDRUG(",DA=PSADRG,DR="14.5////^S X=PSAODU;15////^S X=PSAXDUOU" D ^DIE 139 W !,"NO CHANGE",! G Q -
WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAVERA1.m
r613 r623 1 PSAVERA1 ;BHM/DB - Edit previously verified invoices;16NOV99 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21,61,63**; 10/24/97;Build 10 3 ;References to ^DIC(51.5 are covered by IA #1931 4 ;References to ^PSDRUG( are covered by IA #2095 5 ; 6 S $P(PSASLN,"=",79)="" K PSALINE 7 DISPLN S PSALINE=$S('$D(PSALINE):$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,0)),1:$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE))) G Q:PSALINE'>0 S CNT=$G(CNT)+1 8 S PSADATA=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)) 9 S PSATEMP=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2)) 10 S PSAVSN=$P(PSADATA,"^",12),PSAOUT=0 11 DRUG S PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","D",0)) 12 I $G(PSADJ) D 13 .S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)) 14 .S PSADJD=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 15 .S PSASUP=$S(PSADJD'?1.N:1,1:0) 16 .S PSADRG=$S(PSADJ&('PSASUP):$G(PSADJD),PSADJ&(PSASUP):0,1:+$P(PSADATA,"^",2)) 17 .I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")'="" S (PSADRG,PSA50IEN)=+PSADJD Q 18 .I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")="" S (PSADJ,PSADRG)=0 Q 19 .S PSADJSUP=1,(PSADRG,PSA50IEN)=PSADJD 20 I '$G(PSADJ) D 21 .S (PSA50IEN,PSADRG)=$S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):+$P(PSADATA,"^",2),1:0) 22 S PSADRUGN=$S($P($G(^PSDRUG(PSADRG,0)),"^")'="":$P($G(^PSDRUG(PSADRG,0)),"^"),1:"Unknown Drug Name") 23 QTY ;Quantity 24 ;No Adj. Qty 25 S PSADJQ="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","Q",0)) 26 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJQ=$S($P(PSANODE,"^",6)'="":+$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 27 ;Adj. Qty 28 I $G(PSADJQ) S PSAQTY=PSADJQ 29 I '$G(PSADJQ) S PSAQTY=$P(PSADATA,"^",3) 30 UPC S:$P(PSADATA,"^",13) PSAUPC=$P(PSADATA,"^",13) 31 OU ;W !,"Order Unit : " 32 S PSAOU=$S(+$P(PSADATA,"^",4)&($P($G(^DIC(51.5,+$P(PSADATA,"^",4),0)),"^")'=""):+$P(PSADATA,"^",4),1:"") 33 S PSATEMP=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2)) 34 I +$P(PSATEMP,"^",3),PSADRG,+$P($G(^PSDRUG(PSADRG,1,+$P(PSATEMP,"^",3),0)),"^",5) S PSAOU=+$P(^PSDRUG(PSADRG,1,+$P(PSATEMP,"^",3),0),"^",5) 35 S PSADJO="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","O",0)) 36 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJO=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 37 ;Adj. Order Unit 38 I PSADJO'="" S PSAOU=+PSADJO 39 I PSADJO="" ;W $S(+PSAOU:$P($G(^DIC(51.5,+PSAOU,0)),"^"),1:"Blank") 40 ; 41 NDC S PSANDC=$P(PSADATA,"^",11) 42 ;I $E(PSANDC)'="S" W ?38,"NDC: "_$S(PSANDC'="":$E(PSANDC,1,6)_"-"_$E(PSANDC,7,10)_"-"_$E(PSANDC,11,12),1:"Blank") 43 ; 44 PRICE ;W !,"Unit Price : $" 45 S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","P",0)) 46 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJP=$S(+$P(PSANODE,"^",6):+$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2)) 47 ;Adj. Unit Price 48 I $G(PSADJP) D 49 .I $L($P(PSADJP,".",2))<2 S PSADJP=$P(PSADJP,".")_"."_$P(PSADJP,".",2)_$E("00",1,(2-$L($P(PSADJP,".",2)))) 50 .;W $FN(PSADJP,",")_" ($"_$S(+$P(PSADATA,"^",5):$FN($P(PSADATA,"^",5),","),$P(PSADATA,"^",5)=0:"0.00",1:"")_")" 51 .S PSAPRICE=PSADJP 52 I '$G(PSADJP) D 53 .S PSAPRICE=+$P(PSADATA,"^",5) 54 .;I $G(PSAPRICE)!(PSAPRICE=0) W $S($G(PSAPRICE):PSAPRICE,1:"0.00") Q 55 .;W "Blank" 56 ; 57 VSN ;W ?38,"VSN: "_$S(PSAVSN'="":PSAVSN,1:"Blank"),! 58 VDU S PSADUOU=+$P(PSATEMP,"^"),PSAREORD=+$P(PSATEMP,"^",2),PSASUB=+$P(PSATEMP,"^",3),PSASTOCK=+$P(PSATEMP,"^",4) 59 S INVARRAY(PSAORD,PSAINV,PSALINE)=$G(PSADRG)_"~"_$G(PSADRUGN)_"^"_$G(PSAQTY)_"^"_$G(PSALOC)_"^"_$G(PSAOU)_"^"_$G(PSANDC)_"^"_$G(PSAPRICE)_"^"_$G(PSAVSN)_"^"_$G(PSAUPC) 60 ; 61 I '+$P($G(^PSD(58.8,+PSALOC,0)),"^",14) G DISPLN 62 ; 63 STOCK S PSASTOCK=$S(+PSASTOCK:+PSASTOCK,+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3):+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3),1:"Blank") 64 REORDER S PSAREORD=$S(+PSAREORD:+PSAREORD,+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5):+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5),1:"Blank") 65 S INVARRAY(PSAORD,PSAINV,PSALINE)=$G(INVARRAY(PSAORD,PSAINV,PSALINE))_"^"_$G(PSASTOCK)_"^"_$G(PSAREORD) 66 G DISPLN 67 ASK R !!,"Enter an '^' to abort, <RET> to continue, or a corresponding line item number: ",AN:DTIME I AN="" G DISPLN 68 I AN["^" G Q 69 I AN<0!(AN>CNT) W !,"Enter a number between 1 and ",CNT G ASK 70 S (PSALINE,PSALINEN)=AN 71 PROCSS I '$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)) W !,"Invalid line number." G ASK 72 S PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),PSASUP=0 73 S PSANDC=$P(PSADATA,"^",11),PSAVSN=$P(PSADATA,"^",12),PSALOC=$S($P(PSADATA,"^",10):+$P(PSAIN,"^",12),1:+$P(PSAIN,"^",5)) 74 VIEW S PSALINEN=" " D VERDISP^PSAUTL4 W !,PSASLN,! 75 W "1. Drug",!,"2. Order Unit",! S PSACHO=2 76 S DIR(0)="LO^1:"_PSACHO,DIR("A")="Edit fields",DIR("?")="Enter the number(s) of the data to be edited" S DIR("??")="^D DDQOR^PSAVER3" 77 D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q 78 Q:Y="" S PSAFLDS=Y,PSASET=0 ;D VERDISP^PSAUTL4 W PSASLN 79 FIELDS F PSAPCF=1:1 S PSAFLD=$P(PSAFLDS,",",PSAPCF) Q:'PSAFLD!(PSAOUT) D 80 .I PSAFLD=1 D ASKDRUG^PSAVERA2 Q 81 .I PSAFLD=2 D OU^PSAVER2 Q 82 Q Q 83 ; 84 UPDATE ; *63 RJS CODE REMOVED FROM PSAVERA AND CALLED BY PSAVERA 85 ;File data in 58.8 86 ;PSALOC= Either PSALOC or PSALOCB 87 S PSADRG=PSABFR 88 F L +^PSD(58.8,PSALOC,1,PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 89 S PSADUREC=PSAQTY*$G(PSAODUOU),PSABAL=$P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",4),$P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",4)=PSABAL-$G(PSABFR("Q")) 90 L -^PSD(58.8,PSALOC,1,PSADRG,0) 91 S PSADRG=PSAAFTER,PSAABAL=PSABAL,PSADUREC=PSAQTY*$G(PSADUOU) 92 D NOW^%DTC S PSADT=+$E(%,1,14) 93 I '$D(^PSD(58.8,PSALOC,1,PSADRG,0)) D 94 .S:'$D(^PSD(58.8,PSALOC,1,0)) DIC("P")=$P(^DD(58.8,10,0),"^",2) 95 .S DA(1)=PSALOC,DIC="^PSD(58.8,"_DA(1)_",1,",(DA,DINUM,X)=PSADRG,DIC(0)="L",DLAYGO=58.8 ;*53 96 .F L +^PSD(58.8,PSALOC,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 97 .D FILE^DICN L -^PSD(58.8,PSALOC,0) K DIC,DA,DLAYGO 98 F L +^PSD(58.8,PSALOC,1,PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 99 S PSABAL=$P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",4) 100 I $P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",1)'=PSADRG S $P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",1)=PSADRG 101 S $P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",4)=PSADUREC+PSABAL 102 I +$P($G(^PSD(58.8,PSALOC,0)),"^",14) D 103 .I PSASTOCK'=$P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",3) S $P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",3)=PSASTOCK 104 .I PSAREORD'=$P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",5) S $P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",5)=PSAREORD 105 S:'$D(^PSD(58.8,PSALOC,1,PSADRG,5,0)) DIC("P")=$P(^DD(58.8001,20,0),"^",2) 106 I '$D(^PSD(58.8,PSALOC,1,PSADRG,5,$E(DT,1,5)*100,0)) D 107 .S DIC="^PSD(58.8,"_PSALOC_",1,"_PSADRG_",5,",DIC(0)="L",DIC("DR")="1////^S X=$G(PSABAL)",(X,DINUM)=$E(DT,1,5)*100,DA(2)=PSALOC,DA(1)=PSADRG,DLAYGO=58.8 D ^DIC K DIC 108 .S X="T-1M" D ^%DT S DIC="^PSD(58.8,"_PSALOC_",1,"_PSADRG_",5,",DIC(0)="L",(X,DINUM)=$E(Y,1,5)*100 D ^DIC K DIC,DLAYGO S DA=+Y 109 .S DA(2)=PSALOC,DA(1)=PSADRG,DIE="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",5,",DR="3////^S X=$G(PSABAL)" D ^DIE K DIE 110 S DA(2)=PSALOC,DA(1)=PSADRG,DIE="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",5,",DA=$E(DT,1,5)*100,DR="5////^S X="_($P($G(^(0)),"^",3)+PSADUREC) D ^DIE K DIE 111 L -^PSD(58.8,PSALOC,1,PSADRG,0) 112 W !,"updating pharmacy location file." 113 FILE581 ;Update transaction file ;;*63 114 S PSAVDUZ=DUZ,PSAREA="EDIT VERIFIED INVOICE" 115 I '$G(PSABFR(581)) D NEW581 Q 116 I PSADRG'=PSABFR S PSANQTY=0,PSAAQTY=$G(PSABFR("Q"))*-1 117 I PSADRG=PSABFR S PSANQTY=PSADUREC D 118 .S PSAAQTY=PSADUREC-$G(PSABFR("Q")) 119 FIND S PSAT=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSAT)) S $P(^PSD(58.81,0),"^",3)=$P(^PSD(58.81,0),"^",3)+1 G FIND 120 S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSAT D ^DIC K DIC,DINUM,DLAYGO L -^PSD(58.81,0) 121 S DIE="^PSD(58.81,",DA=PSAT 122 I PSAAFTER'=PSABFR S PSADRG=PSABFR 123 S DR="1////14;2////^S X=PSALOC;3////^S X=PSADT;4////^S X=PSADRG;48////^S X=PSADT;49////^S X=PSAVDUZ;50////^S X=PSANQTY;51////^S X=PSAAQTY;53////^S X=PSAREA;54////^S X=PSAABAL;71////^S X=PSAINV;106////^S X=PSAORD" 124 F L +^PSD(58.81,DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 125 D ^DIE L -^PSD(58.81,DA,0) K DIE 126 I PSAAFTER'=PSABFR S PSADRG=PSAAFTER D NEW581 127 Q 128 ; 129 NEW581 S PSAT=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSAT)) S $P(^PSD(58.81,0),"^",3)=$P(^PSD(58.81,0),"^",3)+1 G NEW581 130 S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSAT D ^DIC K DIC,DINUM,DLAYGO L -^PSD(58.81,0) 131 S PSADUREC=PSAQTY*$G(PSADUOU) 132 S DIE="^PSD(58.81,",DA=PSAT,DR="1////1;2////^S X=PSALOC;3////^S X=PSADT;4////^S X=PSADRG;5////^S X=PSADUREC;6////^S X=PSAVDUZ;9////^S X=PSABAL;71////^S X=PSAINV;106////^S X=PSAORD" 133 I $G(PSACS)>0 S DR=DR_";100////^S X=PSACS" 134 F L +^PSD(58.81,DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 135 D ^DIE L -^PSD(58.81,DA,0) K DIE W !,"updating transaction file." Q 136 Q 1 PSAVERA1 ;BHM/DB - Edit previously verified invoices;16NOV99 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21,61**; 10/24/97;Build 1 3 ;References to ^DIC(51.5 are covered by IA #1931 4 ;References to ^PSDRUG( are covered by IA #2095 5 ; 6 S $P(PSASLN,"=",79)="" K PSALINE 7 DISPLN S PSALINE=$S('$D(PSALINE):$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,0)),1:$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE))) G Q:PSALINE'>0 S CNT=$G(CNT)+1 8 S PSADATA=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)) 9 S PSATEMP=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2)) 10 S PSAVSN=$P(PSADATA,"^",12),PSAOUT=0 11 DRUG S PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","D",0)) 12 I $G(PSADJ) D 13 .S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)) 14 .S PSADJD=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 15 .S PSASUP=$S(PSADJD'?1.N:1,1:0) 16 .S PSADRG=$S(PSADJ&('PSASUP):$G(PSADJD),PSADJ&(PSASUP):0,1:+$P(PSADATA,"^",2)) 17 .I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")'="" S (PSADRG,PSA50IEN)=+PSADJD Q 18 .I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")="" S (PSADJ,PSADRG)=0 Q 19 .S PSADJSUP=1,(PSADRG,PSA50IEN)=PSADJD 20 I '$G(PSADJ) D 21 .S (PSA50IEN,PSADRG)=$S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):+$P(PSADATA,"^",2),1:0) 22 S PSADRUGN=$S($P($G(^PSDRUG(PSADRG,0)),"^")'="":$P($G(^PSDRUG(PSADRG,0)),"^"),1:"Unknown Drug Name") 23 QTY ;Quantity 24 ;No Adj. Qty 25 S PSADJQ="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","Q",0)) 26 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJQ=$S($P(PSANODE,"^",6)'="":+$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 27 ;Adj. Qty 28 I $G(PSADJQ) S PSAQTY=PSADJQ 29 I '$G(PSADJQ) S PSAQTY=$P(PSADATA,"^",3) 30 UPC S:$P(PSADATA,"^",13) PSAUPC=$P(PSADATA,"^",13) 31 OU ;W !,"Order Unit : " 32 S PSAOU=$S(+$P(PSADATA,"^",4)&($P($G(^DIC(51.5,+$P(PSADATA,"^",4),0)),"^")'=""):+$P(PSADATA,"^",4),1:"") 33 S PSATEMP=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2)) 34 I +$P(PSATEMP,"^",3),PSADRG,+$P($G(^PSDRUG(PSADRG,1,+$P(PSATEMP,"^",3),0)),"^",5) S PSAOU=+$P(^PSDRUG(PSADRG,1,+$P(PSATEMP,"^",3),0),"^",5) 35 S PSADJO="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","O",0)) 36 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJO=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 37 ;Adj. Order Unit 38 I PSADJO'="" S PSAOU=+PSADJO 39 I PSADJO="" ;W $S(+PSAOU:$P($G(^DIC(51.5,+PSAOU,0)),"^"),1:"Blank") 40 ; 41 NDC S PSANDC=$P(PSADATA,"^",11) 42 ;I $E(PSANDC)'="S" W ?38,"NDC: "_$S(PSANDC'="":$E(PSANDC,1,6)_"-"_$E(PSANDC,7,10)_"-"_$E(PSANDC,11,12),1:"Blank") 43 ; 44 PRICE ;W !,"Unit Price : $" 45 S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","P",0)) 46 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJP=$S(+$P(PSANODE,"^",6):+$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2)) 47 ;Adj. Unit Price 48 I $G(PSADJP) D 49 .I $L($P(PSADJP,".",2))<2 S PSADJP=$P(PSADJP,".")_"."_$P(PSADJP,".",2)_$E("00",1,(2-$L($P(PSADJP,".",2)))) 50 .;W $FN(PSADJP,",")_" ($"_$S(+$P(PSADATA,"^",5):$FN($P(PSADATA,"^",5),","),$P(PSADATA,"^",5)=0:"0.00",1:"")_")" 51 .S PSAPRICE=PSADJP 52 I '$G(PSADJP) D 53 .S PSAPRICE=+$P(PSADATA,"^",5) 54 .;I $G(PSAPRICE)!(PSAPRICE=0) W $S($G(PSAPRICE):PSAPRICE,1:"0.00") Q 55 .;W "Blank" 56 ; 57 VSN ;W ?38,"VSN: "_$S(PSAVSN'="":PSAVSN,1:"Blank"),! 58 VDU S PSADUOU=+$P(PSATEMP,"^"),PSAREORD=+$P(PSATEMP,"^",2),PSASUB=+$P(PSATEMP,"^",3),PSASTOCK=+$P(PSATEMP,"^",4) 59 S INVARRAY(PSAORD,PSAINV,PSALINE)=$G(PSADRG)_"~"_$G(PSADRUGN)_"^"_$G(PSAQTY)_"^"_$G(PSALOC)_"^"_$G(PSAOU)_"^"_$G(PSANDC)_"^"_$G(PSAPRICE)_"^"_$G(PSAVSN)_"^"_$G(PSAUPC) 60 ; 61 I '+$P($G(^PSD(58.8,+PSALOC,0)),"^",14) G DISPLN 62 ; 63 STOCK S PSASTOCK=$S(+PSASTOCK:+PSASTOCK,+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3):+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3),1:"Blank") 64 REORDER S PSAREORD=$S(+PSAREORD:+PSAREORD,+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5):+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5),1:"Blank") 65 S INVARRAY(PSAORD,PSAINV,PSALINE)=$G(INVARRAY(PSAORD,PSAINV,PSALINE))_"^"_$G(PSASTOCK)_"^"_$G(PSAREORD) 66 G DISPLN 67 ASK R !!,"Enter an '^' to abort, <RET> to continue, or a corresponding line item number: ",AN:DTIME I AN="" G DISPLN 68 I AN["^" G Q 69 I AN<0!(AN>CNT) W !,"Enter a number between 1 and ",CNT G ASK 70 S (PSALINE,PSALINEN)=AN 71 PROCSS I '$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)) W !,"Invalid line number." G ASK 72 S PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),PSASUP=0 73 S PSANDC=$P(PSADATA,"^",11),PSAVSN=$P(PSADATA,"^",12),PSALOC=$S($P(PSADATA,"^",10):+$P(PSAIN,"^",12),1:+$P(PSAIN,"^",5)) 74 VIEW S PSALINEN=" " D VERDISP^PSAUTL4 W !,PSASLN,! 75 W "1. Drug",!,"2. Order Unit",! S PSACHO=2 76 S DIR(0)="LO^1:"_PSACHO,DIR("A")="Edit fields",DIR("?")="Enter the number(s) of the data to be edited" S DIR("??")="^D DDQOR^PSAVER3" 77 D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q 78 Q:Y="" S PSAFLDS=Y,PSASET=0 ;D VERDISP^PSAUTL4 W PSASLN 79 FIELDS F PSAPCF=1:1 S PSAFLD=$P(PSAFLDS,",",PSAPCF) Q:'PSAFLD!(PSAOUT) D 80 .I PSAFLD=1 D ASKDRUG^PSAVERA2 Q 81 .I PSAFLD=2 D OU^PSAVER2 Q 82 Q Q
Note:
See TracChangeset
for help on using the changeset viewer.
