33 lines
1.2 KiB
Mathematica
33 lines
1.2 KiB
Mathematica
IBDY358 ;ALB/JEH - PRE INSTALL FOR PATCH IBD*3*58 ; 10-AUG-04
|
|
;;3.0;AUTOMATED INFO COLLECTION SYS;**58**;APR 24, 1997
|
|
;
|
|
;This routine will loop through the SELECTION file looking for incorrect Vitamin B12 dosage and correct
|
|
EN N ITEM,CNT,SUBCOL
|
|
S ITEM=0
|
|
S CNT=0
|
|
W !,"STARTING CORRECTION OF Vitamin B12 INJECTION DOSAGE TO 1000mcg"
|
|
F S ITEM=$O(^IBE(357.3,ITEM)) Q:'ITEM D
|
|
. S CNT=CNT+1
|
|
. S SUBCOL=0
|
|
. F S SUBCOL=$O(^IBE(357.3,ITEM,1,SUBCOL)) Q:'SUBCOL D
|
|
. . I $P(^IBE(357.3,ITEM,1,SUBCOL,0),"^",2)["Vitamin B12, per 1000mg" D
|
|
. . . S $P(^IBE(357.3,ITEM,1,SUBCOL,0),"^",2)="Vitamin B12, per 1000mcg"
|
|
. . . W !,"ITEM NUMBER "_ITEM_" IN SELECTION FILE MODIFIED"
|
|
. . Q
|
|
W !,CNT_" SELECTION FILE ENTRIES READ"
|
|
S ITEM=0
|
|
S CNT=0
|
|
F S ITEM=$O(^IBE(357.1,ITEM)) Q:'ITEM D
|
|
. S CNT=CNT+1
|
|
. S SUBCOL=0
|
|
. F S SUBCOL=$O(^IBE(357.1,ITEM,"S",SUBCOL)) Q:'SUBCOL D
|
|
. . ;W !,ITEM_" "_SUBCOL
|
|
. . I $P(^IBE(357.1,ITEM,"S",SUBCOL,0),"^",5)["J3420 Vitamin B12, per 1000mg" D
|
|
. . . S $P(^IBE(357.1,ITEM,"S",SUBCOL,0),"^",5)=" J3420 Vitamin B12,per 1000mcg"
|
|
. . . W !,"ITEM NUMBER "_ITEM_" "_SUBCOL_" ENCOUNTER FORM BLOCK MODIFIED"
|
|
. . Q
|
|
W !,CNT_" ENCOUNTER FORM BLOCK ENTRIES READ"
|
|
W !,"UPDATE OF Vitamin B12 INJECTION DOSAGE COMPLETE"
|
|
Q
|
|
;
|