source: WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAPUR.m@ 724

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1PSAPUR ;BIR/LTL-Nightly Background Job - CONT'D ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
3 ;This routine purges all DA transactions greater than 120 days old. It
4 ;also purges all invoices from the DA ORDERS file if they are over the
5 ;number of days set in 58.8. It is called by PSAPSI5.
6 ;
7 N DIC,DIE,DINUM,D0,D1,DLAYGO,DR,PSAS,PSA,PSALOC,PSAOUT,PSADT,DA,PSADRUG,PSADRUGN,PSAT,PSAR,X,Y
8 S PSALOC=0
9 S X="T-120" D ^%DT S PSADT=Y
10 F S PSALOC=$O(^PSD(58.8,PSALOC)) G:'PSALOC END D:$P($G(^PSD(58.8,+PSALOC,0)),U,2)="P"
11 .S PSADRUG=0
12LUP .F S PSADRUG=$O(^PSD(58.8,+PSALOC,1,PSADRUG)) Q:'PSADRUG D:$O(^PSD(58.8,+PSALOC,1,+PSADRUG,4,0))
13 ..S PSAT=0
14 ..F S PSAT=$O(^PSD(58.8,+PSALOC,1,+PSADRUG,4,PSAT)) Q:'PSAT D:$P($G(^PSD(58.81,+PSAT,0)),U,4)<PSADT&('$P($G(^PSD(58.81,+PSAT,"CS")),U))
15 ...S DIE="^PSD(58.8,+PSALOC,1,+PSADRUG,4,",DA(2)=PSALOC,DA(1)=PSADRUG,DA=PSAT,DR=".01////@" D ^DIE
16 ...S DIE="^PSD(58.81,",DA=PSAT,DR=".01////@" D ^DIE
17 ;
18ORDERS ;Deletes invoices from the DA ORDERS file if they are over the number
19 ;of days set in 58.8.
20 S PSALOC=0 F S PSALOC=$O(^PSD(58.811,"ALOC",PSALOC)) Q:'PSALOC D
21 .S PSALOCDT=$S(+$P($G(^PSD(58.8,PSALOC,0)),"^",15):+$P($G(^PSD(58.8,PSALOC,0)),"^",15),1:120) S X1=DT,X2=-PSALOCDT D C^%DTC S PSALOCDT=X
22 .S PSADT=0 F S PSADT=$O(^PSD(58.811,"ALOC",PSALOC,PSADT)) Q:'PSADT!(PSADT>PSALOCDT) D
23 ..S PSAIEN=0 F S PSAIEN=$O(^PSD(58.811,"ALOC",PSALOC,PSADT,PSAIEN)) Q:'PSAIEN D
24 ...S PSAIEN1=0 F S PSAIEN1=$O(^PSD(58.811,"ALOC",PSALOC,PSADT,PSAIEN,PSAIEN1)) Q:'PSAIEN1 D
25 ....Q:$P($G(^PSD(58.811,PSAIEN,1,PSAIEN1,0)),"^",3)'="C"!('$D(^PSD(58.811,PSAIEN,1,PSAIEN1,0)))
26 ....S DA(1)=PSAIEN,DA=PSAIEN1,DIK="^PSD(58.811,"_DA(1)_",1," D ^DIK K DA,DIK
27 ...I '$O(^PSD(58.811,PSAIEN,1,0)) S DA=PSAIEN,DIK="^PSD(58.811," D ^DIK K DA,DIK
28 K PSADT,PSAIEN,PSAIEN1,PSALOC,PSALOCDT,X,X1,X2
29END Q
Note: See TracBrowser for help on using the repository browser.