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