BWDIAGS.m

BWDIAGS ;IHS/ANMC/MWR - RES/DIAG SYNONYM ADD/EDIT/PRINT;15-Feb-2003 21:50;PLS

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

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

 ;;  ADD/EDIT/PRINT/PURGE SYNONYMS FOR BW RESULTS/DIAGNOSIS FILE.

 ;;

 ;

EDITSYN ;EP

 ;---> EDIT SYNONYMS FOR RESULTS/DIAGNOSIS.

 ;---> CALLED BY OPTION "BW EDIT RES/DIAG SYNONYMS".

 D SETVARS^BWUTL5

 F  D  Q:$G(Y)<0

 .D TITLE^BWUTL5("EDIT SYNONYMS FOR RESULTS/DIAGNOSIS FILE")

 .D TEXT1

 .D DIC^BWFMAN(9002086.31,"QEMA",.Y,"   Select RESULT/DIAGNOSIS: ")

 .Q:Y<0

 .D DIE^BWFMAN(9002086.31,".3;.31",+Y,1,.BWPOP)

 .S:BWPOP Y=-1

 W @IOF

 D KILLALL^BWUTL8

 Q

 ;

PRINTSYN ;EP

 ;---> CALLED BY OPTION "BW PRINT RES/DIAG SYNONYMS".

 D SETVARS^BWUTL5

 S DIC="^BWDIAG("

 S FLDS="[BW PRINT RES/DIAG SYNONYMS]"

 S BY=.01,(FR,TO)=""

 D EN1^DIP

 D KILLALL^BWUTL8

 Q

 ;

 ;

TEXT1 ;EP

 ;;You may enter a synonym for each Result/Diagnosis.  The synonym will

 ;;allow the Result/Diagnosis to be called up by typing only a few

 ;;characters.  Synonyms should be unique and less than 6 characters.

 ;;

 ;;For example, "C1" might be used for CIN I/mild dysplasia; "C2" for

 ;;CIN II/moderate dysplasia; "C3" for CIN III/severe dysplasia,

 ;;and so on.

 ;;

 ;;

 S BWTAB=5,BWLINL="TEXT1" D PRINTX

 Q

 ;

PRINTX ;EP

 N I,T,X S T="" F I=1:1:BWTAB S T=T_" "

 F I=1:1 S X=$T(@BWLINL+I) Q:X'[";;"  W !,T,$P(X,";;",2)

 Q

BWDIAGS   ;IHS/ANMC/MWR - RES/DIAG SYNONYM ADD/EDIT/PRINT;15-Feb-2003 21:50;PLS

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

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

 +3       ;;  ADD/EDIT/PRINT/PURGE SYNONYMS FOR BW RESULTS/DIAGNOSIS FILE.

 +4       ;;

 +5       ;

EDITSYN   ;EP

 +1       ;---> EDIT SYNONYMS FOR RESULTS/DIAGNOSIS.

 +2       ;---> CALLED BY OPTION "BW EDIT RES/DIAG SYNONYMS".

 +3        DO SETVARS^BWUTL5

 +4        FOR 

               Begin DoDot:1

 +5                DO TITLE^BWUTL5("EDIT SYNONYMS FOR RESULTS/DIAGNOSIS FILE")

 +6                DO TEXT1

 +7                DO DIC^BWFMAN(9002086.31,"QEMA",.Y,"   Select RESULT/DIAGNOSIS: ")

 +8                IF Y<0

                       QUIT 

 +9                DO DIE^BWFMAN(9002086.31,".3;.31",+Y,1,.BWPOP)

 +10               IF BWPOP

                       SET Y=-1

               End DoDot:1

               IF $GET(Y)<0

                   QUIT 

 +11       WRITE @IOF

 +12       DO KILLALL^BWUTL8

 +13       QUIT 

 +14      ;

PRINTSYN  ;EP

 +1       ;---> CALLED BY OPTION "BW PRINT RES/DIAG SYNONYMS".

 +2        DO SETVARS^BWUTL5

 +3        SET DIC="^BWDIAG("

 +4        SET FLDS="[BW PRINT RES/DIAG SYNONYMS]"

 +5        SET BY=.01

           SET (FR,TO)=""

 +6        DO EN1^DIP

 +7        DO KILLALL^BWUTL8

 +8        QUIT 

 +9       ;

 +10      ;

TEXT1     ;EP

 +1       ;;You may enter a synonym for each Result/Diagnosis.  The synonym will

 +2       ;;allow the Result/Diagnosis to be called up by typing only a few

 +3       ;;characters.  Synonyms should be unique and less than 6 characters.

 +4       ;;

 +5       ;;For example, "C1" might be used for CIN I/mild dysplasia; "C2" for

 +6       ;;CIN II/moderate dysplasia; "C3" for CIN III/severe dysplasia,

 +7       ;;and so on.

 +8       ;;

 +9       ;;

 +10       SET BWTAB=5

           SET BWLINL="TEXT1"

           DO PRINTX

 +11       QUIT 

 +12      ;

PRINTX    ;EP

 +1        NEW I,T,X

           SET T=""

           FOR I=1:1:BWTAB

               SET T=T_" "

 +2        FOR I=1:1

               SET X=$TEXT(@BWLINL+I)

               IF X'[";;"

                   QUIT 

               WRITE !,T,$PIECE(X,";;",2)

 +3        QUIT