Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: WVRPST

WVRPST.m

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