WVMSTL1 ;HCIOFO/FT-List Sexual Trauma Data (cont.) ;2/16/01 16:07
;;1.0;WOMEN'S HEALTH;**11,14**;Sep 30, 1998
;
PRINT ; Print list
U IO
S WVLINE=$$REPEAT^XLFSTR("-",79),(WVPAGE,WVPOP)=0
S WVDATE=$$FMTE^XLFDT($$NOW^XLFDT(),"2")
S WVUSER=$$PERSON^WVUTL1(DUZ),WVSORT=$S(WVE=0:"ONE",1:"ALL")
S WVTITLE="* LIST SEXUAL TRAUMA DATA *"
S WVCRT=$S($E(IOST)="C":1,1:0)
S WVTAB=$L(WVTITLE),WVTAB=(80-WVTAB)\2
I '$D(^TMP($J,"WVST")) D HDR Q:WVPOP D NODATA
I $D(^TMP($J,"WVST")) D HDR Q:WVPOP D DATA
I WVCRT&('$D(IO("S"))) D:'WVPOP DIRZ^WVUTL3 W @IOF
Q
HDR ; Report header
W:$Y>0 @IOF
S WVPAGE=WVPAGE+1
W !,?WVTAB,WVTITLE
W !,"Report Run by: "_WVUSER,?50," Page: "_WVPAGE
W !,"Case Mgr Sort: "_WVSORT,?50,"Run Date: "_WVDATE
W !!,"SSN",?14,"PATIENT",?41,"MST & CST VALUES"
W !,WVLINE
I $D(ZTQUEUED) D STOPCHK^WVUTL10(1) D ;stop background task?
.S:$G(ZTSTOP)=1 WVPOP=1
.Q
Q
NODATA ; no wh patient data found
W !,"<No patient data was found.>",!
Q
DATA ; Loop through TMP global
S (WVMGRN,WVMGRO)=""
F S WVMGRN=$O(^TMP($J,"WVST",WVMGRN)) Q:WVMGRN=""!(WVPOP) S WVMGR=0 F S WVMGR=$O(^TMP($J,"WVST",WVMGRN,WVMGR)) Q:'WVMGR!(WVPOP) D
.I WVMGRN'=WVMGRO D
..W:WVMGRO="" !! ;first cm
..W:WVMGRO]"" !!! ;subsequent cms
..W "CASE MGR: "_WVMGRN
..S WVMGRO=WVMGRN ;identify cm
..Q
.S WVMSTN=0
.F S WVMSTN=$O(^TMP($J,"WVST",WVMGRN,WVMGR,WVMSTN)) Q:'WVMSTN D
..S WVNAME=""
..F S WVNAME=$O(^TMP($J,"WVST",WVMGRN,WVMGR,WVMSTN,WVNAME)) Q:WVNAME=""!(WVPOP) S WVDFN=0 F S WVDFN=$O(^TMP($J,"WVST",WVMGRN,WVMGR,WVMSTN,WVNAME,WVDFN)) Q:'WVDFN!(WVPOP) D
...I ($Y+6)>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D HDR Q:WVPOP
...S WVNODE=^TMP($J,"WVST",WVMGRN,WVMGR,WVMSTN,WVNAME,WVDFN)
...S WVSSN=$P(WVNODE,U,1),WVPROV=$P(WVNODE,U,2),WVVET=$P(WVNODE,U,3)
...S WVEC=$P(WVNODE,U,4),WVCST=$P(WVNODE,U,5),WVDGMST=$P(WVNODE,U,6)
...W !!,WVSSN,?14,WVNAME,?41,"MST= "_WVDGMST
...W !,"Pr. Provider => "_WVPROV,?41,"CST= "_WVCST
...W !,"Age: "_$$AGE^WVUTL9(WVDFN)_" / Veteran: "_WVVET_" / Eligibility: "_WVEC
...Q
..Q
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVMSTL1 2087 printed Apr 09, 2024@21:50:16 Page 2
WVMSTL1 ;HCIOFO/FT-List Sexual Trauma Data (cont.) ;2/16/01 16:07
+1 ;;1.0;WOMEN'S HEALTH;**11,14**;Sep 30, 1998
+2 ;
PRINT ; Print list
+1 USE IO
+2 SET WVLINE=$$REPEAT^XLFSTR("-",79)
SET (WVPAGE,WVPOP)=0
+3 SET WVDATE=$$FMTE^XLFDT($$NOW^XLFDT(),"2")
+4 SET WVUSER=$$PERSON^WVUTL1(DUZ)
SET WVSORT=$SELECT(WVE=0:"ONE",1:"ALL")
+5 SET WVTITLE="* LIST SEXUAL TRAUMA DATA *"
+6 SET WVCRT=$SELECT($EXTRACT(IOST)="C":1,1:0)
+7 SET WVTAB=$LENGTH(WVTITLE)
SET WVTAB=(80-WVTAB)\2
+8 IF '$DATA(^TMP($JOB,"WVST"))
DO HDR
if WVPOP
QUIT
DO NODATA
+9 IF $DATA(^TMP($JOB,"WVST"))
DO HDR
if WVPOP
QUIT
DO DATA
+10 IF WVCRT&('$DATA(IO("S")))
if 'WVPOP
DO DIRZ^WVUTL3
WRITE @IOF
+11 QUIT
HDR ; Report header
+1 if $Y>0
WRITE @IOF
+2 SET WVPAGE=WVPAGE+1
+3 WRITE !,?WVTAB,WVTITLE
+4 WRITE !,"Report Run by: "_WVUSER,?50," Page: "_WVPAGE
+5 WRITE !,"Case Mgr Sort: "_WVSORT,?50,"Run Date: "_WVDATE
+6 WRITE !!,"SSN",?14,"PATIENT",?41,"MST & CST VALUES"
+7 WRITE !,WVLINE
+8 ;stop background task?
IF $DATA(ZTQUEUED)
DO STOPCHK^WVUTL10(1)
Begin DoDot:1
+9 if $GET(ZTSTOP)=1
SET WVPOP=1
+10 QUIT
End DoDot:1
+11 QUIT
NODATA ; no wh patient data found
+1 WRITE !,"<No patient data was found.>",!
+2 QUIT
DATA ; Loop through TMP global
+1 SET (WVMGRN,WVMGRO)=""
+2 FOR
SET WVMGRN=$ORDER(^TMP($JOB,"WVST",WVMGRN))
if WVMGRN=""!(WVPOP)
QUIT
SET WVMGR=0
FOR
SET WVMGR=$ORDER(^TMP($JOB,"WVST",WVMGRN,WVMGR))
if 'WVMGR!(WVPOP)
QUIT
Begin DoDot:1
+3 IF WVMGRN'=WVMGRO
Begin DoDot:2
+4 ;first cm
if WVMGRO=""
WRITE !!
+5 ;subsequent cms
if WVMGRO]""
WRITE !!!
+6 WRITE "CASE MGR: "_WVMGRN
+7 ;identify cm
SET WVMGRO=WVMGRN
+8 QUIT
End DoDot:2
+9 SET WVMSTN=0
+10 FOR
SET WVMSTN=$ORDER(^TMP($JOB,"WVST",WVMGRN,WVMGR,WVMSTN))
if 'WVMSTN
QUIT
Begin DoDot:2
+11 SET WVNAME=""
+12 FOR
SET WVNAME=$ORDER(^TMP($JOB,"WVST",WVMGRN,WVMGR,WVMSTN,WVNAME))
if WVNAME=""!(WVPOP)
QUIT
SET WVDFN=0
FOR
SET WVDFN=$ORDER(^TMP($JOB,"WVST",WVMGRN,WVMGR,WVMSTN,WVNAME,WVDFN))
if 'WVDFN!(WVPOP)
QUIT
Begin DoDot:3
+13 IF ($Y+6)>IOSL
if WVCRT
DO DIRZ^WVUTL3
if WVPOP
QUIT
DO HDR
if WVPOP
QUIT
+14 SET WVNODE=^TMP($JOB,"WVST",WVMGRN,WVMGR,WVMSTN,WVNAME,WVDFN)
+15 SET WVSSN=$PIECE(WVNODE,U,1)
SET WVPROV=$PIECE(WVNODE,U,2)
SET WVVET=$PIECE(WVNODE,U,3)
+16 SET WVEC=$PIECE(WVNODE,U,4)
SET WVCST=$PIECE(WVNODE,U,5)
SET WVDGMST=$PIECE(WVNODE,U,6)
+17 WRITE !!,WVSSN,?14,WVNAME,?41,"MST= "_WVDGMST
+18 WRITE !,"Pr. Provider => "_WVPROV,?41,"CST= "_WVCST
+19 WRITE !,"Age: "_$$AGE^WVUTL9(WVDFN)_" / Veteran: "_WVVET_" / Eligibility: "_WVEC
+20 QUIT
End DoDot:3
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 QUIT
