BMCDXLK.m

BMCDXLK ; IHS/PHXAO/TMJ - LOOKUP ICD9 ENTRY ;

 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 ;

 ; This routine looks up an entry in the ICD DIAGNOSIS file (80).

 ;

START ;

 D EN^XBNEW("EN^BMCICDLK","BMC*") ;  new everthing except BMC*

 Q

 ;

EN ; ENTRY POINT FOR ^XBNEW

 NEW BMCQ

 F  D LOOP Q:BMCQ

 Q

 ;

LOOP ;

 S BMCQ=1

 W:$G(IOF)'="" @IOF

 S DIC=80,DIC(0)="AEMQ" D DIC^BMCFMC

 Q:Y<0

 ; add new rcis diagnosis for dx just looked up

 S BMCLOOK=1

 S DIC="^BMCDX(",DIC(0)="L",DLAYGO=90001.01,DIC("DR")=".02////"_BMCDFN_";.03////"_BMCRIEN,X=+Y

 D FILE^BMCFMC

 K BMCLOOK

 Q:Y<0

 ; add other fields to dx just created

 S DDSFILE=90001.01,DA=+Y,DR="[BMC DIAGNOSIS ADD]",DDSPARM="TW"

 D DDS^BMCFMC

 Q

BMCDXLK   ; IHS/PHXAO/TMJ - LOOKUP ICD9 ENTRY ;

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 +2       ;

 +3       ; This routine looks up an entry in the ICD DIAGNOSIS file (80).

 +4       ;

START     ;

 +1       ;  new everthing except BMC*

           DO EN^XBNEW("EN^BMCICDLK","BMC*")

 +2        QUIT 

 +3       ;

EN        ; ENTRY POINT FOR ^XBNEW

 +1        NEW BMCQ

 +2        FOR 

               DO LOOP

               IF BMCQ

                   QUIT 

 +3        QUIT 

 +4       ;

LOOP      ;

 +1        SET BMCQ=1

 +2        IF $GET(IOF)'=""

               WRITE @IOF

 +3        SET DIC=80

           SET DIC(0)="AEMQ"

           DO DIC^BMCFMC

 +4        IF Y<0

               QUIT 

 +5       ; add new rcis diagnosis for dx just looked up

 +6        SET BMCLOOK=1

 +7        SET DIC="^BMCDX("

           SET DIC(0)="L"

           SET DLAYGO=90001.01

           SET DIC("DR")=".02////"_BMCDFN_";.03////"_BMCRIEN

           SET X=+Y

 +8        DO FILE^BMCFMC

 +9        KILL BMCLOOK

 +10       IF Y<0

               QUIT 

 +11      ; add other fields to dx just created

 +12       SET DDSFILE=90001.01

           SET DA=+Y

           SET DR="[BMC DIAGNOSIS ADD]"

           SET DDSPARM="TW"

 +13       DO DDS^BMCFMC

 +14       QUIT