- 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 Mar 13, 2025@21:52:59 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