WVDIAGS.m

WVDIAGS ;HCIOFO/FT,JR IHS/ANMC/MWR - RES/DIAG SYNONYM ADD/EDIT/PRINT ;8/3/98  16:26

 ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998

 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 ;;  ADD/EDIT/PRINT/PURGE SYNONYMS FOR WV RESULTS/DIAGNOSIS FILE.

 ;;

 ;

EDITSYN ;EP

 ;---> EDIT SYNONYMS FOR RESULTS/DIAGNOSIS.

 ;---> CALLED BY OPTION "WV EDIT RES/DIAG SYNONYMS".

 D SETVARS^WVUTL5

 F  D  Q:$G(Y)<0

 .D TITLE^WVUTL5("EDIT SYNONYMS FOR RESULTS/DIAGNOSIS FILE")

 .D TEXT1

 .D DIC^WVFMAN(790.31,"QEMA",.Y,"   Select RESULT/DIAGNOSIS: ")

 .Q:Y<0

 .D DIE^WVFMAN(790.31,".3;.31",+Y,1,.WVPOP)

 .S:WVPOP Y=-1

 W @IOF

 D KILLALL^WVUTL8

 Q

 ;

PRINTSYN ;EP

 ;---> CALLED BY OPTION "WV PRINT RES/DIAG SYNONYMS".

 D SETVARS^WVUTL5

 S DIC="^WV(790.31,"

 S FLDS="[WV PRINT RES/DIAG SYNONYMS]"

 S BY=.01,(FR,TO)=""

 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

EXIT ;

 K IOP,WVIOST

 D KILLALL^WVUTL8

 Q

 ;

 ;

TEXT1 ;EP

 ;;You may enter a synonym for each Result/Diagnosis.  The synonym will

 ;;allow the Result/Diagnosis to be called up by typing only a few

 ;;characters.  Synonyms should be unique and less than 6 characters.

 ;;

 ;;For example, "C1" might be used for CIN I/mild dysplasia; "C2" for

 ;;CIN II/moderate dysplasia; "C3" for CIN III/severe dysplasia,

 ;;and so on.

 ;;

 ;;

 S WVTAB=5,WVLINL="TEXT1" D PRINTX

 Q

 ;

PRINTX ;EP

 N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)

 F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;"  W !,T,$P(X,";;",2)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---WVDIAGS   1588     printed  Apr 09, 2024@21:49:02                                                                                                                                                                                                     Page 2

WVDIAGS   ;HCIOFO/FT,JR IHS/ANMC/MWR - RES/DIAG SYNONYM ADD/EDIT/PRINT ;8/3/98  16:26

 +1       ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998

 +2       ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 +3       ;;  ADD/EDIT/PRINT/PURGE SYNONYMS FOR WV RESULTS/DIAGNOSIS FILE.

 +4       ;;

 +5       ;

EDITSYN   ;EP

 +1       ;---> EDIT SYNONYMS FOR RESULTS/DIAGNOSIS.

 +2       ;---> CALLED BY OPTION "WV EDIT RES/DIAG SYNONYMS".

 +3        DO SETVARS^WVUTL5

 +4        FOR 

               Begin DoDot:1

 +5                DO TITLE^WVUTL5("EDIT SYNONYMS FOR RESULTS/DIAGNOSIS FILE")

 +6                DO TEXT1

 +7                DO DIC^WVFMAN(790.31,"QEMA",.Y,"   Select RESULT/DIAGNOSIS: ")

 +8                if Y<0

                       QUIT 

 +9                DO DIE^WVFMAN(790.31,".3;.31",+Y,1,.WVPOP)

 +10               if WVPOP

                       SET Y=-1

               End DoDot:1

               if $GET(Y)<0

                   QUIT 

 +11       WRITE @IOF

 +12       DO KILLALL^WVUTL8

 +13       QUIT 

 +14      ;

PRINTSYN  ;EP

 +1       ;---> CALLED BY OPTION "WV PRINT RES/DIAG SYNONYMS".

 +2        DO SETVARS^WVUTL5

 +3        SET DIC="^WV(790.31,"

 +4        SET FLDS="[WV PRINT RES/DIAG SYNONYMS]"

 +5        SET BY=.01

           SET (FR,TO)=""

 +6        KILL IO("Q")

           SET %ZIS="Q"

           DO ^%ZIS

           IF POP

               DO EXIT

               QUIT 

 +7        SET IOP=ION

           IF $DATA(IO("Q"))

               SET IOP="Q;"_ION

 +8        KILL IO("Q")

           SET WVIOST=$EXTRACT(IOST)

 +9        DO EN1^DIP

 +10       if $EXTRACT(WVIOST)="C"

               DO DIRZ^WVUTL3

EXIT      ;

 +1        KILL IOP,WVIOST

 +2        DO KILLALL^WVUTL8

 +3        QUIT 

 +4       ;

 +5       ;

TEXT1     ;EP

 +1       ;;You may enter a synonym for each Result/Diagnosis.  The synonym will

 +2       ;;allow the Result/Diagnosis to be called up by typing only a few

 +3       ;;characters.  Synonyms should be unique and less than 6 characters.

 +4       ;;

 +5       ;;For example, "C1" might be used for CIN I/mild dysplasia; "C2" for

 +6       ;;CIN II/moderate dysplasia; "C3" for CIN III/severe dysplasia,

 +7       ;;and so on.

 +8       ;;

 +9       ;;

 +10       SET WVTAB=5

           SET WVLINL="TEXT1"

           DO PRINTX

 +11       QUIT 

 +12      ;

PRINTX    ;EP

 +1        NEW I,T,X

           SET T=$$REPEAT^XLFSTR(" ",WVTAB)

 +2        FOR I=1:1

               SET X=$TEXT(@WVLINL+I)

               if X'[";;"

                   QUIT 

               WRITE !,T,$PIECE(X,";;",2)

 +3        QUIT