| 1 | PSOMGCM1 ;BHAM ISC/JMB,SAB - management data compile/recompile ;4/15/05 3:10pm
|
---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**20,28,175,185,198**;DEC 1997
|
---|
| 3 | ;Ref. to $$RXSUM^FBRXUTL supp. by IA# 4395
|
---|
| 4 | ;Ref. to ^PSDRUG(, supp. by IA# 221
|
---|
| 5 | ;PSO*198 correct begin date to previous day @ time 999999
|
---|
| 6 | ;
|
---|
| 7 | 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
|
---|
| 8 | 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
|
---|
| 9 | K TFIL,TFTY,TFCT,TY,NDT,DAYS,COM,STN S:$D(ZTQUEUED) ZTREQ="@"
|
---|
| 10 | Q
|
---|
| 11 | PURG ;purge data for a date range
|
---|
| 12 | W !,"Purge Management Statistics",!! S SDT=$O(^PS(59.12,0)) I $D(SDT) S Y=SDT D DD^%DT S %DT("B")=Y
|
---|
| 13 | 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
|
---|
| 14 | PDT W ! S %DT(0)=SDT,%DT("A")=" Ending date: " D ^%DT G:"^"[X END G:Y<0 PDT S EDT=Y W !
|
---|
| 15 | W !,$C(7),$C(7) S Y=EDT D DD^%DT W !!!,"Purge from "_SY_" to "_Y,!
|
---|
| 16 | 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
|
---|
| 17 | S ZTDTH="",ZTRTN="P^PSOMGCM1",ZTDESC="Outpatient Pharmacy Management Data Purge",ZTIO="" F G="SDT","EDT" S:$D(@G) ZTSAVE(G)=""
|
---|
| 18 | D ^%ZTLOAD W:$D(ZTSK) !!,"Task Queued !",! K SDT,EDT,G,ZTSK,ZTIO S:$D(ZTQUEUED) ZTREQ="@"
|
---|
| 19 | Q
|
---|
| 20 | P S DIK="^PS(59.12," F DA=SDT-1:0 S DA=$O(^PS(59.12,DA)) Q:'DA!(DA>EDT) D ^DIK
|
---|
| 21 | K DIK Q
|
---|
| 22 | TSK ;initialize nightly mgmt. compile job
|
---|
| 23 | D SETUP1^PSOAUTOC
|
---|
| 24 | 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
|
---|
| 25 | D RECOM
|
---|
| 26 | EX K DIR,X,Y
|
---|
| 27 | Q
|
---|
| 28 | TASK ;compile every night
|
---|
| 29 | S X1=DT,X2=-1 D C^%DTC S (EDT,SDT)=X K X1,X2 D BEG
|
---|
| 30 | Q
|
---|
| 31 | QUE S ZTDTH=$H+1_",3600",ZTIO="",ZTRTN="TASK^PSOMGCM1",ZTDESC="Outpatient Pharmacy Daily Compile of Management Data",ZTIO=""
|
---|
| 32 | D ^%ZTLOAD W:$D(ZTSK)&('$D(ZTQUEUED)) !!,"Task Queued !",! K DAY,SDT,EDT,G,ZTSK,ZTIO S:$D(ZTQUEUED) ZTREQ="@"
|
---|
| 33 | Q
|
---|
| 34 | DAY ;recompile by day
|
---|
| 35 | 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 !
|
---|
| 36 | G Q
|
---|
| 37 | RECOM ;recompile data for a date range
|
---|
| 38 | 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)
|
---|
| 39 | REDT W ! S %DT(0)=SDT,%DT("A")=" Ending date: " D ^%DT G:"^"[X END I Y<0!(Y>DT) W " ??" G REDT
|
---|
| 40 | S EDT=Y S COM="R" W !
|
---|
| 41 | 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)=""
|
---|
| 42 | D ^%ZTLOAD W:$D(ZTSK) !!,"Task Queued !",! K SDT,EDT,G,ZTSK,ZTIO S:$D(ZTQUEUED) ZTREQ="@"
|
---|
| 43 | Q
|
---|
| 44 | BEG S DIK="^PS(59.12,",DA=SDT-1 F S DA=$O(^PS(59.12,DA)) Q:'DA!(DA>EDT) D ^DIK
|
---|
| 45 | K DA,DIK F NDT=SDT:1:EDT D BEG1
|
---|
| 46 | D FBA G END
|
---|
| 47 | Q
|
---|
| 48 | ;PSO*198 seed loop to previous day @ time 999999
|
---|
| 49 | 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
|
---|
| 50 | S PDATE=NDT D:TFIL ADD,BUILD^PSOMGCOM
|
---|
| 51 | Q
|
---|
| 52 | BEG2 S REC=0 F S REC=$O(^PSRX(TY,PDATE,REC)) Q:'REC D BEG3
|
---|
| 53 | Q
|
---|
| 54 | BEG3 Q:'$D(^PSRX(REC,0)) S DA="" F S DA=$O(^PSRX(TY,PDATE,REC,DA)) Q:DA="" D
|
---|
| 55 | .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)
|
---|
| 56 | .Q:'DFN!('DRUG) D:TY="AL" COM1^PSOMGCOM D:TY="AM" COM2
|
---|
| 57 | Q
|
---|
| 58 | COM2 Q:'$P($G(^PSRX(REC,"P",DA,0)),"^",19)
|
---|
| 59 | 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
|
---|
| 60 | S COST=$P(RXF,"^",4)*$S($P(RXF,"^",11):$P(RXF,"^",11),1:+$P($G(^PSDRUG(+$P(^PSRX(REC,0),"^",6),660)),"^",6))
|
---|
| 61 | D DAYS^PSOMGCOM,STA^PSOMGCOM
|
---|
| 62 | Q
|
---|
| 63 | FBA S (STN,DV)=0 S:'$G(DT) DT=$$DT^XLFDT
|
---|
| 64 | F S DV=$O(^PS(59,DV)) Q:'DV D Q:STN
|
---|
| 65 | .I '$G(^PS(59,DV,"I"))!(DT'>$G(^PS(59,DV,"I"))) S STN=$P(^("INI"),"^"),STN=+$$GET1^DIQ(4,STN,99)
|
---|
| 66 | I 'STN S PP="Invalid Related Institution in File #59" G MAIL
|
---|
| 67 | F PDATE=SDT:1:EDT S PP=$$RXSUM^FBRXUTL(PDATE,STN) Q:+PP<0 D:+PP>0
|
---|
| 68 | .S PPCOST=$P(PP,"^",2),PP=+PP D SET
|
---|
| 69 | I +PP<0 S PP=$P(PP,"^",3) G MAIL
|
---|
| 70 | Q
|
---|
| 71 | MAIL F PSO1=0:0 S PSO1=$O(^XUSEC("PSORPH",PSO1)) Q:'PSO1 S XMY(PSO1)=""
|
---|
| 72 | Q:$O(XMY(""))=""
|
---|
| 73 | S XMDUZ="Outpatient Pharmacy Package"
|
---|
| 74 | S XMSUB="FEE Basis Cost Data - Incomplete Nightly Job"
|
---|
| 75 | S PP=$E(PP_". ",1,42)
|
---|
| 76 | S PSO(1)="**************************************************"
|
---|
| 77 | S PSO(2)="*** FEE Basis Cost data was not collected for ***"
|
---|
| 78 | 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)_". ***"
|
---|
| 79 | S PSO(4)="*** ***"
|
---|
| 80 | S PSO(5)="*** The reason reported was: ***"
|
---|
| 81 | S PSO(6)="*** "_PP_" ***"
|
---|
| 82 | S PSO(7)="*** ***"
|
---|
| 83 | S PSO(8)="*** You may have to manually recompile this ***"
|
---|
| 84 | S PSO(9)="*** data at a later date. ***"
|
---|
| 85 | S PSO(10)="**************************************************"
|
---|
| 86 | S XMTEXT="PSO(" N DIFROM D ^XMD K XMSUB,XMDUZ,XMTEXT,PSO,PSO1
|
---|
| 87 | Q
|
---|
| 88 | SET I '$D(^PS(59.12,PDATE,0)) D ADD S DV=0 F S DV=$O(^PS(59,DV)) Q:'+DV D
|
---|
| 89 | .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"
|
---|
| 90 | S DV=0,DV=$O(^PS(59,DV)),$P(^PS(59.12,PDATE,2,DV,0),"^",13)=PP,FEE=0
|
---|
| 91 | 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)
|
---|
| 92 | 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)
|
---|
| 93 | 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)
|
---|
| 94 | Q
|
---|
| 95 | 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
|
---|
| 96 | Q
|
---|
| 97 | 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)=""
|
---|
| 98 | 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)=""
|
---|
| 99 | 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)=""
|
---|
| 100 | Q
|
---|