PSAAOP ;BIR/DB - Price Conversion Routine;4/3/00
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21**; 10/24/97
;PSA*3*21 : 14145837
;References to ^PSDRUG( are covered by IA #2095
Q K DA,DIE,DIR,DR,PSALOC,PSALOCN,PSAOP,PSAOSITN
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"
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"
W !,"found in the synonym data."
W !!,"Please note - Because this process checks each NDC in the DRUG file (#50),"
W !,"it is suggested that you queue the option to run during low usage times."
PRICE R !!,"Fix synonym entries? YES // ",AN:DTIME G NOQ:AN["^" I AN="" S AN="Y"
S AN=$E(AN,1) I "yYNn"'[AN W !!,"Answer 'Y' for YES, or 'N' for NO." K AN G PRICE
I "nN"[AN G NOQ
S PSADUZ=DUZ,ZTSAVE("PSADUZ")=""
S ZTIO=""
S ZTRTN="PSANDC^PSAAOP",ZTDESC="Drug Accountability Price Correction" D ^%ZTLOAD,HOME^%ZIS G EXITQ
;
PSANDC ;Entry point for price correction
;
K PSADRG,PSACNT,PSADRG1,PSASUB,PSADATA,DRGCNT,FIXCNT
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
S PSANDC=$P($G(^PSDRUG(PSADRG,2)),"^",4) G PSADRG:$G(PSANDC)=""
;
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
G PSASUB
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
;
S XX=PSAOU/PSADUOU,NEWPRICE=$J(XX,0,3) I NEWPRICE'=PSAPDUOU D
.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)
.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)=" "
.S DIE="^PSDRUG(",DA=PSADRG,DR="16///^S X=NEWPRICE" D
..F L +^PSDRUG(PSADRG,0):0 I Q
..D ^DIE K DIE,DA,DR
..S DA(1)=PSADRG,DIE="^PSDRUG("_DA(1)_",1,",DA=PSASUB,DR="404////^S X=NEWPRICE" D ^DIE
..L -^PSDRUG(PSADRG,0)
.S FIXCNT=$G(FIXCNT)+1
G PSADRG
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
S ^TMP("PSAAOP",$J,1,0)="Price correction process results"
S XMDUZ="Patch: PSA*3*21 price Corrector",XMSUB="Drug Accountability Synonym Fix",XMTEXT="^TMP(""PSAAOP"",$J,"
S XMY(PSADUZ)=""
G:'$D(XMY) QQ D ^XMD
K ^TMP("PSAAOP",$J)
Q
NOQ W !,"Nothing corrected." Q
EXITQ Q
PSAAOP ;BIR/DB - Price Conversion Routine;4/3/00
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21**; 10/24/97
+2 ;PSA*3*21 : 14145837
+3 ;References to ^PSDRUG( are covered by IA #2095
Q KILL DA,DIE,DIR,DR,PSALOC,PSALOCN,PSAOP,PSAOSITN
+1 WRITE !!,"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"
+2 WRITE !,"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"
+3 WRITE !,"found in the synonym data."
+4 WRITE !!,"Please note - Because this process checks each NDC in the DRUG file (#50),"
+5 WRITE !,"it is suggested that you queue the option to run during low usage times."
PRICE READ !!,"Fix synonym entries? YES // ",AN:DTIME
IF AN["^"
GOTO NOQ
IF AN=""
SET AN="Y"
+1 SET AN=$EXTRACT(AN,1)
IF "yYNn"'[AN
WRITE !!,"Answer 'Y' for YES, or 'N' for NO."
KILL AN
GOTO PRICE
+2 IF "nN"[AN
GOTO NOQ
+3 SET PSADUZ=DUZ
SET ZTSAVE("PSADUZ")=""
+4 SET ZTIO=""
+5 SET ZTRTN="PSANDC^PSAAOP"
SET ZTDESC="Drug Accountability Price Correction"
DO ^%ZTLOAD
DO HOME^%ZIS
GOTO EXITQ
+6 ;
PSANDC ;Entry point for price correction
+1 ;
+2 KILL PSADRG,PSACNT,PSADRG1,PSASUB,PSADATA,DRGCNT,FIXCNT
PSADRG SET PSADRG1=$SELECT('$DATA(PSADRG1):$ORDER(^PSDRUG("B",0)),1:$ORDER(^PSDRUG("B",PSADRG1)))
IF PSADRG1=""
GOTO QQ
KILL PSASUB
SET DRGCNT=$GET(DRGCNT)+1
SET PSADRG=$ORDER(^PSDRUG("B",PSADRG1,0))
IF $GET(^PSDRUG(PSADRG,0))=""
GOTO PSADRG
+1 SET PSANDC=$PIECE($GET(^PSDRUG(PSADRG,2)),"^",4)
IF $GET(PSANDC)=""
GOTO PSADRG
+2 ;
PSASUB SET PSASUB=$SELECT('$DATA(PSASUB):$ORDER(^PSDRUG(PSADRG,1,0)),1:$ORDER(^PSDRUG(PSADRG,1,PSASUB)))
IF PSASUB'>0
GOTO PSADRG
SET PSADATA=$GET(^PSDRUG(PSADRG,1,PSASUB,0))
IF $PIECE(PSADATA,"^",2)=PSANDC
GOTO DONESUB
+1 GOTO PSASUB
DONESUB SET PSAOU=$PIECE($GET(PSADATA),"^",6)
SET PSADUOU=$PIECE($GET(PSADATA),"^",7)
SET PSAPDUOU=$JUSTIFY($PIECE($GET(PSADATA),"^",8),0,3)
IF $GET(PSAOU)=""!($GET(PSADUOU)="")
GOTO PSADRG
+1 ;
+2 SET XX=PSAOU/PSADUOU
SET NEWPRICE=$JUSTIFY(XX,0,3)
IF NEWPRICE'=PSAPDUOU
Begin DoDot:1
+3 SET PSACNT=$SELECT('$DATA(PSACNT):4,1:$GET(PSACNT)+1)
SET ^TMP("PSAAOP",$JOB,PSACNT,0)="NDC : "_PSANDC_" Drug Name : "_$EXTRACT($PIECE($GET(^PSDRUG(PSADRG,0)),"^"),1,35)
+4 SET PSACNT=$SELECT('$DATA(PSACNT):4,1:$GET(PSACNT)+1)
SET ^TMP("PSAAOP",$JOB,PSACNT,0)="Old Price : "_$JUSTIFY(PSAPDUOU,8,3)_" New Price : "_$JUSTIFY(NEWPRICE,8,3)
SET PSACNT=PSACNT+1
SET ^TMP("PSAAOP",$JOB,PSACNT,0)=" "
+5 SET DIE="^PSDRUG("
SET DA=PSADRG
SET DR="16///^S X=NEWPRICE"
Begin DoDot:2
+6 FOR
LOCK +^PSDRUG(PSADRG,0):0
IF $TEST
QUIT
+7 DO ^DIE
KILL DIE,DA,DR
+8 SET DA(1)=PSADRG
SET DIE="^PSDRUG("_DA(1)_",1,"
SET DA=PSASUB
SET DR="404////^S X=NEWPRICE"
DO ^DIE
+9 LOCK -^PSDRUG(PSADRG,0)
End DoDot:2
+10 SET FIXCNT=$GET(FIXCNT)+1
End DoDot:1
+11 GOTO PSADRG
QQ SET ^TMP("PSAAOP",$JOB,2,0)=$GET(DRGCNT)_" items checked, and "_$SELECT($GET(FIXCNT)="":0,1:$GET(FIXCNT))_" items corrected."
KILL PSADRG,PSAOU,PSADUOU,NEWPRICE,PSAPDUOU,DATA,PSADATA
+1 SET ^TMP("PSAAOP",$JOB,1,0)="Price correction process results"
+2 SET XMDUZ="Patch: PSA*3*21 price Corrector"
SET XMSUB="Drug Accountability Synonym Fix"
SET XMTEXT="^TMP(""PSAAOP"",$J,"
+3 SET XMY(PSADUZ)=""
+4 IF '$DATA(XMY)
GOTO QQ
DO ^XMD
+5 KILL ^TMP("PSAAOP",$JOB)
+6 QUIT
NOQ WRITE !,"Nothing corrected."
QUIT
EXITQ QUIT
