YSASRPWP ;DALOI/YH- Report Calls ;5/11/2001
;;5.01;MENTAL HEALTH;**71**;Dec 30, 1994
ASINAR(ROOT,YSASDA) ;YSRP ASI NARRATIVE
D START(132,"QTEP^YSASNAR")
Q
;
ASIITM(ROOT,YSASDA) ;YSRP ASI ITEM
D START(132,"QTEP^YSASPRT")
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)
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSASRPWP 1735 printed Dec 13, 2024@02:13:18 Page 2
YSASRPWP ;DALOI/YH- Report Calls ;5/11/2001
+1 ;;5.01;MENTAL HEALTH;**71**;Dec 30, 1994
ASINAR(ROOT,YSASDA) ;YSRP ASI NARRATIVE
+1 DO START(132,"QTEP^YSASNAR")
+2 QUIT
+3 ;
ASIITM(ROOT,YSASDA) ;YSRP ASI ITEM
+1 DO START(132,"QTEP^YSASPRT")
+2 QUIT
+3 ;
START(RM,GOTO) ;
+1 ;RM=Right margin
+2 if '$GET(RM)
SET RM=80
+3 NEW ZTQUEUED,YSHFS,YSSUB,YSIO
+4 KILL ^TMP("YSDATA",$JOB)
SET ROOT=$NAME(^TMP("YSDATA",$JOB,1))
+5 SET YSHFS=$$HFS()
SET YSSUB="YSDATA"
+6 DO OPEN(.RM,.YSHFS,"W",.YSIO)
+7 DO @GOTO
+8 DO CLOSE(.YSRM,.YSHFS,.YSSUB,.YSIO)
+9 QUIT
HFS() ; -- get hfs file name
+1 ; -- need to define better unique algorithm
+2 QUIT "YSU_"_$JOB_".DAT"
+3 ;
OPEN(YSRM,YSHFS,YSMODE,YSIO) ; -- open WORKSTATION device
+1 ; YSRM: right margin
+2 ; YSHFS: host file name
+3 ; YSMODE: open file in 'R'ead or 'W'rite mode
+4 SET ZTQUEUED=""
KILL IOPAR
+5 SET IOP="OR WORKSTATION;"_$GET(YSRM,80)
+6 SET %ZIS("HFSMODE")=YSMODE
SET %ZIS("HFSNAME")=YSHFS
+7 DO ^%ZIS
+8 KILL IOP,%ZIS
+9 USE IO
+10 SET YSIO=IO
+11 QUIT
+12 ;
CLOSE(YSRM,YSHFS,YSSUB,YSIO) ; -- close WORKSTATION device
+1 ; YSSUB: unique subscript name for output
+2 IF IO=YSIO
DO ^%ZISC
+3 USE IO
+4 DO USEHFS
+5 USE IO
+6 QUIT
USEHFS ; -- use host file to build global array
+1 NEW IO,YSOK,SECTION
+2 SET SECTION=0
+3 DO INIT
+4 SET YSOK=$$FTG^%ZISH(,YSHFS,$NAME(@ROOT@(1)),4)
IF 'YSOK
QUIT
+5 DO STRIP
+6 NEW YSARR
SET YSARR(YSHFS)=""
+7 SET YSOK=$$DEL^%ZISH("",$NAME(YSARR))
+8 QUIT
+9 ;
INIT ; -- initialize counts and global section
+1 SET (INC,CNT)=0
SET SECTION=SECTION+1
+2 SET ROOT=$NAME(^TMP(YSSUB,$JOB,SECTION))
+3 KILL @ROOT
+4 QUIT
+5 ;
STRIP ; -- strip off control chars
+1 NEW I,X
+2 SET I=0
FOR
SET I=$ORDER(@ROOT@(I))
if 'I
QUIT
SET X=^(I)
Begin DoDot:1
+3 ;BS
IF X[$CHAR(8)
Begin DoDot:2
+4 ;BS & _
IF $LENGTH(X,$CHAR(8))=$LENGTH(X,$CHAR(95))
SET (X,@ROOT@(I))=$TRANSLATE(X,$CHAR(8,95),"")
QUIT
+5 SET (X,@ROOT@(I))=$TRANSLATE(X,$CHAR(8),"")
End DoDot:2
+6 ;BEL or FF
IF X[$CHAR(7)!(X[$CHAR(12))
SET @ROOT@(I)=$TRANSLATE(X,$CHAR(7,12),"")
End DoDot:1
+7 QUIT
