source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVMSTL.m@ 1361

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.4 KB
RevLine 
[613]1WVMSTL ;HCIOFO/FT-List WH Sexual Trauma Data ;3/27/01 11:12
2 ;;1.0;WOMEN'S HEALTH;**11,14**;Sep 30, 1998
3 ;
4 ; This routine uses the following IAs:
5 ; #2716 - $$GETSTAT^DGMSTAPI (supported)
6 ;
7BEGIN ;EP
8 S WVE="",(WVMGR,WVPOP)=0
9 D CMGR G:WVPOP EXIT
10 D DEVICE G:WVPOP EXIT
11 D START
12EXIT ; Exit and clean up
13 K ^TMP($J)
14 D ^%ZISC
15 K DIR,DIRUT,DIROUT,DTOUT,DUOUT
16 K WVCRT,WVCST,WVDATE,WVDFN,WVDG,WVDGMST,WVDGMSTC,WVE,WVEC,WVLINE,WVLINL,WVMGR,WVMGRN,WVMGRO,WVMSTN,WVNAME
17 K WVNODE,WVPAGE,WVPOP,WVPROV,WVSORT,WVSSN,WVST,WVSV,WVTAB,WVTITLE,WVUSER,WVVET,WVZSTOP
18 K X,Y,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE
19 Q
20CMGR ;EP
21 ;---> SELECT ONE CASE MANAGER OR ALL.
22 W !!?3,"Show data for all patients for ONE particular Case Manager,"
23 W !?3,"or all patients for ALL Case Managers?"
24 N DIR,DIRUT,Y
25 S DIR("A")=" Select ONE or ALL: ",DIR("B")="ONE",WVMGR=""
26 S DIR(0)="SAM^o:ONE;a:ALL" D HELP1^WVMSTL
27 D ^DIR K DIR
28 I Y=-1!($D(DIRUT)) S WVPOP=1 Q
29 ;---> IF ALL CASE MANAGERS, S WVE=1 AND QUIT.
30 I Y="a" S WVE=1 Q
31 D DIC^WVFMAN(790.01,"QEMA",.Y," Select CASE MANAGER: ")
32 I Y<0 S WVPOP=1 Q
33 ;---> FOR ONE CASE MANAGER, SET WVE=0 AND WVMGR=^VA(200 DFN, QUIT.
34 S WVMGR=+Y,WVE=0
35 Q
36DEVICE ;EP
37 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
38 S ZTRTN="DEQUEUE^WVMSTL"
39 S ZTDESC="List Sexual Trauma Data"
40 F WVSV="E","MGR" D
41 .I $D(@("WV"_WVSV)) S ZTSAVE("WV"_WVSV)=""
42 D ZIS^WVUTL2(.WVPOP,1,"HOME")
43 Q
44START ; Start data gathering
45 I $D(ZTQUEUED) S ZTREQ="@"
46 K ^TMP($J)
47 Q:$G(WVE)=""
48 S (WVDFN,WVZSTOP)=0
49 ; all case managers
50 I WVE=1 F S WVDFN=$O(^WV(790,WVDFN)) Q:'WVDFN!($G(ZTSTOP)=1) D SET
51 ; one case manager
52 I WVE=0,WVMGR F S WVDFN=$O(^WV(790,"C",WVMGR,WVDFN)) Q:'WVDFN!($G(ZTSTOP)=1) D SET
53 Q:$G(ZTSTOP)=1
54 D PRINT^WVMSTL1
55 Q
56SET ; Set temp global
57 S WVZSTOP=WVZSTOP+1
58 ; if a background task, check if user requested to stop the task
59 I $D(ZTQUEUED),WVZSTOP#100=0 D STOPCHK^WVUTL10(0) Q:$G(ZTSTOP)=1
60 Q:$$DECEASED^WVUTL1(WVDFN) ;deceased
61 S WVNODE=$G(^WV(790,WVDFN,0)) Q:WVNODE=""
62 I $P(WVNODE,U,24)>0,$P(WVNODE,U,24)<DT Q ;inactive date before today
63 S WVVET=$$VET^WVUTL1A(WVDFN) ;veterans status
64 S WVEC=$$ELIG^WVUTL9(WVDFN),WVEC=$P(WVEC,U,2) ;primary eligibility code
65 S WVPROV=$$PROVI^WVUTL1A(WVDFN) ;primary provider
66 S WVMGR=$P(WVNODE,U,10) ;case manager ien
67 S WVDGMST="<N/A Not a Veteran>"
68 S WVDGMSTC=""
69 I $E(WVVET)="Y" D
70 .; $$GETSTAT^DGMSTAPI supported API - IA #2716
71 .S WVDGMST=$$GETSTAT^DGMSTAPI(WVDFN) ;get MST value from Registration
72 .S WVDGMSTC=$P(WVDGMST,U,2) ;mst status code
73 .S WVDGMST=$P(WVDGMST,U,6) ;mst status text
74 .S:WVDGMST="" WVDGMST="Unknown, not screened"
75 .Q
76 S WVMSTN=$S(WVDGMSTC="Y":1,WVDGMSTC="N":2,WVDGMSTC="D":3,WVDGMSTC="U":4,1:5)
77 S WVMGRN=$$PERSON^WVUTL1(WVMGR) ;case manager name
78 S WVNAME=$$NAME^WVUTL1(WVDFN) ;patient name
79 S WVSSN=$$SSN^WVUTL1(WVDFN) ;patient ssn
80 S WVCST=$$CST^WVUTL1A(WVDFN) ;Civilian Sexual Trauma
81 S:WVCST="" WVCST="<no value>"
82 S:'$D(WVDG(WVMSTN)) WVDG(WVMSTN)=WVDGMST
83 S ^TMP($J,"WVST",WVMGRN,WVMGR,WVMSTN,WVNAME,WVDFN)=WVSSN_U_WVPROV_U_WVVET_U_WVEC_U_WVCST_U_WVDGMST
84 Q
85DEQUEUE ; WVE and WVMGR variables must be set.
86 D START,EXIT
87 Q
88HELP1 ;EP
89 ;;Answer "ONE" to list patients for ONE particular Case Manager.
90 ;;Answer "ALL" to list patients for ALL Case Managers.
91 S WVTAB=5,WVLINL="HELP1" D HELPTX
92 Q
93HELPTX ;EP
94 ;---> CREATES DIR ARRAY FOR DIR. REQUIRED VARIABLES: WVTAB,WVLINL.
95 N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
96 F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" S DIR("?",I)=T_$P(X,";;",2)
97 S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
98 Q
Note: See TracBrowser for help on using the repository browser.