- 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 Feb 18, 2025@23:39:35 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