source: WorldVistAEHR/trunk/r/CMOP-PSX/PSXCOSTU.m@ 861

PSXCOSTU ;BIR/BAB,WPB,HTW-Cost Update ; 26 Apr 2000  10:52 AM

 ;;2.0;CMOP;**18,19,27**;11 Apr 97

 ;Reference to ^PSDRUG( supported by DBIA #2367, #1983

 ;

 ;This routine will update the CMOP Master Database file with cost data from the drug file. Discrepancies will be reported via mail message.

 Q

BLANK S ^XMB(3.9,XMZ,2,MCT,0)="" S MCT=MCT+1

 Q

EN ;

 W !! S DIR(0)="D^::EX",DIR("A")="Enter Begin Date ",DIR("?")="Enter the beginning date for the report" D ^DIR K DIR,DIR("?")

 G:($D(DIRUT))!($D(DIROUT)) EXIT

 S BB=Y,BEG=$$FMADD^XLFDT(BB,-1,0,0,0) K Y

EDT W !! S DIR(0)="DO^::EX",DIR("A")="Enter End Date ",DIR("?")="Enter the ending date for the report" D ^DIR K DIR,DIR("?")

 I $G(Y)']"" W !! G EN

 G:($D(DIRUT))!($D(DIROUT)) EXIT

 I Y<BB W !,"End Date must follow Begin Date!" K Y,DIR G EDT

 S EE=Y,END=$$FMADD^XLFDT(EE,1,0,0,0) K Y,EE

QUE S ZTRTN="GET^PSXCOSTU",ZTIO="",ZTSAVE("BEG")="",ZTSAVE("END")=""

 S ZTDESC="CMOP Cost Update for Master Database",ZTSAVE("DUZ")=""

 D ^%ZTLOAD

 I $D(ZTSK)[0 W !!,"Job Cancelled"

 E  W !!,"Job Queued"

 G EXIT

 ; Called by Taskman to Build Cost Data

GET S (C1,CNT)=1

 F  S BEG=$O(^PSX(552.4,"AD",BEG)) Q:BEG'>0!(BEG=END)  S XX=0 F  S XX=$O(^PSX(552.4,"AD",BEG,XX)) Q:XX'>0  S YY=0 F  S YY=$O(^PSX(552.4,"AD",BEG,XX,YY)) Q:YY'>0  D

 .I $P($G(^PSX(552.4,XX,1,YY,0)),U,2)'=1 Q

 .I $P(^PSX(552.4,XX,1,YY,0),U,11)>0 Q

 .S IDDRG=$P($G(^PSX(552.4,XX,1,YY,0)),U,4) Q:$G(IDDRG)=""

 .S CDT=$P($G(^PSX(552.4,XX,1,YY,0)),U,9) I $G(CDT) S Y=$P(CDT,".") X ^DD("DD") S CDT=Y K Y

 .S IEN50=$O(^PSDRUG("AQ1",IDDRG,""))

 .I $G(IEN50)']"" S ^TMP($J,"PSX",CNT)=IDDRG_"     "_$G(CDT) S CNT=CNT+1 Q

 .S COST=$P($G(^PSDRUG(IEN50,660)),U,6)

 .S Z1=$P($G(^PSDRUG(IEN50,"ND")),U),Z2=$P($G(^("ND")),U,3)

 .I $G(Z1),($G(Z2)) S ZX=$$PROD2^PSNAPIS(Z1,Z2),TRUG=$P($G(ZX),"^")

 .I $G(COST)']"" S ^TMP($J,"PSX1",C1)=IDDRG_"     "_$G(CDT)_"     "_$G(TRUG) S C1=C1+1 Q

 .S DA(1)=XX,DA=YY,DIE="^PSX(552.4,"_XX_",1,",DR="10////"_$G(COST) D ^DIE

 .K DA(1),DA,COST,IDDRG,IEN50,DIE,DR,Z1,Z2

MSG ;

 I '$D(^TMP($J,"PSX")),('$D(^TMP($J,"PSX1"))) G EXIT

 S XMSUB="CMOP COST UPDATE",XMDUZ=.5

XMZ D XMZ^XMA2

 I XMZ'>0 G XMZ

 S MCT=2

 D NOW^%DTC S Y=% X ^DD("DD")

 S ^XMB(3.9,XMZ,2,1,0)="CMOP Master Database Drug Cost Update   "_Y K Y

 F I=1:1:2 D BLANK

 I '$D(^TMP($J,"PSX")) G PSX1

 S ^XMB(3.9,XMZ,2,MCT,0)="The drug ID's listed below are missing a corresponding entry in Drug file 50,  therefore, no cost information can be updated for any prescription written"

 S MCT=MCT+1

 S ^XMB(3.9,XMZ,2,MCT,0)="for this drug.  When the drug file entry is available, the Cost Update option  may be re-run for the dates indicated to enter the costs for these drugs."

 S MCT=MCT+1

 D BLANK

 S ^XMB(3.9,XMZ,2,MCT,0)="DRUG ID   COMPLETED D/T"

 S MCT=MCT+1

 D BLANK

 F I=0:0 S I=$O(^TMP($J,"PSX",I)) Q:'I  D

 .S ^XMB(3.9,XMZ,2,MCT,0)=^TMP($J,"PSX",I) S MCT=MCT+1

 F I=1:1:2 D BLANK

PSX1 I '$D(^TMP($J,"PSX1")) G MSGEND

 S ^XMB(3.9,XMZ,2,MCT,0)="The Drug File entries listed below do not contain cost data so prescriptions   for these drugs have not been updated.  When the cost data is entered,  "

 S MCT=MCT+1

 S ^XMB(3.9,XMZ,2,MCT,0)="the Cost Update option may be re-run to update the prescription entries."

 S MCT=MCT+1

 D BLANK

 S ^XMB(3.9,XMZ,2,MCT,0)="DRUG ID   COMPLETED D/T   DRUG NAME"

 S MCT=MCT+1

 D BLANK

 F I=0:0 S I=$O(^TMP($J,"PSX1",I)) Q:'I  D

 .S ^XMB(3.9,XMZ,2,MCT,0)=^TMP($J,"PSX1",I) S MCT=MCT+1

MSGEND S ^XMB(3.9,XMZ,2,0)="^3.92A^"_MCT_U_MCT_U_DT,XMDUN="CMOP Manager"

 S XMDUZ=.5,XMY(DUZ)=""

 D ENT1^XMD

EXIT K ID,XX,YY,BEG,END,IDDRG,IEN50,CNT,COST,^TMP($J),CDT,BB

 K XMSER,XQMSG,XMZ,XMSUB S ZTREQ="@"

 Q