MCPRE06 ;HIRMFO/DAD-ICD CODE MULT CLEANUP IN MEDICAL DIAGNOSIS/ICD CODES FILE (#697.5 ;8/2/96 10:29
;;2.3;Medicine;;09/13/1996
;
N D0,D1,DIK,MCD0,MCD1,MCDATA
S MCDATA(1)=""
S MCDATA(2)="Cleaning up the data in the ICD Code multiple in"
S MCDATA(3)="the Medical Diagnosis/ICD Codes file (#697.5)."
D MES^XPDUTL(.MCDATA)
;
S MCD0=0
F S MCD0=$O(^MCAR(697.5,MCD0)) Q:MCD0'>0 D
. S MCD1=0
. F S MCD1=$O(^MCAR(697.5,MCD0,2,MCD1)) Q:MCD1'>0 D
.. S MCDATA=$P($G(^MCAR(697.5,MCD0,2,MCD1,0)),U)
.. I $S(MCDATA="":1,'$D(^ICD9(MCDATA,0)):1,1:0) D
... S DIK="^MCAR(697.5,"_MCD0_",2,",(D0,DA(1))=MCD0,(D1,DA)=MCD1
... D ^DIK
... Q
.. Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPRE06 674 printed Nov 22, 2024@17:26:43 Page 2
MCPRE06 ;HIRMFO/DAD-ICD CODE MULT CLEANUP IN MEDICAL DIAGNOSIS/ICD CODES FILE (#697.5 ;8/2/96 10:29
+1 ;;2.3;Medicine;;09/13/1996
+2 ;
+3 NEW D0,D1,DIK,MCD0,MCD1,MCDATA
+4 SET MCDATA(1)=""
+5 SET MCDATA(2)="Cleaning up the data in the ICD Code multiple in"
+6 SET MCDATA(3)="the Medical Diagnosis/ICD Codes file (#697.5)."
+7 DO MES^XPDUTL(.MCDATA)
+8 ;
+9 SET MCD0=0
+10 FOR
SET MCD0=$ORDER(^MCAR(697.5,MCD0))
if MCD0'>0
QUIT
Begin DoDot:1
+11 SET MCD1=0
+12 FOR
SET MCD1=$ORDER(^MCAR(697.5,MCD0,2,MCD1))
if MCD1'>0
QUIT
Begin DoDot:2
+13 SET MCDATA=$PIECE($GET(^MCAR(697.5,MCD0,2,MCD1,0)),U)
+14 IF $SELECT(MCDATA="":1,'$DATA(^ICD9(MCDATA,0)):1,1:0)
Begin DoDot:3
+15 SET DIK="^MCAR(697.5,"_MCD0_",2,"
SET (D0,DA(1))=MCD0
SET (D1,DA)=MCD1
+16 DO ^DIK
+17 QUIT
End DoDot:3
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 QUIT
