| 1 | YTRPWRP ;DALOI/YH- Report Calls ;5/27/03 13:34
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;**71,76**;Dec 30, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | INTRMNT(ROOT,YSDFN,YSXT) ; -- return report text
|
|---|
| 5 | ;ROOT=Where you want it
|
|---|
| 6 | ;YSDFN=Patient DFN
|
|---|
| 7 | ;YSXT= DATE TEST TAKEN,POINTER TO MH INSTRUMENT FILE #601
|
|---|
| 8 | ; RPC: MH INTRUMENT REPORT TEXT
|
|---|
| 9 | ;
|
|---|
| 10 | ; -- init output global for close logic of WORKSTATION device
|
|---|
| 11 | N YSTOUT,YSUOUT,YSTEST,YSED,YSET,DFN,YSROU,YSN,LEN,YSBLNK S (YSTOUT,YSUOUT,YSN)=0,DFN=+YSDFN,$P(YSBLNK," ",60)=""
|
|---|
| 12 | 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")
|
|---|
| 13 | 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
|
|---|
| 14 | S YSHDR=YSSSN_" "_YSNM_YSBLNK,YSHDR=$E(YSHDR,1,44)_YSSEX_" AGE "_YSAGE,YSHD=DT
|
|---|
| 15 | K ^TMP("YSDATA",$J)
|
|---|
| 16 | S ROOT=$NA(^TMP("YSDATA",$J,1))
|
|---|
| 17 | ; -- get report text
|
|---|
| 18 | D START(132,"RP1^YTDP")
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | START(RM,GOTO) ;
|
|---|
| 22 | ;RM=Right margin
|
|---|
| 23 | S:'$G(RM) RM=80
|
|---|
| 24 | N ZTQUEUED,YSHFS,YSSUB,YSIO
|
|---|
| 25 | K ^TMP("YSDATA",$J)
|
|---|
| 26 | S ROOT=$NA(^TMP("YSDATA",$J,1))
|
|---|
| 27 | S YSHFS=$$HFS(),YSSUB="YSDATA"
|
|---|
| 28 | D OPEN(.RM,.YSHFS,"W",.YSIO)
|
|---|
| 29 | D @GOTO
|
|---|
| 30 | D CLOSE(.YSRM,.YSHFS,.YSSUB,.YSIO)
|
|---|
| 31 | Q
|
|---|
| 32 | HFS() ; -- get hfs file name
|
|---|
| 33 | ; -- need to define better unique algorithm
|
|---|
| 34 | Q "YSU_"_$J_".DAT"
|
|---|
| 35 | ;
|
|---|
| 36 | OPEN(YSRM,YSHFS,YSMODE,YSIO) ; -- open WORKSTATION device
|
|---|
| 37 | ; YSRM: right margin
|
|---|
| 38 | ; YSHFS: host file name
|
|---|
| 39 | ; YSMODE: open file in 'R'ead or 'W'rite mode
|
|---|
| 40 | S ZTQUEUED="" K IOPAR
|
|---|
| 41 | S IOP="OR WORKSTATION;"_$G(YSRM,80)_";66"
|
|---|
| 42 | S %ZIS("HFSMODE")=YSMODE,%ZIS("HFSNAME")=YSHFS
|
|---|
| 43 | D ^%ZIS
|
|---|
| 44 | K IOP,%ZIS
|
|---|
| 45 | U IO
|
|---|
| 46 | S YSIO=IO
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | CLOSE(YSRM,YSHFS,YSSUB,YSIO) ; -- close WORKSTATION device
|
|---|
| 50 | ; YSSUB: unique subscript name for output
|
|---|
| 51 | I IO=YSIO D ^%ZISC
|
|---|
| 52 | U IO
|
|---|
| 53 | D USEHFS
|
|---|
| 54 | U IO
|
|---|
| 55 | Q
|
|---|
| 56 | USEHFS ; -- use host file to build global array
|
|---|
| 57 | N IO,YSOK,SECTION
|
|---|
| 58 | S SECTION=0
|
|---|
| 59 | D INIT
|
|---|
| 60 | S YSOK=$$FTG^%ZISH(,YSHFS,$NA(@ROOT@(1)),4) I 'YSOK Q
|
|---|
| 61 | D STRIP
|
|---|
| 62 | N YSARR S YSARR(YSHFS)=""
|
|---|
| 63 | S YSOK=$$DEL^%ZISH("",$NA(YSARR))
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | INIT ; -- initialize counts and global section
|
|---|
| 67 | S (INC,CNT)=0,SECTION=SECTION+1
|
|---|
| 68 | S ROOT=$NA(^TMP(YSSUB,$J,SECTION))
|
|---|
| 69 | K @ROOT
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | STRIP ; -- strip off control chars
|
|---|
| 73 | N I,X
|
|---|
| 74 | S I=0 F S I=$O(@ROOT@(I)) Q:'I S X=^(I) D
|
|---|
| 75 | . I X[$C(8) D ;BS
|
|---|
| 76 | .. I $L(X,$C(8))=$L(X,$C(95)) S (X,@ROOT@(I))=$TR(X,$C(8,95),"") Q ;BS & _
|
|---|
| 77 | .. S (X,@ROOT@(I))=$TR(X,$C(8),"")
|
|---|
| 78 | . I X[$C(7)!(X[$C(12)) S @ROOT@(I)=$TR(X,$C(7,12),"") ;BEL or FF
|
|---|
| 79 | Q
|
|---|
| 80 | ;
|
|---|
| 81 | TESTCODE(ROOT) ;YTRP LIST TEST/CODE
|
|---|
| 82 | N A S A="C"
|
|---|
| 83 | D START(132,"ENP^YTLCTD")
|
|---|
| 84 | Q
|
|---|
| 85 | TESTDES(ROOT) ;YTRP LIST TEST/DESC
|
|---|
| 86 | N A S A="D"
|
|---|
| 87 | D START(132,"ENP^YTLCTD")
|
|---|
| 88 | Q
|
|---|
| 89 | TESTTL(ROOT) ;YTRP LIST TEST/TITLE
|
|---|
| 90 | N A S A="T"
|
|---|
| 91 | D START(132,"ENP^YTLCTD")
|
|---|
| 92 | Q
|
|---|
