191 lines
5.9 KiB
Mathematica
191 lines
5.9 KiB
Mathematica
WVUTL1A ;HCIOFO/JR,FT-Continuation of ^WVUTL1 (Utilities) ;4/10/01 11:29
|
|
;;1.0;WOMEN'S HEALTH;**4,7,14**;Sep 30, 1998
|
|
;
|
|
; 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) ;
|
|
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) ;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(790.01,+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
|
|
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")
|
|
;
|