WVRPST.m

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 ---WVRPST   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