MCPRE02.m

MCPRE02 ;HISC/DAD-FIX DATA IN PROCEDURE/SUBSPECIALTY FILE ;7/25/96  12:34

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

 ;

 ; Procedure/Subspecialty file (#697.2) Print Name field (#7)

 ; Change 'GI ENDSCOPIC' to 'GI ENDOSCOPIC'

 N DA,DIE,DR,MCD0,TEMP

 S TEMP(1)=""

 S TEMP(2)="Cleaning up data in the Procedure/Subspecialty file (#697.2)."

 D MES^XPDUTL(.TEMP)

 ;

 I $$VFILE^DILFD(697.2) D

 . S MCD0=0

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

 .. S DR="2///@;2.1///@;9///@;10///@"

 .. I $P($G(^MCAR(697.2,MCD0,0)),U,8)="GI ENDSCOPIC" S DR=DR_";7///GI ENDOSCOPIC"

 .. S DIE="^MCAR(697.2,",DA=MCD0

 .. D ^DIE

 .. Q

 . Q

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---MCPRE02   631     printed  Apr 09, 2024@21:17:19                                                                                                                                                                                                      Page 2

MCPRE02   ;HISC/DAD-FIX DATA IN PROCEDURE/SUBSPECIALTY FILE ;7/25/96  12:34

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

 +2       ;

 +3       ; Procedure/Subspecialty file (#697.2) Print Name field (#7)

 +4       ; Change 'GI ENDSCOPIC' to 'GI ENDOSCOPIC'

 +5        NEW DA,DIE,DR,MCD0,TEMP

 +6        SET TEMP(1)=""

 +7        SET TEMP(2)="Cleaning up data in the Procedure/Subspecialty file (#697.2)."

 +8        DO MES^XPDUTL(.TEMP)

 +9       ;

 +10       IF $$VFILE^DILFD(697.2)

               Begin DoDot:1

 +11               SET MCD0=0

 +12               FOR 

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

                       if MCD0'>0

                           QUIT 

                       Begin DoDot:2

 +13                       SET DR="2///@;2.1///@;9///@;10///@"

 +14                       IF $PIECE($GET(^MCAR(697.2,MCD0,0)),U,8)="GI ENDSCOPIC"

                               SET DR=DR_";7///GI ENDOSCOPIC"

 +15                       SET DIE="^MCAR(697.2,"

                           SET DA=MCD0

 +16                       DO ^DIE

 +17                       QUIT 

                       End DoDot:2

 +18               QUIT 

               End DoDot:1

 +19       QUIT