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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVRAD 1314 printed Oct 16, 2024@18:48 Page 2
WVRAD ;HCIOFO/FT,JR IHS/ANMC/MWR - UTIL: MOSTLY PATIENT DATA ;7/22/98 09:46
+1 ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; EDIT WV MAMMOGRAM DIAG CODE TRANSLATIONS FILE.
+4 ;; PRINT WV MAMMOGRAM DIAG CODE TRANSLATIONS FILE.
+5 ;
+6 ;
EDIT ;---> MATCH WV RESULTS/DIAGNOSES WITH RADIOLOGY DIAGNOSTIC CODES.
+1 ;---> CALLED BY OPTION "WV EDIT DIAG TRANSLATION".
+2 DO SETVARS^WVUTL5
+3 FOR
Begin DoDot:1
+4 DO TITLE^WVUTL5("EDIT WV DIAGNOSTIC CODE TRANSLATION FILE")
+5 DO DIC^WVFMAN(790.32,"QEMAL",.Y," Select RESULT/DIAGNOSIS: ")
+6 if Y<0
QUIT
+7 DO DIE^WVFMAN(790.32,".01;.02",+Y,.WVPOP)
End DoDot:1
if $GET(Y)<0
QUIT
+8 DO EXIT
+9 QUIT
+10 ;
SCREEN ;
+1 ;---> SCREEN CALLED BY FILEMAN ^DD(790.32,.01
+2 ;---> SCREEN ONLY FOR RESULTS/DIAGNOSES THAT APPLY TO MAMMOGRAMS.
+3 ;---> HARDCODED FOR MAM IENS=25, 26 OR 28. CALLED BY ^DIC.
+4 NEW I
+5 FOR I=3:1:19
IF $PIECE(^(0),U,I)=25!($PIECE(^(0),U,I)=26)!($PIECE(^(0),U,I)=28)
QUIT
+6 QUIT
+7 ;
+8 ;
PRINT ;EP
+1 ;---> CALLED BY OPTION "WV PRINT DIAG TRANSLATION".
+2 SET DIC="^WV(790.32,"
+3 SET FLDS="[WV PRINT DIAG CODE TRANSLATION]"
+4 SET BY=.01
SET FR="AAAA"
SET TO="ZZZZ"
+5 KILL IO("Q")
SET %ZIS="Q"
DO ^%ZIS
IF POP
DO EXIT
QUIT
+6 SET IOP=ION
IF $DATA(IO("Q"))
SET IOP="Q;"_ION
+7 KILL IO("Q")
SET WVIOST=$EXTRACT(IOST)
+8 DO EN1^DIP
+9 if $EXTRACT(WVIOST)="C"
DO DIRZ^WVUTL3
+10 KILL IOP,WVIOST
+11 DO EXIT
+12 QUIT
+13 ;
EXIT ;EP
+1 DO KILLALL^WVUTL8
+2 QUIT
