source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOMGCM1.m@ 767

Last change on this file since 767 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1PSOMGCM1 ;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 ;
7END 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
11PURG ;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
14PDT 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
20P 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
22TSK ;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
26EX K DIR,X,Y
27 Q
28TASK ;compile every night
29 S X1=DT,X2=-1 D C^%DTC S (EDT,SDT)=X K X1,X2 D BEG
30 Q
31QUE 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
34DAY ;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
37RECOM ;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)
39REDT 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 !
41Q 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
44BEG 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
49BEG1 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
52BEG2 S REC=0 F S REC=$O(^PSRX(TY,PDATE,REC)) Q:'REC D BEG3
53 Q
54BEG3 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
58COM2 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
63FBA 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
71MAIL 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
88SET 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
95ADD 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
97ADDEM 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
Note: See TracBrowser for help on using the repository browser.