| 1 | WVDIAGS ;HCIOFO/FT,JR IHS/ANMC/MWR - RES/DIAG SYNONYM ADD/EDIT/PRINT ;8/3/98 16:26
|
|---|
| 2 | ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
|
|---|
| 3 | ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
|---|
| 4 | ;; ADD/EDIT/PRINT/PURGE SYNONYMS FOR WV RESULTS/DIAGNOSIS FILE.
|
|---|
| 5 | ;;
|
|---|
| 6 | ;
|
|---|
| 7 | EDITSYN ;EP
|
|---|
| 8 | ;---> EDIT SYNONYMS FOR RESULTS/DIAGNOSIS.
|
|---|
| 9 | ;---> CALLED BY OPTION "WV EDIT RES/DIAG SYNONYMS".
|
|---|
| 10 | D SETVARS^WVUTL5
|
|---|
| 11 | F D Q:$G(Y)<0
|
|---|
| 12 | .D TITLE^WVUTL5("EDIT SYNONYMS FOR RESULTS/DIAGNOSIS FILE")
|
|---|
| 13 | .D TEXT1
|
|---|
| 14 | .D DIC^WVFMAN(790.31,"QEMA",.Y," Select RESULT/DIAGNOSIS: ")
|
|---|
| 15 | .Q:Y<0
|
|---|
| 16 | .D DIE^WVFMAN(790.31,".3;.31",+Y,1,.WVPOP)
|
|---|
| 17 | .S:WVPOP Y=-1
|
|---|
| 18 | W @IOF
|
|---|
| 19 | D KILLALL^WVUTL8
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | PRINTSYN ;EP
|
|---|
| 23 | ;---> CALLED BY OPTION "WV PRINT RES/DIAG SYNONYMS".
|
|---|
| 24 | D SETVARS^WVUTL5
|
|---|
| 25 | S DIC="^WV(790.31,"
|
|---|
| 26 | S FLDS="[WV PRINT RES/DIAG SYNONYMS]"
|
|---|
| 27 | S BY=.01,(FR,TO)=""
|
|---|
| 28 | K IO("Q") S %ZIS="Q" D ^%ZIS I POP D EXIT Q
|
|---|
| 29 | S IOP=ION I $D(IO("Q")) S IOP="Q;"_ION
|
|---|
| 30 | K IO("Q") S WVIOST=$E(IOST)
|
|---|
| 31 | D EN1^DIP
|
|---|
| 32 | D:$E(WVIOST)="C" DIRZ^WVUTL3
|
|---|
| 33 | EXIT ;
|
|---|
| 34 | K IOP,WVIOST
|
|---|
| 35 | D KILLALL^WVUTL8
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | ;
|
|---|
| 39 | TEXT1 ;EP
|
|---|
| 40 | ;;You may enter a synonym for each Result/Diagnosis. The synonym will
|
|---|
| 41 | ;;allow the Result/Diagnosis to be called up by typing only a few
|
|---|
| 42 | ;;characters. Synonyms should be unique and less than 6 characters.
|
|---|
| 43 | ;;
|
|---|
| 44 | ;;For example, "C1" might be used for CIN I/mild dysplasia; "C2" for
|
|---|
| 45 | ;;CIN II/moderate dysplasia; "C3" for CIN III/severe dysplasia,
|
|---|
| 46 | ;;and so on.
|
|---|
| 47 | ;;
|
|---|
| 48 | ;;
|
|---|
| 49 | S WVTAB=5,WVLINL="TEXT1" D PRINTX
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | PRINTX ;EP
|
|---|
| 53 | N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
|
|---|
| 54 | F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
|
|---|
| 55 | Q
|
|---|
