45 lines
1.2 KiB
Mathematica
45 lines
1.2 KiB
Mathematica
WVRAD ;HCIOFO/FT,JR IHS/ANMC/MWR - UTIL: MOSTLY PATIENT DATA ;7/22/98 09:46
|
|
;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
|
|
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
|
;; EDIT WV MAMMOGRAM DIAG CODE TRANSLATIONS FILE.
|
|
;; PRINT WV MAMMOGRAM DIAG CODE TRANSLATIONS FILE.
|
|
;
|
|
;
|
|
EDIT ;---> MATCH WV RESULTS/DIAGNOSES WITH RADIOLOGY DIAGNOSTIC CODES.
|
|
;---> CALLED BY OPTION "WV EDIT DIAG TRANSLATION".
|
|
D SETVARS^WVUTL5
|
|
F D Q:$G(Y)<0
|
|
.D TITLE^WVUTL5("EDIT WV DIAGNOSTIC CODE TRANSLATION FILE")
|
|
.D DIC^WVFMAN(790.32,"QEMAL",.Y," Select RESULT/DIAGNOSIS: ")
|
|
.Q:Y<0
|
|
.D DIE^WVFMAN(790.32,".01;.02",+Y,.WVPOP)
|
|
D EXIT
|
|
Q
|
|
;
|
|
SCREEN ;
|
|
;---> SCREEN CALLED BY FILEMAN ^DD(790.32,.01
|
|
;---> 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 "WV PRINT DIAG TRANSLATION".
|
|
S DIC="^WV(790.32,"
|
|
S FLDS="[WV PRINT DIAG CODE TRANSLATION]"
|
|
S BY=.01,FR="AAAA",TO="ZZZZ"
|
|
K IO("Q") S %ZIS="Q" D ^%ZIS I POP D EXIT Q
|
|
S IOP=ION I $D(IO("Q")) S IOP="Q;"_ION
|
|
K IO("Q") S WVIOST=$E(IOST)
|
|
D EN1^DIP
|
|
D:$E(WVIOST)="C" DIRZ^WVUTL3
|
|
K IOP,WVIOST
|
|
D EXIT
|
|
Q
|
|
;
|
|
EXIT ;EP
|
|
D KILLALL^WVUTL8
|
|
Q
|