source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTRPWRP.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1YTRPWRP ;DALOI/YH- Report Calls ;5/27/03 13:34
2 ;;5.01;MENTAL HEALTH;**71,76**;Dec 30, 1994
3 ;
4INTRMNT(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 ;
21START(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
32HFS() ; -- get hfs file name
33 ; -- need to define better unique algorithm
34 Q "YSU_"_$J_".DAT"
35 ;
36OPEN(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 ;
49CLOSE(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
56USEHFS ; -- 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 ;
66INIT ; -- 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 ;
72STRIP ; -- 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 ;
81TESTCODE(ROOT) ;YTRP LIST TEST/CODE
82 N A S A="C"
83 D START(132,"ENP^YTLCTD")
84 Q
85TESTDES(ROOT) ;YTRP LIST TEST/DESC
86 N A S A="D"
87 D START(132,"ENP^YTLCTD")
88 Q
89TESTTL(ROOT) ;YTRP LIST TEST/TITLE
90 N A S A="T"
91 D START(132,"ENP^YTLCTD")
92 Q
Note: See TracBrowser for help on using the repository browser.