MCPRE06.m

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

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