WVRAD.m

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 ---WVRAD   1314     printed  Apr 09, 2024@21:50:26                                                                                                                                                                                                       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