| [613] | 1 | WVRAD ;HCIOFO/FT,JR IHS/ANMC/MWR - UTIL: MOSTLY PATIENT DATA ;7/22/98  09:46
 | 
|---|
 | 2 |  ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
 | 
|---|
 | 3 |  ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
 | 
|---|
 | 4 |  ;;  EDIT WV MAMMOGRAM DIAG CODE TRANSLATIONS FILE.
 | 
|---|
 | 5 |  ;;  PRINT WV MAMMOGRAM DIAG CODE TRANSLATIONS FILE.
 | 
|---|
 | 6 |  ;
 | 
|---|
 | 7 |  ;
 | 
|---|
 | 8 | EDIT ;---> MATCH WV RESULTS/DIAGNOSES WITH RADIOLOGY DIAGNOSTIC CODES.
 | 
|---|
 | 9 |  ;---> CALLED BY OPTION "WV EDIT DIAG TRANSLATION".
 | 
|---|
 | 10 |  D SETVARS^WVUTL5
 | 
|---|
 | 11 |  F  D  Q:$G(Y)<0
 | 
|---|
 | 12 |  .D TITLE^WVUTL5("EDIT WV DIAGNOSTIC CODE TRANSLATION FILE")
 | 
|---|
 | 13 |  .D DIC^WVFMAN(790.32,"QEMAL",.Y,"   Select RESULT/DIAGNOSIS: ")
 | 
|---|
 | 14 |  .Q:Y<0
 | 
|---|
 | 15 |  .D DIE^WVFMAN(790.32,".01;.02",+Y,.WVPOP)
 | 
|---|
 | 16 |  D EXIT
 | 
|---|
 | 17 |  Q
 | 
|---|
 | 18 |  ;
 | 
|---|
 | 19 | SCREEN ;
 | 
|---|
 | 20 |  ;---> SCREEN CALLED BY FILEMAN ^DD(790.32,.01
 | 
|---|
 | 21 |  ;---> SCREEN ONLY FOR RESULTS/DIAGNOSES THAT APPLY TO MAMMOGRAMS.
 | 
|---|
 | 22 |  ;---> HARDCODED FOR MAM IENS=25, 26 OR 28.  CALLED BY ^DIC.
 | 
|---|
 | 23 |  N I
 | 
|---|
 | 24 |  F I=3:1:19 I $P(^(0),U,I)=25!($P(^(0),U,I)=26)!($P(^(0),U,I)=28) Q
 | 
|---|
 | 25 |  Q
 | 
|---|
 | 26 |  ;
 | 
|---|
 | 27 |  ;
 | 
|---|
 | 28 | PRINT ;EP
 | 
|---|
 | 29 |  ;---> CALLED BY OPTION "WV PRINT DIAG TRANSLATION".
 | 
|---|
 | 30 |  S DIC="^WV(790.32,"
 | 
|---|
 | 31 |  S FLDS="[WV PRINT DIAG CODE TRANSLATION]"
 | 
|---|
 | 32 |  S BY=.01,FR="AAAA",TO="ZZZZ"
 | 
|---|
 | 33 |  K IO("Q") S %ZIS="Q" D ^%ZIS I POP D EXIT Q
 | 
|---|
 | 34 |  S IOP=ION I $D(IO("Q")) S IOP="Q;"_ION
 | 
|---|
 | 35 |  K IO("Q") S WVIOST=$E(IOST)
 | 
|---|
 | 36 |  D EN1^DIP
 | 
|---|
 | 37 |  D:$E(WVIOST)="C" DIRZ^WVUTL3
 | 
|---|
 | 38 |  K IOP,WVIOST
 | 
|---|
 | 39 |  D EXIT
 | 
|---|
 | 40 |  Q
 | 
|---|
 | 41 |  ;
 | 
|---|
 | 42 | EXIT ;EP
 | 
|---|
 | 43 |  D KILLALL^WVUTL8
 | 
|---|
 | 44 |  Q
 | 
|---|