| 1 | PSAAOP ;BIR/DB - Price Conversion Routine;4/3/00
|
|---|
| 2 | ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21,64**; 10/24/97;Build 4
|
|---|
| 3 | ;PSA*3*21 : 14145837
|
|---|
| 4 | ;References to ^PSDRUG( are covered by IA #2095
|
|---|
| 5 | Q K DA,DIE,DIR,DR,PSALOC,PSALOCN,PSAOP,PSAOSITN
|
|---|
| 6 | W !!,"PSA*3*21 corrects errors in the way pricing was done in the past. The new",!,"process correctly calculates the price per dispense unit by dividing"
|
|---|
| 7 | W !,"the Price per Order Unit by the Dispense Units per Order Unit.",!!,"It loops through each entry in the DRUG file (#50) and corrects any problems"
|
|---|
| 8 | W !,"found in the synonym data."
|
|---|
| 9 | W !!,"Please note - Because this process checks each NDC in the DRUG file (#50),"
|
|---|
| 10 | W !,"it is suggested that you queue the option to run during low usage times."
|
|---|
| 11 | PRICE R !!,"Fix synonym entries? YES // ",AN:DTIME G NOQ:AN["^" I AN="" S AN="Y"
|
|---|
| 12 | S AN=$E(AN,1) I "yYNn"'[AN W !!,"Answer 'Y' for YES, or 'N' for NO." K AN G PRICE
|
|---|
| 13 | I "nN"[AN G NOQ
|
|---|
| 14 | S PSADUZ=DUZ,ZTSAVE("PSADUZ")=""
|
|---|
| 15 | S ZTIO=""
|
|---|
| 16 | S ZTRTN="PSANDC^PSAAOP",ZTDESC="Drug Accountability Price Correction" D ^%ZTLOAD,HOME^%ZIS G EXITQ
|
|---|
| 17 | ;
|
|---|
| 18 | PSANDC ;Entry point for price correction
|
|---|
| 19 | ;
|
|---|
| 20 | K PSADRG,PSACNT,PSADRG1,PSASUB,PSADATA,DRGCNT,FIXCNT
|
|---|
| 21 | PSADRG S PSADRG1=$S('$D(PSADRG1):$O(^PSDRUG("B",0)),1:$O(^PSDRUG("B",PSADRG1))) G QQ:PSADRG1="" K PSASUB S DRGCNT=$G(DRGCNT)+1,PSADRG=$O(^PSDRUG("B",PSADRG1,0)) I $G(^PSDRUG(PSADRG,0))="" G PSADRG
|
|---|
| 22 | S PSANDC=$P($G(^PSDRUG(PSADRG,2)),"^",4) G PSADRG:$G(PSANDC)=""
|
|---|
| 23 | ;
|
|---|
| 24 | PSASUB S PSASUB=$S('$D(PSASUB):$O(^PSDRUG(PSADRG,1,0)),1:$O(^PSDRUG(PSADRG,1,PSASUB))) G PSADRG:PSASUB'>0 S PSADATA=$G(^PSDRUG(PSADRG,1,PSASUB,0)) I $P(PSADATA,"^",2)=PSANDC G DONESUB
|
|---|
| 25 | G PSASUB
|
|---|
| 26 | DONESUB S PSAOU=$P($G(PSADATA),"^",6),PSADUOU=$P($G(PSADATA),"^",7),PSAPDUOU=$J($P($G(PSADATA),"^",8),0,3) I $G(PSAOU)=""!($G(PSADUOU)="") G PSADRG
|
|---|
| 27 | ;
|
|---|
| 28 | S XX=PSAOU/PSADUOU,NEWPRICE=$J(XX,0,3) I NEWPRICE'=PSAPDUOU D
|
|---|
| 29 | .S PSACNT=$S('$D(PSACNT):4,1:$G(PSACNT)+1),^TMP("PSAAOP",$J,PSACNT,0)="NDC : "_PSANDC_" Drug Name : "_$E($P($G(^PSDRUG(PSADRG,0)),"^"),1,35)
|
|---|
| 30 | .S PSACNT=$S('$D(PSACNT):4,1:$G(PSACNT)+1),^TMP("PSAAOP",$J,PSACNT,0)="Old Price : "_$J(PSAPDUOU,8,3)_" New Price : "_$J(NEWPRICE,8,3),PSACNT=PSACNT+1,^TMP("PSAAOP",$J,PSACNT,0)=" "
|
|---|
| 31 | .S DIE="^PSDRUG(",DA=PSADRG,DR="16///^S X=NEWPRICE" D
|
|---|
| 32 | ..F L +^PSDRUG(PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|---|
| 33 | ..D ^DIE K DIE,DA,DR
|
|---|
| 34 | ..S DA(1)=PSADRG,DIE="^PSDRUG("_DA(1)_",1,",DA=PSASUB,DR="404////^S X=NEWPRICE" D ^DIE
|
|---|
| 35 | ..L -^PSDRUG(PSADRG,0)
|
|---|
| 36 | .S FIXCNT=$G(FIXCNT)+1
|
|---|
| 37 | G PSADRG
|
|---|
| 38 | QQ S ^TMP("PSAAOP",$J,2,0)=$G(DRGCNT)_" items checked, and "_$S($G(FIXCNT)="":0,1:$G(FIXCNT))_" items corrected." K PSADRG,PSAOU,PSADUOU,NEWPRICE,PSAPDUOU,DATA,PSADATA
|
|---|
| 39 | S ^TMP("PSAAOP",$J,1,0)="Price correction process results"
|
|---|
| 40 | S XMDUZ="Patch: PSA*3*21 price Corrector",XMSUB="Drug Accountability Synonym Fix",XMTEXT="^TMP(""PSAAOP"",$J,"
|
|---|
| 41 | S XMY(PSADUZ)=""
|
|---|
| 42 | G:'$D(XMY) QQ D ^XMD
|
|---|
| 43 | K ^TMP("PSAAOP",$J)
|
|---|
| 44 | Q
|
|---|
| 45 | NOQ W !,"Nothing corrected." Q
|
|---|
| 46 | EXITQ Q
|
|---|
