source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WVRPST.m@ 1384

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1WVRPST ;HCIOFO/JR,FT-Sexual Trauma Summary ;4/11/01 09:16
2 ;;1.0;WOMEN'S HEALTH;**7,14**;Sep 30, 1998
3 ;
4 ; This routine uses the following IAs:
5 ; #2716 - $$GETSTAT^DGMSTAPI (supported)
6 ; #10035 - ^DPT(DFN,.351 (supported)
7 ;
8 ; EP for List Sexual Trauma Data [WV SEXUAL TRAUMA LIST] option
9 W @IOF,!?33,"WOMEN'S HEALTH"
10 W !?19,"* * * SEXUAL TRAUMA SUMMARY REPORT * * *",!
11 S WVE="",(WVMGR,WVPOP)=0
12 D CMGR^WVMSTL ;select one or all case mgrs to sort by
13 I WVPOP D EXIT Q
14 K IO("Q") S %ZIS="Q" D ^%ZIS G EXIT:POP I $D(IO("Q")) D Q
15 .S ZTRTN="GET^WVRPST",ZTDESC="WH SEXUAL TRAUMA SUMMARY"
16 .S ZTSAVE("WVE")="",ZTSAVE("WVMGR")=""
17 .D ^%ZTLOAD D HOME^%ZIS K IO("Q")
18 .Q
19GET ; Get data for report
20 U IO
21 Q:WVE="" ;no case mgr selection
22 S (WVBOTH,WVDFN,WVCIVCNT,WVCNALL,WVETCNT,WVZSTOP)=0
23 S (WVCSTV("Y"),WVCSTV("N"),WVCSTV("D"),WVCSTV("U"))=0
24 S (WVCSTNV("Y"),WVCSTNV("N"),WVCSTNV("D"),WVCSTNV("U"))=0
25 S (WVMSTV("Y"),WVMSTV("N"),WVMSTV("D"),WVMSTV("U"))=0
26 S WVLINE=$$REPEAT^XLFSTR("-",76)
27 S WVDASH=$$REPEAT^XLFSTR("=",80)
28 F S WVDFN=$O(^WV(790,WVDFN)) Q:WVDFN'>0!($G(ZSTOP)=1) S WV0=$G(^(WVDFN,0)) D
29 .S WVZSTOP=WVZSTOP+1
30 .;If background task, then every 100 records check if user wants to
31 .;stop the task.
32 .I $D(ZTQUEUED),WVZSTOP#100=0 D STOPCHK^WVUTL10(0) Q:$G(ZTSTOP)=1
33 .I '$$NOT(WVDFN) Q ;active patient in WH package?
34 .I WVE=0,WVMGR'=$P(WV0,U,10) Q ;not the case mgr selected by user
35 .S WVCST=$P(WV0,U,28) ;CST value
36 .S WVMST=$P($$GETSTAT^DGMSTAPI(WVDFN),U,2) ;get MST status
37 .S WVCNALL=WVCNALL+1 ;count of active patients in WH
38 .S WVET=$E($$VET^WVUTL1A(WVDFN)) ;check veteran status
39 .S:WVET="Y" WVETCNT=WVETCNT+1 ;count of veterans
40 .S:WVET'="Y" WVCIVCNT=WVCIVCNT+1 ;count of non-veterans
41 .I WVET="Y" D ;CST count for veterans
42 ..I WVCST="Y" S WVCSTV("Y")=WVCSTV("Y")+1 Q
43 ..I WVCST="N" S WVCSTV("N")=WVCSTV("N")+1 Q
44 ..I WVCST="D" S WVCSTV("D")=WVCSTV("D")+1 Q
45 ..S WVCSTV("U")=WVCSTV("U")+1
46 ..Q
47 .I WVET'="Y" D ;CST count for non-veterans
48 ..I WVCST="Y" S WVCSTNV("Y")=WVCSTNV("Y")+1 Q
49 ..I WVCST="N" S WVCSTNV("N")=WVCSTNV("N")+1 Q
50 ..I WVCST="D" S WVCSTNV("D")=WVCSTNV("D")+1 Q
51 ..S WVCSTNV("U")=WVCSTNV("U")+1
52 ..Q
53 .I WVET="Y" D ;MST count - applies to veterans only
54 ..I WVMST="Y" S WVMSTV("Y")=WVMSTV("Y")+1 S:WVCST="Y" WVBOTH=WVBOTH+1 Q
55 ..I WVMST="N" S WVMSTV("N")=WVMSTV("N")+1 Q
56 ..I WVMST="D" S WVMSTV("D")=WVMSTV("D")+1 Q
57 ..S WVMSTV("U")=WVMSTV("U")+1
58 ..Q
59 .Q
60 I $G(ZTSTOP)=1 D EXIT Q
61 D PRINT
62EXIT ;
63 D ^%ZISC
64 K WV0,WVBOTH,WVCIVCNT,WVCNALL,WVCRT,WVCST,WVCSTNV,WVCSTV,WVDASH,WVDFN
65 K WVE,WVET,WVETCNT,WVJRNOW,WVLINE,WVLINL,WVMGR,WVMST,WVMSTV,WVPOP,WVTAB,WVZSTOP
66 K POP,X,Y
67 Q
68PRINT ; Print counts
69 S WVCRT=$S($E(IOST)="C":1,1:0)
70 D HEAD
71 W !,"MST",?18,"YES",?29,"NO",?35,"DECLINED",?45,"UNKNOWN"
72 W !,WVLINE
73 W !,"VETERANS",?15,$J(WVMSTV("Y"),6),?25,$J(WVMSTV("N"),6),?35,$J(WVMSTV("D"),6),?45,$J(WVMSTV("U"),6)
74 W !!,WVDASH
75 W !!,"CST",?18,"YES",?29,"NO",?35,"DECLINED",?45,"UNKNOWN"
76 W !,WVLINE
77 W !,"VETERANS",?15,$J(WVCSTV("Y"),6),?25,$J(WVCSTV("N"),6),?35,$J(WVCSTV("D"),6),?45,$J(WVCSTV("U"),6)
78 W !,"NON-VETS",?15,$J(WVCSTNV("Y"),6),?25,$J(WVCSTNV("N"),6),?35,$J(WVCSTNV("D"),6),?45,$J(WVCSTNV("U"),6)
79 W !,WVDASH
80 W !?5,"# OF PATIENTS ---------------->",$J(WVCNALL,5)
81 W !?5,"# WHO ARE VETERANS ----------->",$J(WVETCNT,5)
82 W !?5,"# WHO ARE NON-VETERANS ------->",$J(WVCIVCNT,5)
83 W !?5,"# WITH MST & CST ------------->",$J(WVBOTH,5)
84 W !!?12,"Above numbers are based on Active Women's Health patients"
85 I WVE=1 W !?12,"for all case managers."
86 I WVE=0 W !?12,"for "_$$PERSON^WVUTL1(WVMGR)_"."
87 S WVPOP=0
88 I WVCRT&('$D(IO("S")))&('POP) D DIRZ^WVUTL3 W @IOF,!
89 Q
90HEAD ; Print the report header
91 W:$Y>0 @IOF
92 W !?26,"SEXUAL TRAUMA SUMMARY REPORT"
93 W !,$$RUNDT^WVUTL1A("C")
94 W !,WVDASH
95 Q
96NOT(WVDFN) ;Screen out patients for Inactive & Dead
97 N TEST
98 S TEST=$$GET1^DIQ(2,WVDFN,.351,"I")
99 Q:TEST>0 0
100 S TEST=$P($G(^WV(790,WVDFN,0)),U,24)
101 Q:TEST>0 0
102 Q 1
Note: See TracBrowser for help on using the repository browser.