WVMSTL ;HCIOFO/FT-List WH Sexual Trauma Data ;3/27/01 11:12
;;1.0;WOMEN'S HEALTH;**11,14**;Sep 30, 1998
;
; This routine uses the following IAs:
; #2716 - $$GETSTAT^DGMSTAPI (supported)
;
BEGIN ;EP
S WVE="",(WVMGR,WVPOP)=0
D CMGR G:WVPOP EXIT
D DEVICE G:WVPOP EXIT
D START
EXIT ; Exit and clean up
K ^TMP($J)
D ^%ZISC
K DIR,DIRUT,DIROUT,DTOUT,DUOUT
K WVCRT,WVCST,WVDATE,WVDFN,WVDG,WVDGMST,WVDGMSTC,WVE,WVEC,WVLINE,WVLINL,WVMGR,WVMGRN,WVMGRO,WVMSTN,WVNAME
K WVNODE,WVPAGE,WVPOP,WVPROV,WVSORT,WVSSN,WVST,WVSV,WVTAB,WVTITLE,WVUSER,WVVET,WVZSTOP
K X,Y,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE
Q
CMGR ;EP
;---> SELECT ONE CASE MANAGER OR ALL.
W !!?3,"Show data for all patients for ONE particular Case Manager,"
W !?3,"or all patients for ALL Case Managers?"
N DIR,DIRUT,Y
S DIR("A")=" Select ONE or ALL: ",DIR("B")="ONE",WVMGR=""
S DIR(0)="SAM^o:ONE;a:ALL" D HELP1^WVMSTL
D ^DIR K DIR
I Y=-1!($D(DIRUT)) S WVPOP=1 Q
;---> IF ALL CASE MANAGERS, S WVE=1 AND QUIT.
I Y="a" S WVE=1 Q
D DIC^WVFMAN(790.01,"QEMA",.Y," Select CASE MANAGER: ")
I Y<0 S WVPOP=1 Q
;---> FOR ONE CASE MANAGER, SET WVE=0 AND WVMGR=^VA(200 DFN, QUIT.
S WVMGR=+Y,WVE=0
Q
DEVICE ;EP
;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
S ZTRTN="DEQUEUE^WVMSTL"
S ZTDESC="List Sexual Trauma Data"
F WVSV="E","MGR" D
.I $D(@("WV"_WVSV)) S ZTSAVE("WV"_WVSV)=""
D ZIS^WVUTL2(.WVPOP,1,"HOME")
Q
START ; Start data gathering
I $D(ZTQUEUED) S ZTREQ="@"
K ^TMP($J)
Q:$G(WVE)=""
S (WVDFN,WVZSTOP)=0
; all case managers
I WVE=1 F S WVDFN=$O(^WV(790,WVDFN)) Q:'WVDFN!($G(ZTSTOP)=1) D SET
; one case manager
I WVE=0,WVMGR F S WVDFN=$O(^WV(790,"C",WVMGR,WVDFN)) Q:'WVDFN!($G(ZTSTOP)=1) D SET
Q:$G(ZTSTOP)=1
D PRINT^WVMSTL1
Q
SET ; Set temp global
S WVZSTOP=WVZSTOP+1
; if a background task, check if user requested to stop the task
I $D(ZTQUEUED),WVZSTOP#100=0 D STOPCHK^WVUTL10(0) Q:$G(ZTSTOP)=1
Q:$$DECEASED^WVUTL1(WVDFN) ;deceased
S WVNODE=$G(^WV(790,WVDFN,0)) Q:WVNODE=""
I $P(WVNODE,U,24)>0,$P(WVNODE,U,24)<DT Q ;inactive date before today
S WVVET=$$VET^WVUTL1A(WVDFN) ;veterans status
S WVEC=$$ELIG^WVUTL9(WVDFN),WVEC=$P(WVEC,U,2) ;primary eligibility code
S WVPROV=$$PROVI^WVUTL1A(WVDFN) ;primary provider
S WVMGR=$P(WVNODE,U,10) ;case manager ien
S WVDGMST="<N/A Not a Veteran>"
S WVDGMSTC=""
I $E(WVVET)="Y" D
.; $$GETSTAT^DGMSTAPI supported API - IA #2716
.S WVDGMST=$$GETSTAT^DGMSTAPI(WVDFN) ;get MST value from Registration
.S WVDGMSTC=$P(WVDGMST,U,2) ;mst status code
.S WVDGMST=$P(WVDGMST,U,6) ;mst status text
.S:WVDGMST="" WVDGMST="Unknown, not screened"
.Q
S WVMSTN=$S(WVDGMSTC="Y":1,WVDGMSTC="N":2,WVDGMSTC="D":3,WVDGMSTC="U":4,1:5)
S WVMGRN=$$PERSON^WVUTL1(WVMGR) ;case manager name
S WVNAME=$$NAME^WVUTL1(WVDFN) ;patient name
S WVSSN=$$SSN^WVUTL1(WVDFN) ;patient ssn
S WVCST=$$CST^WVUTL1A(WVDFN) ;Civilian Sexual Trauma
S:WVCST="" WVCST="<no value>"
S:'$D(WVDG(WVMSTN)) WVDG(WVMSTN)=WVDGMST
S ^TMP($J,"WVST",WVMGRN,WVMGR,WVMSTN,WVNAME,WVDFN)=WVSSN_U_WVPROV_U_WVVET_U_WVEC_U_WVCST_U_WVDGMST
Q
DEQUEUE ; WVE and WVMGR variables must be set.
D START,EXIT
Q
HELP1 ;EP
;;Answer "ONE" to list patients for ONE particular Case Manager.
;;Answer "ALL" to list patients for ALL Case Managers.
S WVTAB=5,WVLINL="HELP1" D HELPTX
Q
HELPTX ;EP
;---> CREATES DIR ARRAY FOR DIR. REQUIRED VARIABLES: WVTAB,WVLINL.
N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" S DIR("?",I)=T_$P(X,";;",2)
S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVMSTL 3595 printed Nov 22, 2024@17:57:08 Page 2
WVMSTL ;HCIOFO/FT-List WH Sexual Trauma Data ;3/27/01 11:12
+1 ;;1.0;WOMEN'S HEALTH;**11,14**;Sep 30, 1998
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #2716 - $$GETSTAT^DGMSTAPI (supported)
+5 ;
BEGIN ;EP
+1 SET WVE=""
SET (WVMGR,WVPOP)=0
+2 DO CMGR
if WVPOP
GOTO EXIT
+3 DO DEVICE
if WVPOP
GOTO EXIT
+4 DO START
EXIT ; Exit and clean up
+1 KILL ^TMP($JOB)
+2 DO ^%ZISC
+3 KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT
+4 KILL WVCRT,WVCST,WVDATE,WVDFN,WVDG,WVDGMST,WVDGMSTC,WVE,WVEC,WVLINE,WVLINL,WVMGR,WVMGRN,WVMGRO,WVMSTN,WVNAME
+5 KILL WVNODE,WVPAGE,WVPOP,WVPROV,WVSORT,WVSSN,WVST,WVSV,WVTAB,WVTITLE,WVUSER,WVVET,WVZSTOP
+6 KILL X,Y,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE
+7 QUIT
CMGR ;EP
+1 ;---> SELECT ONE CASE MANAGER OR ALL.
+2 WRITE !!?3,"Show data for all patients for ONE particular Case Manager,"
+3 WRITE !?3,"or all patients for ALL Case Managers?"
+4 NEW DIR,DIRUT,Y
+5 SET DIR("A")=" Select ONE or ALL: "
SET DIR("B")="ONE"
SET WVMGR=""
+6 SET DIR(0)="SAM^o:ONE;a:ALL"
DO HELP1^WVMSTL
+7 DO ^DIR
KILL DIR
+8 IF Y=-1!($DATA(DIRUT))
SET WVPOP=1
QUIT
+9 ;---> IF ALL CASE MANAGERS, S WVE=1 AND QUIT.
+10 IF Y="a"
SET WVE=1
QUIT
+11 DO DIC^WVFMAN(790.01,"QEMA",.Y," Select CASE MANAGER: ")
+12 IF Y<0
SET WVPOP=1
QUIT
+13 ;---> FOR ONE CASE MANAGER, SET WVE=0 AND WVMGR=^VA(200 DFN, QUIT.
+14 SET WVMGR=+Y
SET WVE=0
+15 QUIT
DEVICE ;EP
+1 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
+2 SET ZTRTN="DEQUEUE^WVMSTL"
+3 SET ZTDESC="List Sexual Trauma Data"
+4 FOR WVSV="E","MGR"
Begin DoDot:1
+5 IF $DATA(@("WV"_WVSV))
SET ZTSAVE("WV"_WVSV)=""
End DoDot:1
+6 DO ZIS^WVUTL2(.WVPOP,1,"HOME")
+7 QUIT
START ; Start data gathering
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL ^TMP($JOB)
+3 if $GET(WVE)=""
QUIT
+4 SET (WVDFN,WVZSTOP)=0
+5 ; all case managers
+6 IF WVE=1
FOR
SET WVDFN=$ORDER(^WV(790,WVDFN))
if 'WVDFN!($GET(ZTSTOP)=1)
QUIT
DO SET
+7 ; one case manager
+8 IF WVE=0
IF WVMGR
FOR
SET WVDFN=$ORDER(^WV(790,"C",WVMGR,WVDFN))
if 'WVDFN!($GET(ZTSTOP)=1)
QUIT
DO SET
+9 if $GET(ZTSTOP)=1
QUIT
+10 DO PRINT^WVMSTL1
+11 QUIT
SET ; Set temp global
+1 SET WVZSTOP=WVZSTOP+1
+2 ; if a background task, check if user requested to stop the task
+3 IF $DATA(ZTQUEUED)
IF WVZSTOP#100=0
DO STOPCHK^WVUTL10(0)
if $GET(ZTSTOP)=1
QUIT
+4 ;deceased
if $$DECEASED^WVUTL1(WVDFN)
QUIT
+5 SET WVNODE=$GET(^WV(790,WVDFN,0))
if WVNODE=""
QUIT
+6 ;inactive date before today
IF $PIECE(WVNODE,U,24)>0
IF $PIECE(WVNODE,U,24)<DT
QUIT
+7 ;veterans status
SET WVVET=$$VET^WVUTL1A(WVDFN)
+8 ;primary eligibility code
SET WVEC=$$ELIG^WVUTL9(WVDFN)
SET WVEC=$PIECE(WVEC,U,2)
+9 ;primary provider
SET WVPROV=$$PROVI^WVUTL1A(WVDFN)
+10 ;case manager ien
SET WVMGR=$PIECE(WVNODE,U,10)
+11 SET WVDGMST="<N/A Not a Veteran>"
+12 SET WVDGMSTC=""
+13 IF $EXTRACT(WVVET)="Y"
Begin DoDot:1
+14 ; $$GETSTAT^DGMSTAPI supported API - IA #2716
+15 ;get MST value from Registration
SET WVDGMST=$$GETSTAT^DGMSTAPI(WVDFN)
+16 ;mst status code
SET WVDGMSTC=$PIECE(WVDGMST,U,2)
+17 ;mst status text
SET WVDGMST=$PIECE(WVDGMST,U,6)
+18 if WVDGMST=""
SET WVDGMST="Unknown, not screened"
+19 QUIT
End DoDot:1
+20 SET WVMSTN=$SELECT(WVDGMSTC="Y":1,WVDGMSTC="N":2,WVDGMSTC="D":3,WVDGMSTC="U":4,1:5)
+21 ;case manager name
SET WVMGRN=$$PERSON^WVUTL1(WVMGR)
+22 ;patient name
SET WVNAME=$$NAME^WVUTL1(WVDFN)
+23 ;patient ssn
SET WVSSN=$$SSN^WVUTL1(WVDFN)
+24 ;Civilian Sexual Trauma
SET WVCST=$$CST^WVUTL1A(WVDFN)
+25 if WVCST=""
SET WVCST="<no value>"
+26 if '$DATA(WVDG(WVMSTN))
SET WVDG(WVMSTN)=WVDGMST
+27 SET ^TMP($JOB,"WVST",WVMGRN,WVMGR,WVMSTN,WVNAME,WVDFN)=WVSSN_U_WVPROV_U_WVVET_U_WVEC_U_WVCST_U_WVDGMST
+28 QUIT
DEQUEUE ; WVE and WVMGR variables must be set.
+1 DO START
DO EXIT
+2 QUIT
HELP1 ;EP
+1 ;;Answer "ONE" to list patients for ONE particular Case Manager.
+2 ;;Answer "ALL" to list patients for ALL Case Managers.
+3 SET WVTAB=5
SET WVLINL="HELP1"
DO HELPTX
+4 QUIT
HELPTX ;EP
+1 ;---> CREATES DIR ARRAY FOR DIR. REQUIRED VARIABLES: WVTAB,WVLINL.
+2 NEW I,T,X
SET T=$$REPEAT^XLFSTR(" ",WVTAB)
+3 FOR I=1:1
SET X=$TEXT(@WVLINL+I)
if X'[";;"
QUIT
SET DIR("?",I)=T_$PIECE(X,";;",2)
+4 SET DIR("?")=DIR("?",I-1)
KILL DIR("?",I-1)
+5 QUIT
