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