WVRPST ;HCIOFO/JR,FT-Sexual Trauma Summary ;4/11/01 09:16
;;1.0;WOMEN'S HEALTH;**7,14**;Sep 30, 1998
;
; This routine uses the following IAs:
; #2716 - $$GETSTAT^DGMSTAPI (supported)
; #10035 - ^DPT(DFN,.351 (supported)
;
; EP for List Sexual Trauma Data [WV SEXUAL TRAUMA LIST] option
W @IOF,!?33,"WOMEN'S HEALTH"
W !?19,"* * * SEXUAL TRAUMA SUMMARY REPORT * * *",!
S WVE="",(WVMGR,WVPOP)=0
D CMGR^WVMSTL ;select one or all case mgrs to sort by
I WVPOP D EXIT Q
K IO("Q") S %ZIS="Q" D ^%ZIS G EXIT:POP I $D(IO("Q")) D Q
.S ZTRTN="GET^WVRPST",ZTDESC="WH SEXUAL TRAUMA SUMMARY"
.S ZTSAVE("WVE")="",ZTSAVE("WVMGR")=""
.D ^%ZTLOAD D HOME^%ZIS K IO("Q")
.Q
GET ; Get data for report
U IO
Q:WVE="" ;no case mgr selection
S (WVBOTH,WVDFN,WVCIVCNT,WVCNALL,WVETCNT,WVZSTOP)=0
S (WVCSTV("Y"),WVCSTV("N"),WVCSTV("D"),WVCSTV("U"))=0
S (WVCSTNV("Y"),WVCSTNV("N"),WVCSTNV("D"),WVCSTNV("U"))=0
S (WVMSTV("Y"),WVMSTV("N"),WVMSTV("D"),WVMSTV("U"))=0
S WVLINE=$$REPEAT^XLFSTR("-",76)
S WVDASH=$$REPEAT^XLFSTR("=",80)
F S WVDFN=$O(^WV(790,WVDFN)) Q:WVDFN'>0!($G(ZSTOP)=1) S WV0=$G(^(WVDFN,0)) D
.S WVZSTOP=WVZSTOP+1
.;If background task, then every 100 records check if user wants to
.;stop the task.
.I $D(ZTQUEUED),WVZSTOP#100=0 D STOPCHK^WVUTL10(0) Q:$G(ZTSTOP)=1
.I '$$NOT(WVDFN) Q ;active patient in WH package?
.I WVE=0,WVMGR'=$P(WV0,U,10) Q ;not the case mgr selected by user
.S WVCST=$P(WV0,U,28) ;CST value
.S WVMST=$P($$GETSTAT^DGMSTAPI(WVDFN),U,2) ;get MST status
.S WVCNALL=WVCNALL+1 ;count of active patients in WH
.S WVET=$E($$VET^WVUTL1A(WVDFN)) ;check veteran status
.S:WVET="Y" WVETCNT=WVETCNT+1 ;count of veterans
.S:WVET'="Y" WVCIVCNT=WVCIVCNT+1 ;count of non-veterans
.I WVET="Y" D ;CST count for veterans
..I WVCST="Y" S WVCSTV("Y")=WVCSTV("Y")+1 Q
..I WVCST="N" S WVCSTV("N")=WVCSTV("N")+1 Q
..I WVCST="D" S WVCSTV("D")=WVCSTV("D")+1 Q
..S WVCSTV("U")=WVCSTV("U")+1
..Q
.I WVET'="Y" D ;CST count for non-veterans
..I WVCST="Y" S WVCSTNV("Y")=WVCSTNV("Y")+1 Q
..I WVCST="N" S WVCSTNV("N")=WVCSTNV("N")+1 Q
..I WVCST="D" S WVCSTNV("D")=WVCSTNV("D")+1 Q
..S WVCSTNV("U")=WVCSTNV("U")+1
..Q
.I WVET="Y" D ;MST count - applies to veterans only
..I WVMST="Y" S WVMSTV("Y")=WVMSTV("Y")+1 S:WVCST="Y" WVBOTH=WVBOTH+1 Q
..I WVMST="N" S WVMSTV("N")=WVMSTV("N")+1 Q
..I WVMST="D" S WVMSTV("D")=WVMSTV("D")+1 Q
..S WVMSTV("U")=WVMSTV("U")+1
..Q
.Q
I $G(ZTSTOP)=1 D EXIT Q
D PRINT
EXIT ;
D ^%ZISC
K WV0,WVBOTH,WVCIVCNT,WVCNALL,WVCRT,WVCST,WVCSTNV,WVCSTV,WVDASH,WVDFN
K WVE,WVET,WVETCNT,WVJRNOW,WVLINE,WVLINL,WVMGR,WVMST,WVMSTV,WVPOP,WVTAB,WVZSTOP
K POP,X,Y
Q
PRINT ; Print counts
S WVCRT=$S($E(IOST)="C":1,1:0)
D HEAD
W !,"MST",?18,"YES",?29,"NO",?35,"DECLINED",?45,"UNKNOWN"
W !,WVLINE
W !,"VETERANS",?15,$J(WVMSTV("Y"),6),?25,$J(WVMSTV("N"),6),?35,$J(WVMSTV("D"),6),?45,$J(WVMSTV("U"),6)
W !!,WVDASH
W !!,"CST",?18,"YES",?29,"NO",?35,"DECLINED",?45,"UNKNOWN"
W !,WVLINE
W !,"VETERANS",?15,$J(WVCSTV("Y"),6),?25,$J(WVCSTV("N"),6),?35,$J(WVCSTV("D"),6),?45,$J(WVCSTV("U"),6)
W !,"NON-VETS",?15,$J(WVCSTNV("Y"),6),?25,$J(WVCSTNV("N"),6),?35,$J(WVCSTNV("D"),6),?45,$J(WVCSTNV("U"),6)
W !,WVDASH
W !?5,"# OF PATIENTS ---------------->",$J(WVCNALL,5)
W !?5,"# WHO ARE VETERANS ----------->",$J(WVETCNT,5)
W !?5,"# WHO ARE NON-VETERANS ------->",$J(WVCIVCNT,5)
W !?5,"# WITH MST & CST ------------->",$J(WVBOTH,5)
W !!?12,"Above numbers are based on Active Women's Health patients"
I WVE=1 W !?12,"for all case managers."
I WVE=0 W !?12,"for "_$$PERSON^WVUTL1(WVMGR)_"."
S WVPOP=0
I WVCRT&('$D(IO("S")))&('POP) D DIRZ^WVUTL3 W @IOF,!
Q
HEAD ; Print the report header
W:$Y>0 @IOF
W !?26,"SEXUAL TRAUMA SUMMARY REPORT"
W !,$$RUNDT^WVUTL1A("C")
W !,WVDASH
Q
NOT(WVDFN) ;Screen out patients for Inactive & Dead
N TEST
S TEST=$$GET1^DIQ(2,WVDFN,.351,"I")
Q:TEST>0 0
S TEST=$P($G(^WV(790,WVDFN,0)),U,24)
Q:TEST>0 0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVRPST 4017 printed Nov 22, 2024@17:57:52 Page 2
WVRPST ;HCIOFO/JR,FT-Sexual Trauma Summary ;4/11/01 09:16
+1 ;;1.0;WOMEN'S HEALTH;**7,14**;Sep 30, 1998
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #2716 - $$GETSTAT^DGMSTAPI (supported)
+5 ; #10035 - ^DPT(DFN,.351 (supported)
+6 ;
+7 ; EP for List Sexual Trauma Data [WV SEXUAL TRAUMA LIST] option
+8 WRITE @IOF,!?33,"WOMEN'S HEALTH"
+9 WRITE !?19,"* * * SEXUAL TRAUMA SUMMARY REPORT * * *",!
+10 SET WVE=""
SET (WVMGR,WVPOP)=0
+11 ;select one or all case mgrs to sort by
DO CMGR^WVMSTL
+12 IF WVPOP
DO EXIT
QUIT
+13 KILL IO("Q")
SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
IF $DATA(IO("Q"))
Begin DoDot:1
+14 SET ZTRTN="GET^WVRPST"
SET ZTDESC="WH SEXUAL TRAUMA SUMMARY"
+15 SET ZTSAVE("WVE")=""
SET ZTSAVE("WVMGR")=""
+16 DO ^%ZTLOAD
DO HOME^%ZIS
KILL IO("Q")
+17 QUIT
End DoDot:1
QUIT
GET ; Get data for report
+1 USE IO
+2 ;no case mgr selection
if WVE=""
QUIT
+3 SET (WVBOTH,WVDFN,WVCIVCNT,WVCNALL,WVETCNT,WVZSTOP)=0
+4 SET (WVCSTV("Y"),WVCSTV("N"),WVCSTV("D"),WVCSTV("U"))=0
+5 SET (WVCSTNV("Y"),WVCSTNV("N"),WVCSTNV("D"),WVCSTNV("U"))=0
+6 SET (WVMSTV("Y"),WVMSTV("N"),WVMSTV("D"),WVMSTV("U"))=0
+7 SET WVLINE=$$REPEAT^XLFSTR("-",76)
+8 SET WVDASH=$$REPEAT^XLFSTR("=",80)
+9 FOR
SET WVDFN=$ORDER(^WV(790,WVDFN))
if WVDFN'>0!($GET(ZSTOP)=1)
QUIT
SET WV0=$GET(^(WVDFN,0))
Begin DoDot:1
+10 SET WVZSTOP=WVZSTOP+1
+11 ;If background task, then every 100 records check if user wants to
+12 ;stop the task.
+13 IF $DATA(ZTQUEUED)
IF WVZSTOP#100=0
DO STOPCHK^WVUTL10(0)
if $GET(ZTSTOP)=1
QUIT
+14 ;active patient in WH package?
IF '$$NOT(WVDFN)
QUIT
+15 ;not the case mgr selected by user
IF WVE=0
IF WVMGR'=$PIECE(WV0,U,10)
QUIT
+16 ;CST value
SET WVCST=$PIECE(WV0,U,28)
+17 ;get MST status
SET WVMST=$PIECE($$GETSTAT^DGMSTAPI(WVDFN),U,2)
+18 ;count of active patients in WH
SET WVCNALL=WVCNALL+1
+19 ;check veteran status
SET WVET=$EXTRACT($$VET^WVUTL1A(WVDFN))
+20 ;count of veterans
if WVET="Y"
SET WVETCNT=WVETCNT+1
+21 ;count of non-veterans
if WVET'="Y"
SET WVCIVCNT=WVCIVCNT+1
+22 ;CST count for veterans
IF WVET="Y"
Begin DoDot:2
+23 IF WVCST="Y"
SET WVCSTV("Y")=WVCSTV("Y")+1
QUIT
+24 IF WVCST="N"
SET WVCSTV("N")=WVCSTV("N")+1
QUIT
+25 IF WVCST="D"
SET WVCSTV("D")=WVCSTV("D")+1
QUIT
+26 SET WVCSTV("U")=WVCSTV("U")+1
+27 QUIT
End DoDot:2
+28 ;CST count for non-veterans
IF WVET'="Y"
Begin DoDot:2
+29 IF WVCST="Y"
SET WVCSTNV("Y")=WVCSTNV("Y")+1
QUIT
+30 IF WVCST="N"
SET WVCSTNV("N")=WVCSTNV("N")+1
QUIT
+31 IF WVCST="D"
SET WVCSTNV("D")=WVCSTNV("D")+1
QUIT
+32 SET WVCSTNV("U")=WVCSTNV("U")+1
+33 QUIT
End DoDot:2
+34 ;MST count - applies to veterans only
IF WVET="Y"
Begin DoDot:2
+35 IF WVMST="Y"
SET WVMSTV("Y")=WVMSTV("Y")+1
if WVCST="Y"
SET WVBOTH=WVBOTH+1
QUIT
+36 IF WVMST="N"
SET WVMSTV("N")=WVMSTV("N")+1
QUIT
+37 IF WVMST="D"
SET WVMSTV("D")=WVMSTV("D")+1
QUIT
+38 SET WVMSTV("U")=WVMSTV("U")+1
+39 QUIT
End DoDot:2
+40 QUIT
End DoDot:1
+41 IF $GET(ZTSTOP)=1
DO EXIT
QUIT
+42 DO PRINT
EXIT ;
+1 DO ^%ZISC
+2 KILL WV0,WVBOTH,WVCIVCNT,WVCNALL,WVCRT,WVCST,WVCSTNV,WVCSTV,WVDASH,WVDFN
+3 KILL WVE,WVET,WVETCNT,WVJRNOW,WVLINE,WVLINL,WVMGR,WVMST,WVMSTV,WVPOP,WVTAB,WVZSTOP
+4 KILL POP,X,Y
+5 QUIT
PRINT ; Print counts
+1 SET WVCRT=$SELECT($EXTRACT(IOST)="C":1,1:0)
+2 DO HEAD
+3 WRITE !,"MST",?18,"YES",?29,"NO",?35,"DECLINED",?45,"UNKNOWN"
+4 WRITE !,WVLINE
+5 WRITE !,"VETERANS",?15,$JUSTIFY(WVMSTV("Y"),6),?25,$JUSTIFY(WVMSTV("N"),6),?35,$JUSTIFY(WVMSTV("D"),6),?45,$JUSTIFY(WVMSTV("U"),6)
+6 WRITE !!,WVDASH
+7 WRITE !!,"CST",?18,"YES",?29,"NO",?35,"DECLINED",?45,"UNKNOWN"
+8 WRITE !,WVLINE
+9 WRITE !,"VETERANS",?15,$JUSTIFY(WVCSTV("Y"),6),?25,$JUSTIFY(WVCSTV("N"),6),?35,$JUSTIFY(WVCSTV("D"),6),?45,$JUSTIFY(WVCSTV("U"),6)
+10 WRITE !,"NON-VETS",?15,$JUSTIFY(WVCSTNV("Y"),6),?25,$JUSTIFY(WVCSTNV("N"),6),?35,$JUSTIFY(WVCSTNV("D"),6),?45,$JUSTIFY(WVCSTNV("U"),6)
+11 WRITE !,WVDASH
+12 WRITE !?5,"# OF PATIENTS ---------------->",$JUSTIFY(WVCNALL,5)
+13 WRITE !?5,"# WHO ARE VETERANS ----------->",$JUSTIFY(WVETCNT,5)
+14 WRITE !?5,"# WHO ARE NON-VETERANS ------->",$JUSTIFY(WVCIVCNT,5)
+15 WRITE !?5,"# WITH MST & CST ------------->",$JUSTIFY(WVBOTH,5)
+16 WRITE !!?12,"Above numbers are based on Active Women's Health patients"
+17 IF WVE=1
WRITE !?12,"for all case managers."
+18 IF WVE=0
WRITE !?12,"for "_$$PERSON^WVUTL1(WVMGR)_"."
+19 SET WVPOP=0
+20 IF WVCRT&('$DATA(IO("S")))&('POP)
DO DIRZ^WVUTL3
WRITE @IOF,!
+21 QUIT
HEAD ; Print the report header
+1 if $Y>0
WRITE @IOF
+2 WRITE !?26,"SEXUAL TRAUMA SUMMARY REPORT"
+3 WRITE !,$$RUNDT^WVUTL1A("C")
+4 WRITE !,WVDASH
+5 QUIT
NOT(WVDFN) ;Screen out patients for Inactive & Dead
+1 NEW TEST
+2 SET TEST=$$GET1^DIQ(2,WVDFN,.351,"I")
+3 if TEST>0
QUIT 0
+4 SET TEST=$PIECE($GET(^WV(790,WVDFN,0)),U,24)
+5 if TEST>0
QUIT 0
+6 QUIT 1
