WVUTL1A ;HCIOFO/JR,FT - Continuation of ^WVUTL1 (Utilities) ;07/20/2015 11:12
;;1.0;WOMEN'S HEALTH;**4,7,14,24**;Sep 30, 1998;Build 582
;
; This routine uses the following IAs:
; #1252 - $$OUTPTPR^SDUTL3 (supported)
; #2483 - FILE 2, Field 1901 (private)
; #2716 - $$GETSTAT^DGMSTAPI (supported)
; #10035 - ^DPT(DFN,.104 (supported)
; #10060 - FILE 200 fields (supported)
; #10090 - FILE 4 fields (supported)
;
PRIOR() ;EP
;---> CALLED FROM WV NOTIF-EDITBLK-1 TO GET VALUE AND TEXT OF
;---> NOTIFICATION PRIORITY AND RESULT/REMINDER, FROM PURPOSE OF
;---> NOTIFICATION WHEN FIRST DISPLAYING SCREEN.
;---> REQUIRED VARIABLE: DA=IEN OF NOTIFICATION.
N X
Q:'$D(DA) "UNKNOWN"
Q:'$D(^WV(790.4,DA,0)) "UNKNOWN"
S X=$P(^WV(790.4,DA,0),U,4)
Q:'X "UNKNOWN"
Q $$PRIOR1
;
PRIOR1() ;EP
;---> CALLED FROM WV NOTIF-EDITBLK-1 TO GET VALUE AND TEXT OF
;---> NOTIFICATION PRIORITY FROM PURPOSE OF NOTIFICATION AS AN
;---> ACTION WHEN EDITING PURPOSE OF NOTIFICATION. ALSO DISPLAY
;---> WHETHER PURPOSE IS A RESULT OR A REMINDER.
;---> REQUIRED VARIABLE: X=IEN IN NOTIFICATION PURPOSE FILE.
N R,Y,Z
Q:'$D(X) "UNDEFINED"
Q:'X "UNKNOWN"
Q:'$D(^WV(790.404,X,0)) "UNKNOWN"
S Y=$P(^WV(790.404,X,0),U,2) D
.I 'Y S R="UNKNOWN" Q
.I '$$VFIELD^DILFD(790.404,.02) S R="^DD MISSING"
.S R=$$EXTERNAL^DILFD(790.404,.02,"",Y)
S Z=$P(^WV(790.404,X,0),U,6)
Q:Z="" R
Q:Z R_", RESULT"
Q R_", REMINDER"
;
;
NTPROC() ;EP
;---> CALLED FROM WV NOTIF-EDITBLK-1(?) BLOCK TO DISPLAY PROCEDURE
;---> NAME, BASED ON ACCESSION# PTR, WHEN FIRST DISPLAYING SCREEN.
;---> REQUIRED VARIABLE: X=ACCESSION# OF PROCEDURE
N X
S X=$P(^WV(790.4,DA,0),U,6)
Q $$PROC
;
PROC() ;EP
;---> DISPLAY PROCEDURE TYPE OF THIS PROCEDURE.
;---> REQUIRED VARIABLE: X=IEN OF PROCEDURE IN PROC FILE #790.1.
N WVY,WVYY,Y,Z S WVYY="INVALID ACC# OR PTR"
Q:X']"" ""
Q:'$D(^WV(790.1,X,0)) WVYY
S WVY=$P(^WV(790.1,X,0),U,4)
Q:'WVY WVYY
Q:'$D(^WV(790.2,WVY,0)) WVYY
S Z=$P(^WV(790.2,WVY,0),U)
;---> IF UNILATERAL AND LEFT/RIGHT HAS A VALUE, REPLACE "UNILATERAL"
;---> WITH LEFT OR RIGHT.
S Y=$P(^WV(790.1,X,0),U,9)
S Y=$S(Y="l":"LEFT",Y="r":"RIGHT",1:"")
Q:Y="" Z
Q $P(Z," ")_" "_Y
;
PROC1() ;EP
;---> DISPLAY PROCEDURE TYPE OF THIS PROCEDURE, USING DA.
;---> CALLED BY WV PROC-HEADER-1, WHICH CANNOT USE X.
;---> REQUIRED VARIABLE: DA=IEN OF PROCEDURE IN PROC FILE #790.1.
N X S X=DA
Q $$PROC
PROVI(DFN) ;
;---> RETURNS THE PRIMARY CARE PROVIDER
;---> REQUIRED VARIABLE: DFN
Q:$G(DFN)'>0 "UNKNOWN"
N X S X=$P($G(^DPT(DFN,.104)),U)
S X=$S(X>0:$$GET1^DIQ(200,X,.01,"E"),1:"")
I X="" S X=$P($$OUTPTPR^SDUTL3(DFN),U,2)
S:X="" X="UNKNOWN"
Q X
SCR(X) ;
Q:$G(X)'>0 0
S WVJX=$S(X>0:$P($G(^WV(790.07,X,0)),U,2),1:0)
Q WVJX
QUAD(X) ;
Q:$TR(X,"ULR,")'="" 0
N TEST,CN,CNT,WVJX S WVJX=X,CN=""
S (CN("LL"),CN("UL"),CN("UR"),CN("LR"))="",TEST=1
F S CN=$O(CN(CN)) Q:CN="" I $P(WVJX,CN,2,5)[CN S WVJX=$P(WVJX,CN,1,2)_$P(WVJX,CN,3)
F CN=1:1:11 I $E(WVJX,CN)=","&($E(WVJX,CN+1)=",") S WVJX=$E(WVJX,1,CN)_$E(WVJX,CN+2,11) S CN=CN-1
F CN=1:1:4 S CNT=$P(X,",",CN) I CNT'="" I '$D(CN(CNT)) S TEST=0 Q
S:$E(WVJX,$L(WVJX))="," WVJX=$E(WVJX,1,$L(WVJX)-1)
S:$E(WVJX,1)="," WVJX=$E(WVJX,2,11)
S:TEST>0 TEST=TEST_"^"_WVJX
Q TEST
REF ;
N X,Y,B,L
Q:$G(DA)="" S X=DA
S Y=X,X=$P($G(^WV(790.07,X,0)),U)
S L="abcdefghijklmnopqrstuvwxyz"
S B="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
S X=$TR($E(X,1,$L(X)),L,B)
I WVACT="SET" S ^WV(790.07,"C",X,Y)=""
I WVACT="KIL" K ^WV(790.07,"C",X,Y)
K WVACT Q
FAC N X,Y
S WVJBFAC="",WVJCFAC="",WVJPCP=""
Q:$G(WVDFN)'>0
S X=$G(^WV(790,WVDFN,0))
S WVJBFAC=$P(X,U,25),WVJCFAC=$P(X,U,26),WVJPCP=$$PROVI(WVDFN)
S:WVJBFAC>0 WVJBFAC=$E($$GET1^DIQ(4,WVJBFAC,.01,"E"),1,18)
S:WVJCFAC>0 WVJCFAC=$E($$GET1^DIQ(4,WVJCFAC,.01,"E"),1,18)
Q
RAXS(DA) ;
N WVJJ0
I $G(DA)'>0 Q 0
S WVJJ0=$G(^WV(790.1,DA,0))
I '$D(WVJJ0) Q 0
I "^BU^MB^MU^MS^"'[$E(WVJJ0,1,2) Q 0
I $P(WVJJ0,U,15)="" Q 0
Q 1
FACIL(DFN,TYP) ;Gets Treatment Facility, if typ="C" for Cervix, "B" for Breast
N X,Y
S Y=""
I $G(DFN)'>0 Q Y
S X=$G(^WV(790,DFN,0))
S:TYP="B" Y=$P(X,U,25) S:TYP="C" Y=$P(X,U,26)
S:Y>0 Y=$E($$GET1^DIQ(4,Y,.01,"E"),1,18)
Q Y
MST(WVDFN) ;Gets Military Sexual Trauma
I $G(WVDFN)'>0 Q ""
N X,WVMST
S WVMST=$$GETSTAT^DGMSTAPI(WVDFN)
S WVMST=$S($P(WVMST,U,6)]"":$P(WVMST,U,6),1:"")
S:WVMST="" WVMST="Unknown, not screened"
I $E($$VET(WVDFN))'="Y" S WVMST="<N/A Not a Veteran>"
Q WVMST
;
SC(WVJ,WVFN) ;Screen called from File 790.02 to elim. inactive from selectable
I $G(XQY0)["WV ADD/EDIT CASE MANAGERS" Q 1
I $G(WVJOPEN)>0 Q 1
N WVINACT
S WVINACT=$P($G(^WV(WVFN,+WVJ,0)),U,2) ;date inactivated
I WVINACT>0,WVINACT<$G(DT) Q 0
Q 1
LOOK(WVJ) ;Display select fields with lookup on 790, not file#2 Identif.
Q:WVJ'>0
N DIC,DA,DR,DIQ,Y
S DIC="^WV(790,",DA=WVJ,DIQ="WVJAR(",DIQ(0)="E"
S DR=".06;.1;.16" D EN^DIQ1
S WVJ=WVJAR(790,WVJ,.06,"E")_" "_WVJAR(790,WVJ,.1,"E")
K WVJAR
Q WVJ
LOOKL(WVJ) ;
N Y,WVX,WVP,WVY,WVDT,WVP,X,WVDTS,WVMARK,X1,X2
S X1=DT,X2=-30 D C^%DTC S WVDTS=X
S WVX="" F S WVX=$O(^WV(790.3,"C",+WVJ,WVX)) Q:WVX'>0 D
.S WVY=$G(^WV(790.3,WVX,0)),WVDT=+WVY,WVP=$P(WVY,U,3)
.Q:WVDT'>WVDTS S WVMARK=1
.S Y=WVDT D DD^%DT S WVDT=Y
.;S WVP=$S(WVP'>0:"",1:$P($G(^WV(790.1,WVP,0)),U,4))
.S:WVP'="" WVP=$P($G(^WV(790.2,WVP,0)),U)
.W !?32,WVDT,?47,WVP
W:$G(WVMARK)=1 !
Q
RUNDT(WVY) ;Get and format run date for various reports
; Center when WVY="C"
N Y,WVJ,%
I $D(WVJRNOW) Q WVJRNOW
D NOW^%DTC S Y=% D DD^%DT
S Y=$E(Y,1,12)_" "_$E(Y,14,18)
S:$L(Y)'>10 Y=""
S (WVJRNOW,WVJ)="Run Date: "_Y
I $G(WVY)="C" S (WVJ,WVJRNOW)=" "_WVJRNOW
Q WVJ
;
LINE ; Called from the WV LINE FOR MENUS option. That option is merely a
; place holder in the menu and used for visual purposes. This is
; entry point does nothing.
Q
VET(DFN) ; Check if patient is a veteran.
N WVETERAN
S WVETERAN=$$GET1^DIQ(2,DFN,1901,"I")
Q $S(WVETERAN="Y":"Yes",WVETERAN="N":"No",1:"Unknown")
;
CST(WVDFN) ; Return Civilian Sexual Trauma value
Q $$GET1^DIQ(790,+WVDFN,.28,"E")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVUTL1A 6238 printed Sep 23, 2025@20:24:29 Page 2
WVUTL1A ;HCIOFO/JR,FT - Continuation of ^WVUTL1 (Utilities) ;07/20/2015 11:12
+1 ;;1.0;WOMEN'S HEALTH;**4,7,14,24**;Sep 30, 1998;Build 582
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #1252 - $$OUTPTPR^SDUTL3 (supported)
+5 ; #2483 - FILE 2, Field 1901 (private)
+6 ; #2716 - $$GETSTAT^DGMSTAPI (supported)
+7 ; #10035 - ^DPT(DFN,.104 (supported)
+8 ; #10060 - FILE 200 fields (supported)
+9 ; #10090 - FILE 4 fields (supported)
+10 ;
PRIOR() ;EP
+1 ;---> CALLED FROM WV NOTIF-EDITBLK-1 TO GET VALUE AND TEXT OF
+2 ;---> NOTIFICATION PRIORITY AND RESULT/REMINDER, FROM PURPOSE OF
+3 ;---> NOTIFICATION WHEN FIRST DISPLAYING SCREEN.
+4 ;---> REQUIRED VARIABLE: DA=IEN OF NOTIFICATION.
+5 NEW X
+6 if '$DATA(DA)
QUIT "UNKNOWN"
+7 if '$DATA(^WV(790.4,DA,0))
QUIT "UNKNOWN"
+8 SET X=$PIECE(^WV(790.4,DA,0),U,4)
+9 if 'X
QUIT "UNKNOWN"
+10 QUIT $$PRIOR1
+11 ;
PRIOR1() ;EP
+1 ;---> CALLED FROM WV NOTIF-EDITBLK-1 TO GET VALUE AND TEXT OF
+2 ;---> NOTIFICATION PRIORITY FROM PURPOSE OF NOTIFICATION AS AN
+3 ;---> ACTION WHEN EDITING PURPOSE OF NOTIFICATION. ALSO DISPLAY
+4 ;---> WHETHER PURPOSE IS A RESULT OR A REMINDER.
+5 ;---> REQUIRED VARIABLE: X=IEN IN NOTIFICATION PURPOSE FILE.
+6 NEW R,Y,Z
+7 if '$DATA(X)
QUIT "UNDEFINED"
+8 if 'X
QUIT "UNKNOWN"
+9 if '$DATA(^WV(790.404,X,0))
QUIT "UNKNOWN"
+10 SET Y=$PIECE(^WV(790.404,X,0),U,2)
Begin DoDot:1
+11 IF 'Y
SET R="UNKNOWN"
QUIT
+12 IF '$$VFIELD^DILFD(790.404,.02)
SET R="^DD MISSING"
+13 SET R=$$EXTERNAL^DILFD(790.404,.02,"",Y)
End DoDot:1
+14 SET Z=$PIECE(^WV(790.404,X,0),U,6)
+15 if Z=""
QUIT R
+16 if Z
QUIT R_", RESULT"
+17 QUIT R_", REMINDER"
+18 ;
+19 ;
NTPROC() ;EP
+1 ;---> CALLED FROM WV NOTIF-EDITBLK-1(?) BLOCK TO DISPLAY PROCEDURE
+2 ;---> NAME, BASED ON ACCESSION# PTR, WHEN FIRST DISPLAYING SCREEN.
+3 ;---> REQUIRED VARIABLE: X=ACCESSION# OF PROCEDURE
+4 NEW X
+5 SET X=$PIECE(^WV(790.4,DA,0),U,6)
+6 QUIT $$PROC
+7 ;
PROC() ;EP
+1 ;---> DISPLAY PROCEDURE TYPE OF THIS PROCEDURE.
+2 ;---> REQUIRED VARIABLE: X=IEN OF PROCEDURE IN PROC FILE #790.1.
+3 NEW WVY,WVYY,Y,Z
SET WVYY="INVALID ACC# OR PTR"
+4 if X']""
QUIT ""
+5 if '$DATA(^WV(790.1,X,0))
QUIT WVYY
+6 SET WVY=$PIECE(^WV(790.1,X,0),U,4)
+7 if 'WVY
QUIT WVYY
+8 if '$DATA(^WV(790.2,WVY,0))
QUIT WVYY
+9 SET Z=$PIECE(^WV(790.2,WVY,0),U)
+10 ;---> IF UNILATERAL AND LEFT/RIGHT HAS A VALUE, REPLACE "UNILATERAL"
+11 ;---> WITH LEFT OR RIGHT.
+12 SET Y=$PIECE(^WV(790.1,X,0),U,9)
+13 SET Y=$SELECT(Y="l":"LEFT",Y="r":"RIGHT",1:"")
+14 if Y=""
QUIT Z
+15 QUIT $PIECE(Z," ")_" "_Y
+16 ;
PROC1() ;EP
+1 ;---> DISPLAY PROCEDURE TYPE OF THIS PROCEDURE, USING DA.
+2 ;---> CALLED BY WV PROC-HEADER-1, WHICH CANNOT USE X.
+3 ;---> REQUIRED VARIABLE: DA=IEN OF PROCEDURE IN PROC FILE #790.1.
+4 NEW X
SET X=DA
+5 QUIT $$PROC
PROVI(DFN) ;
+1 ;---> RETURNS THE PRIMARY CARE PROVIDER
+2 ;---> REQUIRED VARIABLE: DFN
+3 if $GET(DFN)'>0
QUIT "UNKNOWN"
+4 NEW X
SET X=$PIECE($GET(^DPT(DFN,.104)),U)
+5 SET X=$SELECT(X>0:$$GET1^DIQ(200,X,.01,"E"),1:"")
+6 IF X=""
SET X=$PIECE($$OUTPTPR^SDUTL3(DFN),U,2)
+7 if X=""
SET X="UNKNOWN"
+8 QUIT X
SCR(X) ;
+1 if $GET(X)'>0
QUIT 0
+2 SET WVJX=$SELECT(X>0:$PIECE($GET(^WV(790.07,X,0)),U,2),1:0)
+3 QUIT WVJX
QUAD(X) ;
+1 if $TRANSLATE(X,"ULR,")'=""
QUIT 0
+2 NEW TEST,CN,CNT,WVJX
SET WVJX=X
SET CN=""
+3 SET (CN("LL"),CN("UL"),CN("UR"),CN("LR"))=""
SET TEST=1
+4 FOR
SET CN=$ORDER(CN(CN))
if CN=""
QUIT
IF $PIECE(WVJX,CN,2,5)[CN
SET WVJX=$PIECE(WVJX,CN,1,2)_$PIECE(WVJX,CN,3)
+5 FOR CN=1:1:11
IF $EXTRACT(WVJX,CN)=","&($EXTRACT(WVJX,CN+1)=",")
SET WVJX=$EXTRACT(WVJX,1,CN)_$EXTRACT(WVJX,CN+2,11)
SET CN=CN-1
+6 FOR CN=1:1:4
SET CNT=$PIECE(X,",",CN)
IF CNT'=""
IF '$DATA(CN(CNT))
SET TEST=0
QUIT
+7 if $EXTRACT(WVJX,$LENGTH(WVJX))=","
SET WVJX=$EXTRACT(WVJX,1,$LENGTH(WVJX)-1)
+8 if $EXTRACT(WVJX,1)=","
SET WVJX=$EXTRACT(WVJX,2,11)
+9 if TEST>0
SET TEST=TEST_"^"_WVJX
+10 QUIT TEST
REF ;
+1 NEW X,Y,B,L
+2 if $GET(DA)=""
QUIT
SET X=DA
+3 SET Y=X
SET X=$PIECE($GET(^WV(790.07,X,0)),U)
+4 SET L="abcdefghijklmnopqrstuvwxyz"
+5 SET B="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+6 SET X=$TRANSLATE($EXTRACT(X,1,$LENGTH(X)),L,B)
+7 IF WVACT="SET"
SET ^WV(790.07,"C",X,Y)=""
+8 IF WVACT="KIL"
KILL ^WV(790.07,"C",X,Y)
+9 KILL WVACT
QUIT
FAC NEW X,Y
+1 SET WVJBFAC=""
SET WVJCFAC=""
SET WVJPCP=""
+2 if $GET(WVDFN)'>0
QUIT
+3 SET X=$GET(^WV(790,WVDFN,0))
+4 SET WVJBFAC=$PIECE(X,U,25)
SET WVJCFAC=$PIECE(X,U,26)
SET WVJPCP=$$PROVI(WVDFN)
+5 if WVJBFAC>0
SET WVJBFAC=$EXTRACT($$GET1^DIQ(4,WVJBFAC,.01,"E"),1,18)
+6 if WVJCFAC>0
SET WVJCFAC=$EXTRACT($$GET1^DIQ(4,WVJCFAC,.01,"E"),1,18)
+7 QUIT
RAXS(DA) ;
+1 NEW WVJJ0
+2 IF $GET(DA)'>0
QUIT 0
+3 SET WVJJ0=$GET(^WV(790.1,DA,0))
+4 IF '$DATA(WVJJ0)
QUIT 0
+5 IF "^BU^MB^MU^MS^"'[$EXTRACT(WVJJ0,1,2)
QUIT 0
+6 IF $PIECE(WVJJ0,U,15)=""
QUIT 0
+7 QUIT 1
FACIL(DFN,TYP) ;Gets Treatment Facility, if typ="C" for Cervix, "B" for Breast
+1 NEW X,Y
+2 SET Y=""
+3 IF $GET(DFN)'>0
QUIT Y
+4 SET X=$GET(^WV(790,DFN,0))
+5 if TYP="B"
SET Y=$PIECE(X,U,25)
if TYP="C"
SET Y=$PIECE(X,U,26)
+6 if Y>0
SET Y=$EXTRACT($$GET1^DIQ(4,Y,.01,"E"),1,18)
+7 QUIT Y
MST(WVDFN) ;Gets Military Sexual Trauma
+1 IF $GET(WVDFN)'>0
QUIT ""
+2 NEW X,WVMST
+3 SET WVMST=$$GETSTAT^DGMSTAPI(WVDFN)
+4 SET WVMST=$SELECT($PIECE(WVMST,U,6)]"":$PIECE(WVMST,U,6),1:"")
+5 if WVMST=""
SET WVMST="Unknown, not screened"
+6 IF $EXTRACT($$VET(WVDFN))'="Y"
SET WVMST="<N/A Not a Veteran>"
+7 QUIT WVMST
+8 ;
SC(WVJ,WVFN) ;Screen called from File 790.02 to elim. inactive from selectable
+1 IF $GET(XQY0)["WV ADD/EDIT CASE MANAGERS"
QUIT 1
+2 IF $GET(WVJOPEN)>0
QUIT 1
+3 NEW WVINACT
+4 ;date inactivated
SET WVINACT=$PIECE($GET(^WV(WVFN,+WVJ,0)),U,2)
+5 IF WVINACT>0
IF WVINACT<$GET(DT)
QUIT 0
+6 QUIT 1
LOOK(WVJ) ;Display select fields with lookup on 790, not file#2 Identif.
+1 if WVJ'>0
QUIT
+2 NEW DIC,DA,DR,DIQ,Y
+3 SET DIC="^WV(790,"
SET DA=WVJ
SET DIQ="WVJAR("
SET DIQ(0)="E"
+4 SET DR=".06;.1;.16"
DO EN^DIQ1
+5 SET WVJ=WVJAR(790,WVJ,.06,"E")_" "_WVJAR(790,WVJ,.1,"E")
+6 KILL WVJAR
+7 QUIT WVJ
LOOKL(WVJ) ;
+1 NEW Y,WVX,WVP,WVY,WVDT,WVP,X,WVDTS,WVMARK,X1,X2
+2 SET X1=DT
SET X2=-30
DO C^%DTC
SET WVDTS=X
+3 SET WVX=""
FOR
SET WVX=$ORDER(^WV(790.3,"C",+WVJ,WVX))
if WVX'>0
QUIT
Begin DoDot:1
+4 SET WVY=$GET(^WV(790.3,WVX,0))
SET WVDT=+WVY
SET WVP=$PIECE(WVY,U,3)
+5 if WVDT'>WVDTS
QUIT
SET WVMARK=1
+6 SET Y=WVDT
DO DD^%DT
SET WVDT=Y
+7 ;S WVP=$S(WVP'>0:"",1:$P($G(^WV(790.1,WVP,0)),U,4))
+8 if WVP'=""
SET WVP=$PIECE($GET(^WV(790.2,WVP,0)),U)
+9 WRITE !?32,WVDT,?47,WVP
End DoDot:1
+10 if $GET(WVMARK)=1
WRITE !
+11 QUIT
RUNDT(WVY) ;Get and format run date for various reports
+1 ; Center when WVY="C"
+2 NEW Y,WVJ,%
+3 IF $DATA(WVJRNOW)
QUIT WVJRNOW
+4 DO NOW^%DTC
SET Y=%
DO DD^%DT
+5 SET Y=$EXTRACT(Y,1,12)_" "_$EXTRACT(Y,14,18)
+6 if $LENGTH(Y)'>10
SET Y=""
+7 SET (WVJRNOW,WVJ)="Run Date: "_Y
+8 IF $GET(WVY)="C"
SET (WVJ,WVJRNOW)=" "_WVJRNOW
+9 QUIT WVJ
+10 ;
LINE ; Called from the WV LINE FOR MENUS option. That option is merely a
+1 ; place holder in the menu and used for visual purposes. This is
+2 ; entry point does nothing.
+3 QUIT
VET(DFN) ; Check if patient is a veteran.
+1 NEW WVETERAN
+2 SET WVETERAN=$$GET1^DIQ(2,DFN,1901,"I")
+3 QUIT $SELECT(WVETERAN="Y":"Yes",WVETERAN="N":"No",1:"Unknown")
+4 ;
CST(WVDFN) ; Return Civilian Sexual Trauma value
+1 QUIT $$GET1^DIQ(790,+WVDFN,.28,"E")
+2 ;
