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

YSASRPWP.m

Go to the documentation of this file.
  1. YSASRPWP ;DALOI/YH- Report Calls ;5/11/2001
  1. ;;5.01;MENTAL HEALTH;**71**;Dec 30, 1994
  1. ASINAR(ROOT,YSASDA) ;YSRP ASI NARRATIVE
  1. D START(132,"QTEP^YSASNAR")
  1. Q
  1. ;
  1. ASIITM(ROOT,YSASDA) ;YSRP ASI ITEM
  1. D START(132,"QTEP^YSASPRT")
  1. Q
  1. ;
  1. START(RM,GOTO) ;
  1. ;RM=Right margin
  1. S:'$G(RM) RM=80
  1. N ZTQUEUED,YSHFS,YSSUB,YSIO
  1. K ^TMP("YSDATA",$J) S ROOT=$NA(^TMP("YSDATA",$J,1))
  1. S YSHFS=$$HFS(),YSSUB="YSDATA"
  1. D OPEN(.RM,.YSHFS,"W",.YSIO)
  1. D @GOTO
  1. D CLOSE(.YSRM,.YSHFS,.YSSUB,.YSIO)
  1. Q
  1. HFS() ; -- get hfs file name
  1. ; -- need to define better unique algorithm
  1. Q "YSU_"_$J_".DAT"
  1. ;
  1. OPEN(YSRM,YSHFS,YSMODE,YSIO) ; -- open WORKSTATION device
  1. ; YSRM: right margin
  1. ; YSHFS: host file name
  1. ; YSMODE: open file in 'R'ead or 'W'rite mode
  1. S ZTQUEUED="" K IOPAR
  1. S IOP="OR WORKSTATION;"_$G(YSRM,80)
  1. S %ZIS("HFSMODE")=YSMODE,%ZIS("HFSNAME")=YSHFS
  1. D ^%ZIS
  1. K IOP,%ZIS
  1. U IO
  1. S YSIO=IO
  1. Q
  1. ;
  1. CLOSE(YSRM,YSHFS,YSSUB,YSIO) ; -- close WORKSTATION device
  1. ; YSSUB: unique subscript name for output
  1. I IO=YSIO D ^%ZISC
  1. U IO
  1. D USEHFS
  1. U IO
  1. Q
  1. USEHFS ; -- use host file to build global array
  1. N IO,YSOK,SECTION
  1. S SECTION=0
  1. D INIT
  1. S YSOK=$$FTG^%ZISH(,YSHFS,$NA(@ROOT@(1)),4) I 'YSOK Q
  1. D STRIP
  1. N YSARR S YSARR(YSHFS)=""
  1. S YSOK=$$DEL^%ZISH("",$NA(YSARR))
  1. Q
  1. ;
  1. INIT ; -- initialize counts and global section
  1. S (INC,CNT)=0,SECTION=SECTION+1
  1. S ROOT=$NA(^TMP(YSSUB,$J,SECTION))
  1. K @ROOT
  1. Q
  1. ;
  1. STRIP ; -- strip off control chars
  1. N I,X
  1. S I=0 F S I=$O(@ROOT@(I)) Q:'I S X=^(I) D
  1. . I X[$C(8) D ;BS
  1. .. I $L(X,$C(8))=$L(X,$C(95)) S (X,@ROOT@(I))=$TR(X,$C(8,95),"") Q ;BS & _
  1. .. S (X,@ROOT@(I))=$TR(X,$C(8),"")
  1. . I X[$C(7)!(X[$C(12)) S @ROOT@(I)=$TR(X,$C(7,12),"") ;BEL or FF
  1. Q