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

WVMSTL1.m

Go to the documentation of this file.
  1. WVMSTL1 ;HCIOFO/FT-List Sexual Trauma Data (cont.) ;2/16/01 16:07
  1. ;;1.0;WOMEN'S HEALTH;**11,14**;Sep 30, 1998
  1. ;
  1. PRINT ; Print list
  1. U IO
  1. S WVLINE=$$REPEAT^XLFSTR("-",79),(WVPAGE,WVPOP)=0
  1. S WVDATE=$$FMTE^XLFDT($$NOW^XLFDT(),"2")
  1. S WVUSER=$$PERSON^WVUTL1(DUZ),WVSORT=$S(WVE=0:"ONE",1:"ALL")
  1. S WVTITLE="* LIST SEXUAL TRAUMA DATA *"
  1. S WVCRT=$S($E(IOST)="C":1,1:0)
  1. S WVTAB=$L(WVTITLE),WVTAB=(80-WVTAB)\2
  1. I '$D(^TMP($J,"WVST")) D HDR Q:WVPOP D NODATA
  1. I $D(^TMP($J,"WVST")) D HDR Q:WVPOP D DATA
  1. I WVCRT&('$D(IO("S"))) D:'WVPOP DIRZ^WVUTL3 W @IOF
  1. Q
  1. HDR ; Report header
  1. W:$Y>0 @IOF
  1. S WVPAGE=WVPAGE+1
  1. W !,?WVTAB,WVTITLE
  1. W !,"Report Run by: "_WVUSER,?50," Page: "_WVPAGE
  1. W !,"Case Mgr Sort: "_WVSORT,?50,"Run Date: "_WVDATE
  1. W !!,"SSN",?14,"PATIENT",?41,"MST & CST VALUES"
  1. W !,WVLINE
  1. I $D(ZTQUEUED) D STOPCHK^WVUTL10(1) D ;stop background task?
  1. .S:$G(ZTSTOP)=1 WVPOP=1
  1. .Q
  1. Q
  1. NODATA ; no wh patient data found
  1. W !,"<No patient data was found.>",!
  1. Q
  1. DATA ; Loop through TMP global
  1. S (WVMGRN,WVMGRO)=""
  1. 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
  1. .I WVMGRN'=WVMGRO D
  1. ..W:WVMGRO="" !! ;first cm
  1. ..W:WVMGRO]"" !!! ;subsequent cms
  1. ..W "CASE MGR: "_WVMGRN
  1. ..S WVMGRO=WVMGRN ;identify cm
  1. ..Q
  1. .S WVMSTN=0
  1. .F S WVMSTN=$O(^TMP($J,"WVST",WVMGRN,WVMGR,WVMSTN)) Q:'WVMSTN D
  1. ..S WVNAME=""
  1. ..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
  1. ...I ($Y+6)>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D HDR Q:WVPOP
  1. ...S WVNODE=^TMP($J,"WVST",WVMGRN,WVMGR,WVMSTN,WVNAME,WVDFN)
  1. ...S WVSSN=$P(WVNODE,U,1),WVPROV=$P(WVNODE,U,2),WVVET=$P(WVNODE,U,3)
  1. ...S WVEC=$P(WVNODE,U,4),WVCST=$P(WVNODE,U,5),WVDGMST=$P(WVNODE,U,6)
  1. ...W !!,WVSSN,?14,WVNAME,?41,"MST= "_WVDGMST
  1. ...W !,"Pr. Provider => "_WVPROV,?41,"CST= "_WVCST
  1. ...W !,"Age: "_$$AGE^WVUTL9(WVDFN)_" / Veteran: "_WVVET_" / Eligibility: "_WVEC
  1. ...Q
  1. ..Q
  1. .Q
  1. Q