YSASPRT ;ALB/ASF,HIOFO/FT - ASI PRINTER ;1/31/13 10:33am
;;5.01;MENTAL HEALTH;**24,30,38,76,121**;Dec 30, 1994;Build 61
;Reference to VADPT APIs supported by DBIA #10061
;Reference to %ZTLOAD supported by IA #10063
;Reference to ^%ZIS supported by IA #10086
;Reference to ^%ZISC supported by IA #10089
;Reference to ^XLFDT APIs supported by DBIA #10103
EN1(YSASDA) ;Entry point to display ASI
Q:$G(YSASDA)'>0
N YSASN,YSASNA,YSZZ,YSHDR,YSASD,YSAST,YSAS0,DIERR,YSI,YSASC
;ASK DEVICE
N YSASQUIT,%ZIS,POP
S %ZIS="QM"
D ^%ZIS
Q:$G(POP)
I $D(IO("Q")) D Q
.N ZTRTN,ZTDESC,ZTSAVE
.S ZTRTN="QTEP^YSASPRT"
.S ZTDESC="YSASPRT ASI PRINT"
.S ZTSAVE("YSASDA")=""
.D ^%ZTLOAD
.D HOME^%ZIS
.Q
QTEP ;Queued Task Entry Point
U IO
S:$D(ZTQUEUED) ZTREQ="@"
N N,YSAS0,YSASC,YSASD,YSASIG,YSASN,YSASNA,YSASQUIT,YSAST,YSHDR,YSI,YSI1,YSZZ
S YSZZ=0
K ^TMP($J,"YSASOSR1")
S YSAS0=^YSTX(604,YSASDA,0),DFN=$P(YSAS0,"^",2)
D DEM^VADPT
S YSASD=$$FMTE^XLFDT($P(YSAS0,U,5),"5ZD")
S YSAST=$$GET1^DIQ(604,YSASDA_",",.04)
S YSASC=$$GET1^DIQ(604,YSASDA_",",.09)
S YSASIG=$$GET1^DIQ(604,YSASDA_",",.51,"I")
S YSHDR=VADM(1)_" "_"xxx-xx-"_$E($P(VADM(2),U,2),8,11)_$J("",(20-$L(VADM(1))))_" ASI "_YSAST_" on "_YSASD_" by: "_YSASC
W @IOF,YSHDR,! W:'YSASIG ?25,"##### Unsigned Draft #####",!
S Y=YSAST_" ITEM REPORT",YSI1=$O(^YSTX(604.68,"B",Y,-1)) Q:YSI1'>0
F YSI=YSI1,20 D Q:YSZZ
. D CSR^YSASOSR(YSASDA,"^TMP($J,""YSASOSR1"","_YSI_")","^YSTX(604.68,"_YSI_",1)")
. D PRT
D ^%ZISC
Q
PRT ; Print output
S N=0 F S N=$O(^TMP($J,"YSASOSR1",YSI,N)) Q:N'>0!YSZZ D
. W !,^TMP($J,"YSASOSR1",YSI,N)
. I IOT'="HFS" D:$Y+4>IOSL WAIT ;ASF 3/7/03
;
Q
WAIT ;
F I0=1:1:IOSL-$Y-2 W !
N DTOUT,DUOUT,DIRUT
I IOST?1"C".E W $C(7) K DIR S DIR(0)="E" D ^DIR K DIR S YSZZ=$D(DIRUT)
Q:YSZZ
W @IOF,YSHDR,! W:'YSASIG ?25,"##### Unsigned Draft #####",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSASPRT 1900 printed Apr 09, 2024@21:23:18 Page 2
YSASPRT ;ALB/ASF,HIOFO/FT - ASI PRINTER ;1/31/13 10:33am
+1 ;;5.01;MENTAL HEALTH;**24,30,38,76,121**;Dec 30, 1994;Build 61
+2 ;Reference to VADPT APIs supported by DBIA #10061
+3 ;Reference to %ZTLOAD supported by IA #10063
+4 ;Reference to ^%ZIS supported by IA #10086
+5 ;Reference to ^%ZISC supported by IA #10089
+6 ;Reference to ^XLFDT APIs supported by DBIA #10103
EN1(YSASDA) ;Entry point to display ASI
+1 if $GET(YSASDA)'>0
QUIT
+2 NEW YSASN,YSASNA,YSZZ,YSHDR,YSASD,YSAST,YSAS0,DIERR,YSI,YSASC
+3 ;ASK DEVICE
+4 NEW YSASQUIT,%ZIS,POP
+5 SET %ZIS="QM"
+6 DO ^%ZIS
+7 if $GET(POP)
QUIT
+8 IF $DATA(IO("Q"))
Begin DoDot:1
+9 NEW ZTRTN,ZTDESC,ZTSAVE
+10 SET ZTRTN="QTEP^YSASPRT"
+11 SET ZTDESC="YSASPRT ASI PRINT"
+12 SET ZTSAVE("YSASDA")=""
+13 DO ^%ZTLOAD
+14 DO HOME^%ZIS
+15 QUIT
End DoDot:1
QUIT
QTEP ;Queued Task Entry Point
+1 USE IO
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 NEW N,YSAS0,YSASC,YSASD,YSASIG,YSASN,YSASNA,YSASQUIT,YSAST,YSHDR,YSI,YSI1,YSZZ
+4 SET YSZZ=0
+5 KILL ^TMP($JOB,"YSASOSR1")
+6 SET YSAS0=^YSTX(604,YSASDA,0)
SET DFN=$PIECE(YSAS0,"^",2)
+7 DO DEM^VADPT
+8 SET YSASD=$$FMTE^XLFDT($PIECE(YSAS0,U,5),"5ZD")
+9 SET YSAST=$$GET1^DIQ(604,YSASDA_",",.04)
+10 SET YSASC=$$GET1^DIQ(604,YSASDA_",",.09)
+11 SET YSASIG=$$GET1^DIQ(604,YSASDA_",",.51,"I")
+12 SET YSHDR=VADM(1)_" "_"xxx-xx-"_$EXTRACT($PIECE(VADM(2),U,2),8,11)_$JUSTIFY("",(20-$LENGTH(VADM(1))))_" ASI "_YSAST_" on "_YSASD_" by: "_YSASC
+13 WRITE @IOF,YSHDR,!
if 'YSASIG
WRITE ?25,"##### Unsigned Draft #####",!
+14 SET Y=YSAST_" ITEM REPORT"
SET YSI1=$ORDER(^YSTX(604.68,"B",Y,-1))
if YSI1'>0
QUIT
+15 FOR YSI=YSI1,20
Begin DoDot:1
+16 DO CSR^YSASOSR(YSASDA,"^TMP($J,""YSASOSR1"","_YSI_")","^YSTX(604.68,"_YSI_",1)")
+17 DO PRT
End DoDot:1
if YSZZ
QUIT
+18 DO ^%ZISC
+19 QUIT
PRT ; Print output
+1 SET N=0
FOR
SET N=$ORDER(^TMP($JOB,"YSASOSR1",YSI,N))
if N'>0!YSZZ
QUIT
Begin DoDot:1
+2 WRITE !,^TMP($JOB,"YSASOSR1",YSI,N)
+3 ;ASF 3/7/03
IF IOT'="HFS"
if $Y+4>IOSL
DO WAIT
End DoDot:1
+4 ;
+5 QUIT
WAIT ;
+1 FOR I0=1:1:IOSL-$Y-2
WRITE !
+2 NEW DTOUT,DUOUT,DIRUT
+3 IF IOST?1"C".E
WRITE $CHAR(7)
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET YSZZ=$DATA(DIRUT)
+4 if YSZZ
QUIT
+5 WRITE @IOF,YSHDR,!
if 'YSASIG
WRITE ?25,"##### Unsigned Draft #####",!
+6 QUIT
