| 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
 | 
|---|