Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YSASPRT

YSASPRT.m

Go to the documentation of this file.
  1. 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
  1. ;Reference to VADPT APIs supported by DBIA #10061
  1. ;Reference to %ZTLOAD supported by IA #10063
  1. ;Reference to ^%ZIS supported by IA #10086
  1. ;Reference to ^%ZISC supported by IA #10089
  1. ;Reference to ^XLFDT APIs supported by DBIA #10103
  1. EN1(YSASDA) ;Entry point to display ASI
  1. Q:$G(YSASDA)'>0
  1. N YSASN,YSASNA,YSZZ,YSHDR,YSASD,YSAST,YSAS0,DIERR,YSI,YSASC
  1. ;ASK DEVICE
  1. N YSASQUIT,%ZIS,POP
  1. S %ZIS="QM"
  1. D ^%ZIS
  1. Q:$G(POP)
  1. I $D(IO("Q")) D Q
  1. .N ZTRTN,ZTDESC,ZTSAVE
  1. .S ZTRTN="QTEP^YSASPRT"
  1. .S ZTDESC="YSASPRT ASI PRINT"
  1. .S ZTSAVE("YSASDA")=""
  1. .D ^%ZTLOAD
  1. .D HOME^%ZIS
  1. .Q
  1. QTEP ;Queued Task Entry Point
  1. U IO
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. N N,YSAS0,YSASC,YSASD,YSASIG,YSASN,YSASNA,YSASQUIT,YSAST,YSHDR,YSI,YSI1,YSZZ
  1. S YSZZ=0
  1. K ^TMP($J,"YSASOSR1")
  1. S YSAS0=^YSTX(604,YSASDA,0),DFN=$P(YSAS0,"^",2)
  1. D DEM^VADPT
  1. S YSASD=$$FMTE^XLFDT($P(YSAS0,U,5),"5ZD")
  1. S YSAST=$$GET1^DIQ(604,YSASDA_",",.04)
  1. S YSASC=$$GET1^DIQ(604,YSASDA_",",.09)
  1. S YSASIG=$$GET1^DIQ(604,YSASDA_",",.51,"I")
  1. 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
  1. W @IOF,YSHDR,! W:'YSASIG ?25,"##### Unsigned Draft #####",!
  1. S Y=YSAST_" ITEM REPORT",YSI1=$O(^YSTX(604.68,"B",Y,-1)) Q:YSI1'>0
  1. F YSI=YSI1,20 D Q:YSZZ
  1. . D CSR^YSASOSR(YSASDA,"^TMP($J,""YSASOSR1"","_YSI_")","^YSTX(604.68,"_YSI_",1)")
  1. . D PRT
  1. D ^%ZISC
  1. Q
  1. PRT ; Print output
  1. S N=0 F S N=$O(^TMP($J,"YSASOSR1",YSI,N)) Q:N'>0!YSZZ D
  1. . W !,^TMP($J,"YSASOSR1",YSI,N)
  1. . I IOT'="HFS" D:$Y+4>IOSL WAIT ;ASF 3/7/03
  1. ;
  1. Q
  1. WAIT ;
  1. F I0=1:1:IOSL-$Y-2 W !
  1. N DTOUT,DUOUT,DIRUT
  1. I IOST?1"C".E W $C(7) K DIR S DIR(0)="E" D ^DIR K DIR S YSZZ=$D(DIRUT)
  1. Q:YSZZ
  1. W @IOF,YSHDR,! W:'YSASIG ?25,"##### Unsigned Draft #####",!
  1. Q