101 lines
6.3 KiB
Mathematica
101 lines
6.3 KiB
Mathematica
PSOMGCM1 ;BHAM ISC/JMB,SAB - management data compile/recompile ;4/15/05 3:10pm
|
|
;;7.0;OUTPATIENT PHARMACY;**20,28,175,185,198**;DEC 1997
|
|
;Ref. to $$RXSUM^FBRXUTL supp. by IA# 4395
|
|
;Ref. to ^PSDRUG(, supp. by IA# 221
|
|
;PSO*198 correct begin date to previous day @ time 999999
|
|
;
|
|
END K ^TMP($J),%DT,AVGCAT,AVGEQFL,AVGFEE,AVGST,CAT,CATA,CATC,CATCOST,COST,DA,DATE,DIC,DINUM,DFN,DIRUT,DIV,DV,EQCOST,EQFL,EQPREQ,DRUG,EDT,FEE,FCOST,INV,MAIL,METH,NEW,METH,METHAD,OTH,PCAT,PHYS,PP,PPCOST,PREQ,PDATE,RECOM
|
|
K QTY30,QTY60,QTY90,QTY90P,QTY120,QTY179,QTY180,REC,R,REF,RX0,RXF,RXPREQ,SDT,ST,STAFF,STCOST,SUB,VAEL,WIND,AVGMETH,COSTPST,METHCOST,PCPP,NODE1,X,Y,ZTDESC,ZTDTH,ZTRTN,ZTSAVE
|
|
K TFIL,TFTY,TFCT,TY,NDT,DAYS,COM,STN S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|
|
PURG ;purge data for a date range
|
|
W !,"Purge Management Statistics",!! S SDT=$O(^PS(59.12,0)) I $D(SDT) S Y=SDT D DD^%DT S %DT("B")=Y
|
|
S %DT(0)=-DT,%DT("A")="Starting date: " S %DT="EPXA" D ^%DT G:"^"[X END G RECOM:'Y S SDT=Y K %DT(0) S Y=SDT D DD^%DT S SY=Y K %DT("B"),Y
|
|
PDT W ! S %DT(0)=SDT,%DT("A")=" Ending date: " D ^%DT G:"^"[X END G:Y<0 PDT S EDT=Y W !
|
|
W !,$C(7),$C(7) S Y=EDT D DD^%DT W !!!,"Purge from "_SY_" to "_Y,!
|
|
S DIR("A")="Are you sure",DIR(0)="Y",DIR("B")="N" D ^DIR K DIR I $G(DIRUT)!('Y) K EDT,SDT,SY,Y W !,$C(7),"No data has been purged." Q
|
|
S ZTDTH="",ZTRTN="P^PSOMGCM1",ZTDESC="Outpatient Pharmacy Management Data Purge",ZTIO="" F G="SDT","EDT" S:$D(@G) ZTSAVE(G)=""
|
|
D ^%ZTLOAD W:$D(ZTSK) !!,"Task Queued !",! K SDT,EDT,G,ZTSK,ZTIO S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|
|
P S DIK="^PS(59.12," F DA=SDT-1:0 S DA=$O(^PS(59.12,DA)) Q:'DA!(DA>EDT) D ^DIK
|
|
K DIK Q
|
|
TSK ;initialize nightly mgmt. compile job
|
|
D SETUP1^PSOAUTOC
|
|
W ! K DIR S DIR("B")="NO",DIR(0)="Y",DIR("A")="Do you want to compile data prior to yesterday" D ^DIR I 'Y!($D(DIRUT)) G EX
|
|
D RECOM
|
|
EX K DIR,X,Y
|
|
Q
|
|
TASK ;compile every night
|
|
S X1=DT,X2=-1 D C^%DTC S (EDT,SDT)=X K X1,X2 D BEG
|
|
Q
|
|
QUE S ZTDTH=$H+1_",3600",ZTIO="",ZTRTN="TASK^PSOMGCM1",ZTDESC="Outpatient Pharmacy Daily Compile of Management Data",ZTIO=""
|
|
D ^%ZTLOAD W:$D(ZTSK)&('$D(ZTQUEUED)) !!,"Task Queued !",! K DAY,SDT,EDT,G,ZTSK,ZTIO S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|
|
DAY ;recompile by day
|
|
W ! S %DT(0)=-DT,%DT("A")="Date: " S %DT="EPXA" D ^%DT G:"^"[X END G DAY:'Y S (SDT,EDT)=Y K %DT(0) S COM=1 W !
|
|
G Q
|
|
RECOM ;recompile data for a date range
|
|
W ! S %DT(0)=-DT,%DT("A")="Starting date: " S %DT="EPXA" D ^%DT G:"^"[X END G RECOM:'Y S SDT=Y K %DT(0)
|
|
REDT W ! S %DT(0)=SDT,%DT("A")=" Ending date: " D ^%DT G:"^"[X END I Y<0!(Y>DT) W " ??" G REDT
|
|
S EDT=Y S COM="R" W !
|
|
Q S ZTDTH="",ZTRTN="BEG^PSOMGCM1",ZTDESC="Outpatient Pharmacy Management Data Recompile "_$S(COM:"One Day",1:"Range of Days"),ZTIO="" F G="SDT","EDT" S:$D(@G) ZTSAVE(G)=""
|
|
D ^%ZTLOAD W:$D(ZTSK) !!,"Task Queued !",! K SDT,EDT,G,ZTSK,ZTIO S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|
|
BEG S DIK="^PS(59.12,",DA=SDT-1 F S DA=$O(^PS(59.12,DA)) Q:'DA!(DA>EDT) D ^DIK
|
|
K DA,DIK F NDT=SDT:1:EDT D BEG1
|
|
D FBA G END
|
|
Q
|
|
;PSO*198 seed loop to previous day @ time 999999
|
|
BEG1 K ^TMP($J) D CLE^PSOMGCOM F TY="AL","AM" S PDATE=NDT-1+.999999 F S PDATE=$O(^PSRX(TY,PDATE)) Q:'PDATE!(PDATE>(NDT_".999999")) D BEG2
|
|
S PDATE=NDT D:TFIL ADD,BUILD^PSOMGCOM
|
|
Q
|
|
BEG2 S REC=0 F S REC=$O(^PSRX(TY,PDATE,REC)) Q:'REC D BEG3
|
|
Q
|
|
BEG3 Q:'$D(^PSRX(REC,0)) S DA="" F S DA=$O(^PSRX(TY,PDATE,REC,DA)) Q:DA="" D
|
|
.S RX0=^PSRX(REC,0),DFN=$P(RX0,"^",2),ST=$P(RX0,"^",3),PHYS=$P(RX0,"^",4),DRUG=$P(RX0,"^",6),DAYS=$P(RX0,"^",8)
|
|
.Q:'DFN!('DRUG) D:TY="AL" COM1^PSOMGCOM D:TY="AM" COM2
|
|
Q
|
|
COM2 Q:'$P($G(^PSRX(REC,"P",DA,0)),"^",19)
|
|
S RXF=^PSRX(REC,"P",DA,0),DV=$S($P(RXF,"^",9):$P(RXF,"^",9),1:$O(^PS(59,0))),REF(DV)=REF(DV)+1 S:$P(RXF,"^",2)="W" WIND(DV)=WIND(DV)+1 S:$P(RXF,"^",2)="M" MAIL(DV)=MAIL(DV)+1 S DATE=$P(^PSRX(REC,"P",0),"^")-.01
|
|
S COST=$P(RXF,"^",4)*$S($P(RXF,"^",11):$P(RXF,"^",11),1:+$P($G(^PSDRUG(+$P(^PSRX(REC,0),"^",6),660)),"^",6))
|
|
D DAYS^PSOMGCOM,STA^PSOMGCOM
|
|
Q
|
|
FBA S (STN,DV)=0 S:'$G(DT) DT=$$DT^XLFDT
|
|
F S DV=$O(^PS(59,DV)) Q:'DV D Q:STN
|
|
.I '$G(^PS(59,DV,"I"))!(DT'>$G(^PS(59,DV,"I"))) S STN=$P(^("INI"),"^"),STN=+$$GET1^DIQ(4,STN,99)
|
|
I 'STN S PP="Invalid Related Institution in File #59" G MAIL
|
|
F PDATE=SDT:1:EDT S PP=$$RXSUM^FBRXUTL(PDATE,STN) Q:+PP<0 D:+PP>0
|
|
.S PPCOST=$P(PP,"^",2),PP=+PP D SET
|
|
I +PP<0 S PP=$P(PP,"^",3) G MAIL
|
|
Q
|
|
MAIL F PSO1=0:0 S PSO1=$O(^XUSEC("PSORPH",PSO1)) Q:'PSO1 S XMY(PSO1)=""
|
|
Q:$O(XMY(""))=""
|
|
S XMDUZ="Outpatient Pharmacy Package"
|
|
S XMSUB="FEE Basis Cost Data - Incomplete Nightly Job"
|
|
S PP=$E(PP_". ",1,42)
|
|
S PSO(1)="**************************************************"
|
|
S PSO(2)="*** FEE Basis Cost data was not collected for ***"
|
|
S PSO(3)="*** the period "_$E(SDT,4,5)_"/"_$E(SDT,6,7)_"/"_$E(SDT,2,3)_" to "_$E(EDT,4,5)_"/"_$E(EDT,6,7)_"/"_$E(EDT,2,3)_". ***"
|
|
S PSO(4)="*** ***"
|
|
S PSO(5)="*** The reason reported was: ***"
|
|
S PSO(6)="*** "_PP_" ***"
|
|
S PSO(7)="*** ***"
|
|
S PSO(8)="*** You may have to manually recompile this ***"
|
|
S PSO(9)="*** data at a later date. ***"
|
|
S PSO(10)="**************************************************"
|
|
S XMTEXT="PSO(" N DIFROM D ^XMD K XMSUB,XMDUZ,XMTEXT,PSO,PSO1
|
|
Q
|
|
SET I '$D(^PS(59.12,PDATE,0)) D ADD S DV=0 F S DV=$O(^PS(59,DV)) Q:'+DV D
|
|
.S ^PS(59.12,PDATE,1,DV,0)=DV_"^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0",^PS(59.12,PDATE,2,DV,0)=DV_"^0^0^0^0^0^0^0^0^0^0^0^0^0.0",^PS(59.12,PDATE,3,DV,0)=DV_"^0.00^0.00^0.00^0.00^0.00^0.00^0.00^0.00^0.00"
|
|
S DV=0,DV=$O(^PS(59,DV)),$P(^PS(59.12,PDATE,2,DV,0),"^",13)=PP,FEE=0
|
|
F DIV=0:0 S DIV=$O(^PS(59.12,PDATE,2,DIV)) Q:'+DIV S FEE=FEE+$P(^PS(59.12,PDATE,2,DIV,0),"^",3)
|
|
S $P(^PS(59.12,PDATE,2,DV,0),"^",14)=$FN($S(FEE=0:100.0,$P(^PS(59.12,PDATE,2,DV,0),"^",13)=0:0,1:(FEE/(FEE+$P(^PS(59.12,$P(PDATE,"."),2,DV,0),"^",13)))*100),"",1)
|
|
S $P(^PS(59.12,PDATE,3,DV,0),"^",9)=$FN(PPCOST,"",2),$P(^PS(59.12,PDATE,3,DV,0),"^",10)=$FN($S(PPCOST=0!(PP=0):0,1:PPCOST/PP),"",2)
|
|
Q
|
|
ADD S (X,DINUM)=PDATE,DIC="^PS(59.12,",DIC(0)="L" K DD,DO D FILE^DICN F DV=0:0 S DV=$O(^PS(59,DV)) Q:'+DV D ADDEM
|
|
Q
|
|
ADDEM S ^PS(59.12,PDATE,1,0)="^59.121A^"_DV_"^"_TFIL,^PS(59.12,PDATE,1,DV,0)=DV,^PS(59.12,PDATE,1,"B",DV,DV)=""
|
|
S ^PS(59.12,PDATE,2,0)="^59.122A^"_DV_"^"_TFTY,^PS(59.12,PDATE,2,DV,0)=DV,^PS(59.12,PDATE,2,"B",DV,DV)=""
|
|
S ^PS(59.12,PDATE,3,0)="^59.123A^"_DV_"^"_TFCT,^PS(59.12,PDATE,3,DV,0)=DV,^PS(59.12,PDATE,3,"B",DV,DV)=""
|
|
Q
|