| [613] | 1 | YSASRPWP ;DALOI/YH- Report Calls ;5/11/2001
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;**71**;Dec 30, 1994
|
|---|
| 3 | ASINAR(ROOT,YSASDA) ;YSRP ASI NARRATIVE
|
|---|
| 4 | D START(132,"QTEP^YSASNAR")
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | ASIITM(ROOT,YSASDA) ;YSRP ASI ITEM
|
|---|
| 8 | D START(132,"QTEP^YSASPRT")
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | START(RM,GOTO) ;
|
|---|
| 12 | ;RM=Right margin
|
|---|
| 13 | S:'$G(RM) RM=80
|
|---|
| 14 | N ZTQUEUED,YSHFS,YSSUB,YSIO
|
|---|
| 15 | K ^TMP("YSDATA",$J) S ROOT=$NA(^TMP("YSDATA",$J,1))
|
|---|
| 16 | S YSHFS=$$HFS(),YSSUB="YSDATA"
|
|---|
| 17 | D OPEN(.RM,.YSHFS,"W",.YSIO)
|
|---|
| 18 | D @GOTO
|
|---|
| 19 | D CLOSE(.YSRM,.YSHFS,.YSSUB,.YSIO)
|
|---|
| 20 | Q
|
|---|
| 21 | HFS() ; -- get hfs file name
|
|---|
| 22 | ; -- need to define better unique algorithm
|
|---|
| 23 | Q "YSU_"_$J_".DAT"
|
|---|
| 24 | ;
|
|---|
| 25 | OPEN(YSRM,YSHFS,YSMODE,YSIO) ; -- open WORKSTATION device
|
|---|
| 26 | ; YSRM: right margin
|
|---|
| 27 | ; YSHFS: host file name
|
|---|
| 28 | ; YSMODE: open file in 'R'ead or 'W'rite mode
|
|---|
| 29 | S ZTQUEUED="" K IOPAR
|
|---|
| 30 | S IOP="OR WORKSTATION;"_$G(YSRM,80)
|
|---|
| 31 | S %ZIS("HFSMODE")=YSMODE,%ZIS("HFSNAME")=YSHFS
|
|---|
| 32 | D ^%ZIS
|
|---|
| 33 | K IOP,%ZIS
|
|---|
| 34 | U IO
|
|---|
| 35 | S YSIO=IO
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | CLOSE(YSRM,YSHFS,YSSUB,YSIO) ; -- close WORKSTATION device
|
|---|
| 39 | ; YSSUB: unique subscript name for output
|
|---|
| 40 | I IO=YSIO D ^%ZISC
|
|---|
| 41 | U IO
|
|---|
| 42 | D USEHFS
|
|---|
| 43 | U IO
|
|---|
| 44 | Q
|
|---|
| 45 | USEHFS ; -- use host file to build global array
|
|---|
| 46 | N IO,YSOK,SECTION
|
|---|
| 47 | S SECTION=0
|
|---|
| 48 | D INIT
|
|---|
| 49 | S YSOK=$$FTG^%ZISH(,YSHFS,$NA(@ROOT@(1)),4) I 'YSOK Q
|
|---|
| 50 | D STRIP
|
|---|
| 51 | N YSARR S YSARR(YSHFS)=""
|
|---|
| 52 | S YSOK=$$DEL^%ZISH("",$NA(YSARR))
|
|---|
| 53 | Q
|
|---|
| 54 | ;
|
|---|
| 55 | INIT ; -- initialize counts and global section
|
|---|
| 56 | S (INC,CNT)=0,SECTION=SECTION+1
|
|---|
| 57 | S ROOT=$NA(^TMP(YSSUB,$J,SECTION))
|
|---|
| 58 | K @ROOT
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | STRIP ; -- strip off control chars
|
|---|
| 62 | N I,X
|
|---|
| 63 | S I=0 F S I=$O(@ROOT@(I)) Q:'I S X=^(I) D
|
|---|
| 64 | . I X[$C(8) D ;BS
|
|---|
| 65 | .. I $L(X,$C(8))=$L(X,$C(95)) S (X,@ROOT@(I))=$TR(X,$C(8,95),"") Q ;BS & _
|
|---|
| 66 | .. S (X,@ROOT@(I))=$TR(X,$C(8),"")
|
|---|
| 67 | . I X[$C(7)!(X[$C(12)) S @ROOT@(I)=$TR(X,$C(7,12),"") ;BEL or FF
|
|---|
| 68 | Q
|
|---|
