YTRPWRP ;DALOI/YH- Report Calls ;5/27/03  13:34
 ;;5.01;MENTAL HEALTH;**71,76**;Dec 30, 1994
 ;
INTRMNT(ROOT,YSDFN,YSXT) ; -- return report text
 ;ROOT=Where you want it
 ;YSDFN=Patient DFN
 ;YSXT= DATE TEST TAKEN,POINTER TO MH INSTRUMENT FILE #601
 ;  RPC: MH INTRUMENT REPORT TEXT
 ;
 ; -- init output global for close logic of WORKSTATION device
 N YSTOUT,YSUOUT,YSTEST,YSED,YSET,DFN,YSROU,YSN,LEN,YSBLNK S (YSTOUT,YSUOUT,YSN)=0,DFN=+YSDFN,$P(YSBLNK," ",60)=""
 S %=$H>21549+$H-.1,%Y=%\365.25+141,%=%#365.25\1,YSPTD=%+306#(%Y#4=0+365)#153#61#31+1,YSPTM=%-YSPTD\29+1,Y=%Y_"00"+YSPTM_"00"+YSPTD,YSDT(0)=$$FMTE^XLFDT(Y,"5ZD")
 D DEM^VADPT,PID^VADPT S YSNM=VADM(1),YSSEX=$P(VADM(5),U),YSDOB=$P(VADM(3),U,2),YSAGE=VADM(4),YSSSN=VA("PID"),YSSX=YSSEX
 S YSHDR=YSSSN_"  "_YSNM_YSBLNK,YSHDR=$E(YSHDR,1,44)_YSSEX_" AGE "_YSAGE,YSHD=DT
 K ^TMP("YSDATA",$J)
 S ROOT=$NA(^TMP("YSDATA",$J,1))
 ; -- get report text
 D START(132,"RP1^YTDP")
 Q
 ;
START(RM,GOTO) ;
 ;RM=Right margin
 S:'$G(RM) RM=80
 N ZTQUEUED,YSHFS,YSSUB,YSIO
 K ^TMP("YSDATA",$J)
 S ROOT=$NA(^TMP("YSDATA",$J,1))
 S YSHFS=$$HFS(),YSSUB="YSDATA"
 D OPEN(.RM,.YSHFS,"W",.YSIO)
 D @GOTO
 D CLOSE(.YSRM,.YSHFS,.YSSUB,.YSIO)
 Q
HFS() ; -- get hfs file name
 ; -- need to define better unique algorithm
 Q "YSU_"_$J_".DAT"
 ;
OPEN(YSRM,YSHFS,YSMODE,YSIO) ; -- open WORKSTATION device
 ;   YSRM: right margin
 ;  YSHFS: host file name
 ; YSMODE: open file in 'R'ead or 'W'rite mode
 S ZTQUEUED="" K IOPAR
 S IOP="OR WORKSTATION;"_$G(YSRM,80)_";66"
 S %ZIS("HFSMODE")=YSMODE,%ZIS("HFSNAME")=YSHFS
 D ^%ZIS
 K IOP,%ZIS
 U IO
 S YSIO=IO
 Q
 ;
CLOSE(YSRM,YSHFS,YSSUB,YSIO) ; -- close WORKSTATION device
 ; YSSUB: unique subscript name for output 
 I IO=YSIO D ^%ZISC
 U IO
 D USEHFS
 U IO
 Q
USEHFS ; -- use host file to build global array
 N IO,YSOK,SECTION
 S SECTION=0
 D INIT
 S YSOK=$$FTG^%ZISH(,YSHFS,$NA(@ROOT@(1)),4) I 'YSOK Q
 D STRIP
 N YSARR S YSARR(YSHFS)=""
 S YSOK=$$DEL^%ZISH("",$NA(YSARR))
 Q
 ;
INIT ; -- initialize counts and global section
 S (INC,CNT)=0,SECTION=SECTION+1
 S ROOT=$NA(^TMP(YSSUB,$J,SECTION))
 K @ROOT
 Q
 ;
STRIP ; -- strip off control chars
 N I,X
 S I=0 F  S I=$O(@ROOT@(I)) Q:'I  S X=^(I) D
 . I X[$C(8) D  ;BS
 .. I $L(X,$C(8))=$L(X,$C(95)) S (X,@ROOT@(I))=$TR(X,$C(8,95),"") Q  ;BS & _
 .. S (X,@ROOT@(I))=$TR(X,$C(8),"")
 . I X[$C(7)!(X[$C(12)) S @ROOT@(I)=$TR(X,$C(7,12),"") ;BEL or FF
 Q
 ;
TESTCODE(ROOT) ;YTRP LIST TEST/CODE
 N A S A="C"
 D START(132,"ENP^YTLCTD")
 Q
TESTDES(ROOT) ;YTRP LIST TEST/DESC
 N A S A="D"
 D START(132,"ENP^YTLCTD")
 Q
TESTTL(ROOT) ;YTRP LIST TEST/TITLE
 N A S A="T"
 D START(132,"ENP^YTLCTD")
 Q