- 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 Feb 19, 2025@00:13:45 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