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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDY358 1293 printed Apr 09, 2024@21:59:51 Page 2
IBDY358 ;ALB/JEH - PRE INSTALL FOR PATCH IBD*3*58 ; 10-AUG-04
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**58**;APR 24, 1997
+2 ;
+3 ;This routine will loop through the SELECTION file looking for incorrect Vitamin B12 dosage and correct
EN NEW ITEM,CNT,SUBCOL
+1 SET ITEM=0
+2 SET CNT=0
+3 WRITE !,"STARTING CORRECTION OF Vitamin B12 INJECTION DOSAGE TO 1000mcg"
+4 FOR
SET ITEM=$ORDER(^IBE(357.3,ITEM))
if 'ITEM
QUIT
Begin DoDot:1
+5 SET CNT=CNT+1
+6 SET SUBCOL=0
+7 FOR
SET SUBCOL=$ORDER(^IBE(357.3,ITEM,1,SUBCOL))
if 'SUBCOL
QUIT
Begin DoDot:2
+8 IF $PIECE(^IBE(357.3,ITEM,1,SUBCOL,0),"^",2)["Vitamin B12, per 1000mg"
Begin DoDot:3
+9 SET $PIECE(^IBE(357.3,ITEM,1,SUBCOL,0),"^",2)="Vitamin B12, per 1000mcg"
+10 WRITE !,"ITEM NUMBER "_ITEM_" IN SELECTION FILE MODIFIED"
End DoDot:3
+11 QUIT
End DoDot:2
End DoDot:1
+12 WRITE !,CNT_" SELECTION FILE ENTRIES READ"
+13 SET ITEM=0
+14 SET CNT=0
+15 FOR
SET ITEM=$ORDER(^IBE(357.1,ITEM))
if 'ITEM
QUIT
Begin DoDot:1
+16 SET CNT=CNT+1
+17 SET SUBCOL=0
+18 FOR
SET SUBCOL=$ORDER(^IBE(357.1,ITEM,"S",SUBCOL))
if 'SUBCOL
QUIT
Begin DoDot:2
+19 ;W !,ITEM_" "_SUBCOL
+20 IF $PIECE(^IBE(357.1,ITEM,"S",SUBCOL,0),"^",5)["J3420 Vitamin B12, per 1000mg"
Begin DoDot:3
+21 SET $PIECE(^IBE(357.1,ITEM,"S",SUBCOL,0),"^",5)=" J3420 Vitamin B12,per 1000mcg"
+22 WRITE !,"ITEM NUMBER "_ITEM_" "_SUBCOL_" ENCOUNTER FORM BLOCK MODIFIED"
End DoDot:3
+23 QUIT
End DoDot:2
End DoDot:1
+24 WRITE !,CNT_" ENCOUNTER FORM BLOCK ENTRIES READ"
+25 WRITE !,"UPDATE OF Vitamin B12 INJECTION DOSAGE COMPLETE"
+26 QUIT
+27 ;
