BWRAD.m

BWRAD ;IHS/ANMC/MWR - UTIL: MOSTLY PATIENT DATA;15-Feb-2003 22:09;PLS

 ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996

 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 ;;  EDIT BW MAMMOGRAM DIAG CODE TRANSLATIONS FILE.

 ;;  PRINT BW MAMMOGRAM DIAG CODE TRANSLATIONS FILE.

 ;

 ;

EDIT ;---> MATCH BW RESULTS/DIAGNOSES WITH RADIOLOGY DIAGNOSTIC CODES.

 ;---> CALLED BY OPTION "BW EDIT DIAG TRANSLATION".

 D SETVARS^BWUTL5

 F  D  Q:$G(Y)<0

 .D TITLE^BWUTL5("EDIT BW DIAGNOSTIC CODE TRANSLATION FILE")

 .D DIC^BWFMAN(9002086.32,"QEMAL",.Y,"   Select RESULT/DIAGNOSIS: ")

 .Q:Y<0

 .D DIE^BWFMAN(9002086.32,".01;.02",+Y,.BWPOP)

 D EXIT

 Q

 ;

SCREEN ;

 ;---> SCREEN CALLED BY FILEMAN ^DD.

 ;---> SCREEN ONLY FOR RESULTS/DIAGNOSES THAT APPLY TO MAMMOGRAMS.

 ;---> HARDCODED FOR MAM IENS=25, 26 OR 28.  CALLED BY ^DIC.

 N I

 F I=3:1:19 I $P(^(0),U,I)=25!($P(^(0),U,I)=26)!($P(^(0),U,I)=28) Q

 Q

 ;

 ;

PRINT ;EP

 ;---> CALLED BY OPTION "BW PRINT DIAG TRANSLATION".

 S DIC="^BWRADX("

 S FLDS="[BW PRINT DIAG CODE TRANSLATION]"

 S BY=.01,FR="AAAA",TO="ZZZZ"

 D EN1^DIP

 D EXIT

 Q

 ;

EXIT ;EP

 D KILLALL^BWUTL8

 Q

BWRAD     ;IHS/ANMC/MWR - UTIL: MOSTLY PATIENT DATA;15-Feb-2003 22:09;PLS

 +1       ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996

 +2       ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 +3       ;;  EDIT BW MAMMOGRAM DIAG CODE TRANSLATIONS FILE.

 +4       ;;  PRINT BW MAMMOGRAM DIAG CODE TRANSLATIONS FILE.

 +5       ;

 +6       ;

EDIT      ;---> MATCH BW RESULTS/DIAGNOSES WITH RADIOLOGY DIAGNOSTIC CODES.

 +1       ;---> CALLED BY OPTION "BW EDIT DIAG TRANSLATION".

 +2        DO SETVARS^BWUTL5

 +3        FOR 

               Begin DoDot:1

 +4                DO TITLE^BWUTL5("EDIT BW DIAGNOSTIC CODE TRANSLATION FILE")

 +5                DO DIC^BWFMAN(9002086.32,"QEMAL",.Y,"   Select RESULT/DIAGNOSIS: ")

 +6                IF Y<0

                       QUIT 

 +7                DO DIE^BWFMAN(9002086.32,".01;.02",+Y,.BWPOP)

               End DoDot:1

               IF $GET(Y)<0

                   QUIT 

 +8        DO EXIT

 +9        QUIT 

 +10      ;

SCREEN    ;

 +1       ;---> SCREEN CALLED BY FILEMAN ^DD.

 +2       ;---> SCREEN ONLY FOR RESULTS/DIAGNOSES THAT APPLY TO MAMMOGRAMS.

 +3       ;---> HARDCODED FOR MAM IENS=25, 26 OR 28.  CALLED BY ^DIC.

 +4        NEW I

 +5        FOR I=3:1:19

               IF $PIECE(^(0),U,I)=25!($PIECE(^(0),U,I)=26)!($PIECE(^(0),U,I)=28)

                   QUIT 

 +6        QUIT 

 +7       ;

 +8       ;

PRINT     ;EP

 +1       ;---> CALLED BY OPTION "BW PRINT DIAG TRANSLATION".

 +2        SET DIC="^BWRADX("

 +3        SET FLDS="[BW PRINT DIAG CODE TRANSLATION]"

 +4        SET BY=.01

           SET FR="AAAA"

           SET TO="ZZZZ"

 +5        DO EN1^DIP

 +6        DO EXIT

 +7        QUIT 

 +8       ;

EXIT      ;EP

 +1        DO KILLALL^BWUTL8

 +2        QUIT