source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDY358.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 1.2 KB
Line 
1IBDY358 ;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
5EN 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 ;
Note: See TracBrowser for help on using the repository browser.