- 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 Jan 18, 2025@03:48:39 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