- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXCOSTU 3687 printed Feb 18, 2025@23:10:03 Page 2
- PSXCOSTU ;BIR/BAB,WPB,HTW-Cost Update ; 26 Apr 2000 10:52 AM
- +1 ;;2.0;CMOP;**18,19,27**;11 Apr 97
- +2 ;Reference to ^PSDRUG( supported by DBIA #2367, #1983
- +3 ;
- +4 ;This routine will update the CMOP Master Database file with cost data from the drug file. Discrepancies will be reported via mail message.
- +5 QUIT
- BLANK SET ^XMB(3.9,XMZ,2,MCT,0)=""
- SET MCT=MCT+1
- +1 QUIT
- EN ;
- +1 WRITE !!
- SET DIR(0)="D^::EX"
- SET DIR("A")="Enter Begin Date "
- SET DIR("?")="Enter the beginning date for the report"
- DO ^DIR
- KILL DIR,DIR("?")
- +2 if ($DATA(DIRUT))!($DATA(DIROUT))
- GOTO EXIT
- +3 SET BB=Y
- SET BEG=$$FMADD^XLFDT(BB,-1,0,0,0)
- KILL Y
- EDT WRITE !!
- SET DIR(0)="DO^::EX"
- SET DIR("A")="Enter End Date "
- SET DIR("?")="Enter the ending date for the report"
- DO ^DIR
- KILL DIR,DIR("?")
- +1 IF $GET(Y)']""
- WRITE !!
- GOTO EN
- +2 if ($DATA(DIRUT))!($DATA(DIROUT))
- GOTO EXIT
- +3 IF Y<BB
- WRITE !,"End Date must follow Begin Date!"
- KILL Y,DIR
- GOTO EDT
- +4 SET EE=Y
- SET END=$$FMADD^XLFDT(EE,1,0,0,0)
- KILL Y,EE
- QUE SET ZTRTN="GET^PSXCOSTU"
- SET ZTIO=""
- SET ZTSAVE("BEG")=""
- SET ZTSAVE("END")=""
- +1 SET ZTDESC="CMOP Cost Update for Master Database"
- SET ZTSAVE("DUZ")=""
- +2 DO ^%ZTLOAD
- +3 IF $DATA(ZTSK)[0
- WRITE !!,"Job Cancelled"
- +4 IF '$TEST
- WRITE !!,"Job Queued"
- +5 GOTO EXIT
- +6 ; Called by Taskman to Build Cost Data
- GET SET (C1,CNT)=1
- +1 FOR
- SET BEG=$ORDER(^PSX(552.4,"AD",BEG))
- if BEG'>0!(BEG=END)
- QUIT
- SET XX=0
- FOR
- SET XX=$ORDER(^PSX(552.4,"AD",BEG,XX))
- if XX'>0
- QUIT
- SET YY=0
- FOR
- SET YY=$ORDER(^PSX(552.4,"AD",BEG,XX,YY))
- if YY'>0
- QUIT
- Begin DoDot:1
- +2 IF $PIECE($GET(^PSX(552.4,XX,1,YY,0)),U,2)'=1
- QUIT
- +3 IF $PIECE(^PSX(552.4,XX,1,YY,0),U,11)>0
- QUIT
- +4 SET IDDRG=$PIECE($GET(^PSX(552.4,XX,1,YY,0)),U,4)
- if $GET(IDDRG)=""
- QUIT
- +5 SET CDT=$PIECE($GET(^PSX(552.4,XX,1,YY,0)),U,9)
- IF $GET(CDT)
- SET Y=$PIECE(CDT,".")
- XECUTE ^DD("DD")
- SET CDT=Y
- KILL Y
- +6 SET IEN50=$ORDER(^PSDRUG("AQ1",IDDRG,""))
- +7 IF $GET(IEN50)']""
- SET ^TMP($JOB,"PSX",CNT)=IDDRG_" "_$GET(CDT)
- SET CNT=CNT+1
- QUIT
- +8 SET COST=$PIECE($GET(^PSDRUG(IEN50,660)),U,6)
- +9 SET Z1=$PIECE($GET(^PSDRUG(IEN50,"ND")),U)
- SET Z2=$PIECE($GET(^("ND")),U,3)
- +10 IF $GET(Z1)
- IF ($GET(Z2))
- SET ZX=$$PROD2^PSNAPIS(Z1,Z2)
- SET TRUG=$PIECE($GET(ZX),"^")
- +11 IF $GET(COST)']""
- SET ^TMP($JOB,"PSX1",C1)=IDDRG_" "_$GET(CDT)_" "_$GET(TRUG)
- SET C1=C1+1
- QUIT
- +12 SET DA(1)=XX
- SET DA=YY
- SET DIE="^PSX(552.4,"_XX_",1,"
- SET DR="10////"_$GET(COST)
- DO ^DIE
- +13 KILL DA(1),DA,COST,IDDRG,IEN50,DIE,DR,Z1,Z2
- End DoDot:1
- MSG ;
- +1 IF '$DATA(^TMP($JOB,"PSX"))
- IF ('$DATA(^TMP($JOB,"PSX1")))
- GOTO EXIT
- +2 SET XMSUB="CMOP COST UPDATE"
- SET XMDUZ=.5
- XMZ DO XMZ^XMA2
- +1 IF XMZ'>0
- GOTO XMZ
- +2 SET MCT=2
- +3 DO NOW^%DTC
- SET Y=%
- XECUTE ^DD("DD")
- +4 SET ^XMB(3.9,XMZ,2,1,0)="CMOP Master Database Drug Cost Update "_Y
- KILL Y
- +5 FOR I=1:1:2
- DO BLANK
- +6 IF '$DATA(^TMP($JOB,"PSX"))
- GOTO PSX1
- +7 SET ^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"
- +8 SET MCT=MCT+1
- +9 SET ^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."
- +10 SET MCT=MCT+1
- +11 DO BLANK
- +12 SET ^XMB(3.9,XMZ,2,MCT,0)="DRUG ID COMPLETED D/T"
- +13 SET MCT=MCT+1
- +14 DO BLANK
- +15 FOR I=0:0
- SET I=$ORDER(^TMP($JOB,"PSX",I))
- if 'I
- QUIT
- Begin DoDot:1
- +16 SET ^XMB(3.9,XMZ,2,MCT,0)=^TMP($JOB,"PSX",I)
- SET MCT=MCT+1
- End DoDot:1
- +17 FOR I=1:1:2
- DO BLANK
- PSX1 IF '$DATA(^TMP($JOB,"PSX1"))
- GOTO MSGEND
- +1 SET ^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, "
- +2 SET MCT=MCT+1
- +3 SET ^XMB(3.9,XMZ,2,MCT,0)="the Cost Update option may be re-run to update the prescription entries."
- +4 SET MCT=MCT+1
- +5 DO BLANK
- +6 SET ^XMB(3.9,XMZ,2,MCT,0)="DRUG ID COMPLETED D/T DRUG NAME"
- +7 SET MCT=MCT+1
- +8 DO BLANK
- +9 FOR I=0:0
- SET I=$ORDER(^TMP($JOB,"PSX1",I))
- if 'I
- QUIT
- Begin DoDot:1
- +10 SET ^XMB(3.9,XMZ,2,MCT,0)=^TMP($JOB,"PSX1",I)
- SET MCT=MCT+1
- End DoDot:1
- MSGEND SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_MCT_U_MCT_U_DT
- SET XMDUN="CMOP Manager"
- +1 SET XMDUZ=.5
- SET XMY(DUZ)=""
- +2 DO ENT1^XMD
- EXIT KILL ID,XX,YY,BEG,END,IDDRG,IEN50,CNT,COST,^TMP($JOB),CDT,BB
- +1 KILL XMSER,XQMSG,XMZ,XMSUB
- SET ZTREQ="@"
- +2 QUIT