MCPREDT.m

MCPREDT ;HIRMFO/JCC-ENTER/EDIT PROCEDURE/SUBSPECIALTY ;8/19/96  09:21

 ;;2.3;Medicine;**8**;09/13/1996

EN ;

 S DIC="^MCAR(697.2,",DLAYGO=697.2,DIC(0)="AEQLM",DIC("S")="I $P(^(0),U,4)=""GEN"",$P(^(0),U,19)" D ^DIC G EXIT:Y<0

 S DIE=DIC,DA=+Y S DR="[MCBUILDGENERIC]" K DIC,DLAYGO D ^DIE

 I $$GET1^DIQ(697.2,DA,3,"I")="GEN" S DIE="^MCAR(697.2,",DR="12////MCKEYGEN" D ^DIE  ;MC*2.3*8

 S MCARDA=DA

 S DIC="^MCAR(690.2,",DLAYGO=690.2,DIC(0)="QL",X="Brief Generic" D ^DIC G NEXT:Y<0

 S MCARIEN=+$O(^MCAR(690.2,+Y,3,"B",MCARDA,0)) I MCARIEN G NEXT

 S DIC="^MCAR(690.2,"_+Y_",3,",DIC("P")=$$GET1^DID(690.2,4,"","SPECIFIER"),DIC(0)="L",D0=+Y,DA(1)=+Y,X=MCARDA

 K DD,DO,DINUM D FILE^DICN

NEXT S DIC="^MCAR(690.2,",DLAYGO=690.2,DIC(0)="QL",X="Full Generic" D ^DIC G EXIT:Y<0

 S MCARIEN=+$O(^MCAR(690.2,+Y,3,"B",MCARDA,0)) I MCARIEN G EXIT

 S DIC="^MCAR(690.2,"_+Y_",3,",DIC("P")=$$GET1^DID(690.2,4,"","SPECIFIER"),DIC(0)="L",D0=+Y,DA(1)=+Y,X=MCARDA

 K DD,DO,DINUM D FILE^DICN

EXIT K D0,DIC,DLAYGO,DIE,DA,DR,MCARDA,MCARIEN

 Q

MCPREDT   ;HIRMFO/JCC-ENTER/EDIT PROCEDURE/SUBSPECIALTY ;8/19/96  09:21

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

EN        ;

 +1        SET DIC="^MCAR(697.2,"

           SET DLAYGO=697.2

           SET DIC(0)="AEQLM"

           SET DIC("S")="I $P(^(0),U,4)=""GEN"",$P(^(0),U,19)"

           DO ^DIC

           IF Y<0

               GOTO EXIT

 +2        SET DIE=DIC

           SET DA=+Y

           SET DR="[MCBUILDGENERIC]"

           KILL DIC,DLAYGO

           DO ^DIE

 +3       ;MC*2.3*8

           IF $$GET1^DIQ(697.2,DA,3,"I")="GEN"

               SET DIE="^MCAR(697.2,"

               SET DR="12////MCKEYGEN"

               DO ^DIE

 +4        SET MCARDA=DA

 +5        SET DIC="^MCAR(690.2,"

           SET DLAYGO=690.2

           SET DIC(0)="QL"

           SET X="Brief Generic"

           DO ^DIC

           IF Y<0

               GOTO NEXT

 +6        SET MCARIEN=+$ORDER(^MCAR(690.2,+Y,3,"B",MCARDA,0))

           IF MCARIEN

               GOTO NEXT

 +7        SET DIC="^MCAR(690.2,"_+Y_",3,"

           SET DIC("P")=$$GET1^DID(690.2,4,"","SPECIFIER")

           SET DIC(0)="L"

           SET D0=+Y

           SET DA(1)=+Y

           SET X=MCARDA

 +8        KILL DD,DO,DINUM

           DO FILE^DICN

NEXT       SET DIC="^MCAR(690.2,"

           SET DLAYGO=690.2

           SET DIC(0)="QL"

           SET X="Full Generic"

           DO ^DIC

           IF Y<0

               GOTO EXIT

 +1        SET MCARIEN=+$ORDER(^MCAR(690.2,+Y,3,"B",MCARDA,0))

           IF MCARIEN

               GOTO EXIT

 +2        SET DIC="^MCAR(690.2,"_+Y_",3,"

           SET DIC("P")=$$GET1^DID(690.2,4,"","SPECIFIER")

           SET DIC(0)="L"

           SET D0=+Y

           SET DA(1)=+Y

           SET X=MCARDA

 +3        KILL DD,DO,DINUM

           DO FILE^DICN

EXIT       KILL D0,DIC,DLAYGO,DIE,DA,DR,MCARDA,MCARIEN

 +1        QUIT