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 ---[H[J[2J[HMCPRE02 631 printed Dec 13, 2024@02:16:38 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
