| 1 | PSAV3P53 ;VMP/PDW-POST INIT *53 FIND BAD 'C' INDEX, KILL OLD, SET PROPER 'C' & 'B' INDEXES; 8/20/05
|
|---|
| 2 | ;;3.0;DRUG ACCOUNTABILITY;**53**; 4/30/97
|
|---|
| 3 | ST ;walk 'C' entries finding bad entries , pull values, kill old, set new indexes
|
|---|
| 4 | S PSASUB=3000101 ;1JAN2000
|
|---|
| 5 | ;
|
|---|
| 6 | W:$G(PSASHOW) !,"by DATES"
|
|---|
| 7 | F S PSASUB=$O(^PSD(58.8,"C",PSASUB)) Q:PSASUB'>0 D
|
|---|
| 8 | . S PSALOC=$O(^PSD(58.8,"C",PSASUB,0))
|
|---|
| 9 | . S PSADRG=0 F S PSADRG=$O(^PSD(58.8,"C",PSASUB,PSALOC,0)) Q:PSADRG'>0 D
|
|---|
| 10 | .. K ^PSD(58.8,"C",PSASUB,PSALOC,PSADRG) X "S X=$ZR" W:$G(PSASHOW) !,"K ",X
|
|---|
| 11 | .. K ^PSD(58.8,PSALOC,1,"B",PSASUB,PSADRG) X "S X=$ZR" W:$G(PSASHOW) !,"K ",X
|
|---|
| 12 | .. S ^PSD(58.8,"C",PSADRG,PSALOC,PSADRG)="" X "S X=$ZR" W:$G(PSASHOW) !,"S ",X
|
|---|
| 13 | .. S ^PSD(58.8,PSALOC,1,"B",PSADRG,PSADRG)="" X "S X=$ZR" W:$G(PSASHOW) !,"S ",X
|
|---|
| 14 | W:$G(PSASHOW) !,"by LOCATION"
|
|---|
| 15 | S PSALOC=0
|
|---|
| 16 | F S PSALOC=$O(^PSD(58.8,PSALOC)) Q:PSALOC'>0 D
|
|---|
| 17 | . S PSADRG=0
|
|---|
| 18 | . F S PSADRG=$O(^PSD(58.8,PSALOC,1,PSADRG)) Q:PSADRG'>0 D
|
|---|
| 19 | .. ;scrub B index
|
|---|
| 20 | .. S PSADRG2=0
|
|---|
| 21 | .. F S PSADRG2=$O(^PSD(58.8,PSALOC,1,"B",PSADRG,PSADRG2)) Q:PSADRG2'>0 D
|
|---|
| 22 | ...I PSADRG2'=PSADRG K ^PSD(58.8,PSALOC,1,"B",PSADRG,PSADRG2) X "S X=$ZR" W:$G(PSASHOW) !,"K ",X
|
|---|
| 23 | .. ;check valid B index
|
|---|
| 24 | .. I '$D(^PSD(58.8,PSALOC,1,"B",PSADRG,PSADRG)) S ^PSD(58.8,PSALOC,1,"B",PSADRG,PSADRG)="" X "S X=$ZR" W:$G(PSASHOW) !,"S ",X
|
|---|
| 25 | .. ;check valid C index
|
|---|
| 26 | .. I '$D(^PSD(58.8,"C",PSADRG,PSALOC,PSADRG)) S ^PSD(58.8,"C",PSADRG,PSALOC,PSADRG)="" X "S X=$ZR" W:$G(PSASHOW) !,"S ",X
|
|---|
| 27 | W:$G(PSASHOW) !,"by C INDEX"
|
|---|
| 28 | S PSADRG=0 F S PSADRG=$O(^PSD(58.8,"C",PSADRG)) Q:PSADRG'>0 D
|
|---|
| 29 | . S PSALOC=0 F S PSALOC=$O(^PSD(58.8,"C",PSADRG,PSALOC)) Q:PSALOC'>0 D
|
|---|
| 30 | .. S PSADRG2=0 F S PSADRG2=$O(^PSD(58.8,"C",PSADRG,PSALOC,PSADRG2)) Q:PSADRG2'>0 D
|
|---|
| 31 | ... I PSADRG2'=PSADRG K ^PSD(58.8,"C",PSADRG,PSALOC,PSADRG2) X "S X=$ZR" W:$G(PSASHOW) !,"K ",X
|
|---|
| 32 | K PSALOC,PSADRG,PSADRG2
|
|---|
| 33 | Q
|
|---|
