49 lines
3.6 KiB
Mathematica
49 lines
3.6 KiB
Mathematica
PSOHELP3 ;BHAM ISC/SAB - outpatient utility routine #4 ;2/17/93 18:00:36
|
|
;;7.0;OUTPATIENT PHARMACY;**20**;DEC 1997
|
|
XREF ;code to create 'APD' xref on Drug Interaction file (#56)
|
|
;I '$D(ZTSK),'$D(PSMSG) D WAIT^DICD W "Building 'APD' X-Ref."
|
|
;The following code accessing files 56 and 50.416 is no longer executed
|
|
S ID1=$P(^PS(56,DA,0),"^",2),ID2=$P(^(0),"^",3),TOT=0
|
|
F I1=0:0 S I1=$O(^PS(50.416,ID1,1,I1)) Q:'I1 S R2=$P(^(I1,0),"^") F I2=0:0 S I2=$O(^PS(50.416,ID2,1,I2)) Q:'I2 S D2=$P(^(I2,0),"^") W:+$G(PSMSG) "." D SEC
|
|
F I1=0:0 S I1=$O(^PS(50.416,"APS",ID1,I1)) Q:'I1 F I3=0:0 S I3=$O(^PS(50.416,I1,1,I3)) Q:'I3 S R2=$P(^(I3,0),"^") F I5=0:0 S I5=$O(^PS(50.416,"APS",ID2,I5)) Q:'I5 F I6=0:0 S I6=$O(^PS(50.416,I5,1,I6)) Q:'I6 S D2=$P(^(I6,0),"^") D SEC
|
|
F I1=0:0 S I1=$O(^PS(50.416,ID1,1,I1)) Q:'I1 S R2=$P(^(I1,0),"^") F I5=0:0 S I5=$O(^PS(50.416,"APS",ID2,I5)) Q:'I5 F I6=0:0 S I6=$O(^PS(50.416,I5,1,I6)) Q:'I6 S D2=$P(^(I6,0),"^") D SEC
|
|
F I2=0:0 S I2=$O(^PS(50.416,ID2,1,I2)) Q:'I2 S D2=$P(^(I2,0),"^") F I1=0:0 S I1=$O(^PS(50.416,"APS",ID1,I1)) Q:'I1 F I3=0:0 S I3=$O(^PS(50.416,I1,1,I3)) Q:'I3 S R2=$P(^(I3,0),"^") D SEC
|
|
S $P(^PS(56,DA,0),"^",6)=TOT
|
|
EX K TOT,I5,I6,D2,I4,I3,PRI,I1,I2,R2,PS1,PS2,ID2,ID1
|
|
Q
|
|
SEC I +$G(DEL) K ^PS(56,"APD",R2,D2,DA),^PS(56,"APD",D2,R2,DA) Q
|
|
S ^PS(56,"APD",R2,D2,DA)="",^PS(56,"APD",D2,R2,DA)="",TOT=TOT+2
|
|
Q
|
|
DRUG ;selects drug and updates Rx file with cost (pso*7*20)
|
|
K X,Y,DA,DIC S DIC(0)="AQEM",DIC=50 D ^DIC I $G(DUOUT) K DIC,Y,X,DA Q
|
|
I Y<0 G OUT
|
|
S (DRG,DA)=+Y K DIC,DR,DIQ S DIC=50,DR=16,DIQ="PSODRG",DIQ(0)="I"
|
|
D EN^DIQ1 S COST=PSODRG(50,DA,16,"I") K PSODRG,DIC,DA,DR,DIQ,DIR
|
|
W ! S DIR("A")="Do you want to update cost on Refills and Partials too",DIR(0)="Y",DIR("B")="No" D ^DIR K DIR I $G(DIRUT) K COST,X,DRG,Y Q
|
|
S REF=$S(Y:Y,1:0),X1=DT,X2=-485 D C^%DTC S (DEF,Y)=X X ^DD("DD")
|
|
W !!,"You can only go back One Year plus 120 days."
|
|
S %DT(0)=DEF,%DT="AQEX",%DT("A")="How far BACK do you want to go: ",%DT("B")=Y D ^%DT K %DT("B"),DEF I Y<0!($D(DTOUT)) K REF,COST,DRG,X,Y Q
|
|
S (FBCK,%DT(0))=Y,%DT("A")="How far AHEAD do you want to go: " D ^%DT
|
|
K %DT I Y<0!($D(DTOUT)) K FBCK,REF,COST,DRG,X,Y Q
|
|
S FAHD=Y K DIR,X,Y S DIR(0)="Y",DIR("A")="Do you want to Queue to run at a specific Time",DIR("B")="Yes" D ^DIR K DIR I $D(DIRUT) G OUT
|
|
I Y S PSOQ=1 K ZTDTH D G OUT
|
|
.S ZTRTN="EN^PSOHELP3",ZTIO="",ZTDESC="Outpatient Pharmacy Rx Cost Update"
|
|
.F G="REF","COST","DRG","FBCK","FAHD","PSOQ" S:$D(@G) ZTSAVE(G)=""
|
|
.D ^%ZTLOAD I $D(ZTSK) W !,"Rxs Cost Update Queued" K ZTSK
|
|
EN W:'$G(PSOQ) ! S FDT=FBCK-1 F S FDT=$O(^PSRX("ADL",FDT)) Q:'FDT!(FDT>FAHD) F RXN=0:0 S RXN=$O(^PSRX("ADL",FDT,DRG,RXN)) Q:'RXN D W:'$G(PSOQ) "."
|
|
.I $P($G(^PSRX(RXN,0)),"^",6)=DRG,$P($G(^(2)),"^",2)=FDT S $P(^PSRX(RXN,0),"^",17)=COST
|
|
.Q:'REF
|
|
.F I=0:0 S I=$O(^PSRX(RXN,1,I)) Q:'I S $P(^PSRX(RXN,1,I,0),"^",11)=COST
|
|
.F I=0:0 S I=$O(^PSRX(RXN,"P",I)) Q:'I S $P(^PSRX(RXN,"P",I,0),"^",11)=COST
|
|
OUT K G,COST,I,X,Y,REF,RXN,FDT,FAHD,FBCK,DRG,PSOQ,DIRUT I $D(ZTQUEUED) S ZTREQ="@"
|
|
Q
|
|
POST ;post install entry point. builds new "ADL" xref for file 52 pso*7*20
|
|
S ZTRTN="EN1^PSOHELP3",ZTIO="",ZTDESC="Outpatient Pharmacy Rx XREF Update"
|
|
S ZTDTH=$H D ^%ZTLOAD I $D(ZTSK) D BMES^XPDUTL(" Post Install Background Job Queued.") K ZTSK
|
|
Q
|
|
EN1 K ^PSRX("ADL") S X1=DT,X2=-485 D C^%DTC S DEF=X-1 W !,"DEF: "_DEF
|
|
F S DEF=$O(^PSRX("AD",DEF)) Q:'DEF F IFN=0:0 S IFN=$O(^PSRX("AD",DEF,IFN)) Q:'IFN S FTY="" F S FTY=$O(^PSRX("AD",DEF,IFN,FTY)) Q:FTY="" I FTY=0 D
|
|
.I $P($G(^PSRX(IFN,2)),"^",2),$P($G(^(0)),"^",6) S ^PSRX("ADL",$P($G(^PSRX(IFN,2)),"^",2),$P($G(^(0)),"^",6),IFN)=""
|
|
K X,Y,DEF,FTY,IFN S ZTREQ="@"
|
|
Q
|