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 ---[H[J[2J[HWVDIAGS 1588 printed Dec 13, 2024@02:46:54 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
