MCPOS06.m

MCPOS06 ;HIRMFO/DAD-FIX SUBDD NUMBER IN DATA NODES ;4/25/96  10:55

 ;;2.3;Medicine;;09/13/1996

 ;

 ; Change subDD number to 699.501

 N MCD0,MCDATA,MCSUBDD

 S MCDATA(1)=""

 S MCDATA(2)="Checking the sub-DD numbers in the Generalized"

 S MCDATA(3)="Procedure/Consult file (#699.5)."

 D MES^XPDUTL(.MCDATA)

 ;

 S MCD0=0

 F  S MCD0=$O(^MCAR(699.5,MCD0)) Q:MCD0'>0  D

 . S MCDATA=$G(^MCAR(699.5,MCD0,2,0))

 . I MCDATA="",$O(^MCAR(699.5,MCD0,2,0))'>0 Q

 . S MCSUBDD=$P(MCDATA,U,2)

 . I +MCSUBDD'=699.501 D

 .. S $P(MCDATA,U,2)="699.501"_$TR(MCSUBDD,"1234567890.")

 .. S ^MCAR(699.5,MCD0,2,0)=MCDATA

 .. Q

 . Q

 Q

MCPOS06   ;HIRMFO/DAD-FIX SUBDD NUMBER IN DATA NODES ;4/25/96  10:55

 +1       ;;2.3;Medicine;;09/13/1996

 +2       ;

 +3       ; Change subDD number to 699.501

 +4        NEW MCD0,MCDATA,MCSUBDD

 +5        SET MCDATA(1)=""

 +6        SET MCDATA(2)="Checking the sub-DD numbers in the Generalized"

 +7        SET MCDATA(3)="Procedure/Consult file (#699.5)."

 +8        DO MES^XPDUTL(.MCDATA)

 +9       ;

 +10       SET MCD0=0

 +11       FOR 

               SET MCD0=$ORDER(^MCAR(699.5,MCD0))

               IF MCD0'>0

                   QUIT 

               Begin DoDot:1

 +12               SET MCDATA=$GET(^MCAR(699.5,MCD0,2,0))

 +13               IF MCDATA=""

                       IF $ORDER(^MCAR(699.5,MCD0,2,0))'>0

                           QUIT 

 +14               SET MCSUBDD=$PIECE(MCDATA,U,2)

 +15               IF +MCSUBDD'=699.501

                       Begin DoDot:2

 +16                       SET $PIECE(MCDATA,U,2)="699.501"_$TRANSLATE(MCSUBDD,"1234567890.")

 +17                       SET ^MCAR(699.5,MCD0,2,0)=MCDATA

 +18                       QUIT 

                       End DoDot:2

 +19               QUIT 

               End DoDot:1

 +20       QUIT