| 1 | IBDY358 ;ALB/JEH - PRE INSTALL FOR PATCH IBD*3*58 ; 10-AUG-04
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;**58**;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | ;This routine will loop through the SELECTION file looking for incorrect Vitamin B12 dosage and correct
|
|---|
| 5 | EN N ITEM,CNT,SUBCOL
|
|---|
| 6 | S ITEM=0
|
|---|
| 7 | S CNT=0
|
|---|
| 8 | W !,"STARTING CORRECTION OF Vitamin B12 INJECTION DOSAGE TO 1000mcg"
|
|---|
| 9 | F S ITEM=$O(^IBE(357.3,ITEM)) Q:'ITEM D
|
|---|
| 10 | . S CNT=CNT+1
|
|---|
| 11 | . S SUBCOL=0
|
|---|
| 12 | . F S SUBCOL=$O(^IBE(357.3,ITEM,1,SUBCOL)) Q:'SUBCOL D
|
|---|
| 13 | . . I $P(^IBE(357.3,ITEM,1,SUBCOL,0),"^",2)["Vitamin B12, per 1000mg" D
|
|---|
| 14 | . . . S $P(^IBE(357.3,ITEM,1,SUBCOL,0),"^",2)="Vitamin B12, per 1000mcg"
|
|---|
| 15 | . . . W !,"ITEM NUMBER "_ITEM_" IN SELECTION FILE MODIFIED"
|
|---|
| 16 | . . Q
|
|---|
| 17 | W !,CNT_" SELECTION FILE ENTRIES READ"
|
|---|
| 18 | S ITEM=0
|
|---|
| 19 | S CNT=0
|
|---|
| 20 | F S ITEM=$O(^IBE(357.1,ITEM)) Q:'ITEM D
|
|---|
| 21 | . S CNT=CNT+1
|
|---|
| 22 | . S SUBCOL=0
|
|---|
| 23 | . F S SUBCOL=$O(^IBE(357.1,ITEM,"S",SUBCOL)) Q:'SUBCOL D
|
|---|
| 24 | . . ;W !,ITEM_" "_SUBCOL
|
|---|
| 25 | . . I $P(^IBE(357.1,ITEM,"S",SUBCOL,0),"^",5)["J3420 Vitamin B12, per 1000mg" D
|
|---|
| 26 | . . . S $P(^IBE(357.1,ITEM,"S",SUBCOL,0),"^",5)=" J3420 Vitamin B12,per 1000mcg"
|
|---|
| 27 | . . . W !,"ITEM NUMBER "_ITEM_" "_SUBCOL_" ENCOUNTER FORM BLOCK MODIFIED"
|
|---|
| 28 | . . Q
|
|---|
| 29 | W !,CNT_" ENCOUNTER FORM BLOCK ENTRIES READ"
|
|---|
| 30 | W !,"UPDATE OF Vitamin B12 INJECTION DOSAGE COMPLETE"
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
