source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSASPRT.m@ 1314

Last change on this file since 1314 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1YSASPRT ;ALB/ASF-ASI PRINTER ;3/7/03 14:54
2 ;;5.01;MENTAL HEALTH;**24,30,38,76**;Dec 30, 1994
3EN1(YSASDA) ;Entry point to display ASI
4 Q:$G(YSASDA)'>0
5 N YSASN,YSASNA,YSZZ,YSHDR,YSASD,YSAST,YSAS0,DIERR,YSI,YSASC
6 ;D DICI^YSASO(.YSASDA)
7 ;Q:$G(YSASDA)'>0
8 ;ASK DEVICE
9 N YSASQUIT,%ZIS,POP
10 S %ZIS="QM"
11 D ^%ZIS
12 Q:$G(POP)
13 I $D(IO("Q")) D Q
14 .N ZTRTN,ZTDESC,ZTSAVE
15 .S ZTRTN="QTEP^YSASPRT"
16 .S ZTDESC="YSASPRT ASI PRINT"
17 .S ZTSAVE("YSASDA")=""
18 .D ^%ZTLOAD
19 .D HOME^%ZIS
20 .Q
21 U IO
22QTEP ;Queued Task Entry Point
23 S:$D(ZTQUEUED) ZTREQ="@"
24 N N,YSAS0,YSASC,YSASD,YSASIG,YSASN,YSASNA,YSASQUIT,YSAST,YSHDR,YSI,YSI1,YSZZ
25 S YSZZ=0
26 K ^TMP($J,"YSASOSR1")
27 S YSAS0=^YSTX(604,YSASDA,0),DFN=$P(YSAS0,"^",2)
28 D DEM^VADPT
29 S YSASD=$$FMTE^XLFDT($P(YSAS0,U,5),"5ZD")
30 S YSAST=$$GET1^DIQ(604,YSASDA_",",.04)
31 S YSASC=$$GET1^DIQ(604,YSASDA_",",.09)
32 S YSASIG=$$GET1^DIQ(604,YSASDA_",",.51,"I")
33 S YSHDR=VADM(1)_" "_$P(VADM(2),U,2)_$J("",(20-$L(VADM(1))))_" ASI "_YSAST_" on "_YSASD_" by: "_YSASC
34 W @IOF,YSHDR,! W:'YSASIG ?25,"##### Unsigned Draft #####",!
35 ;F YSI=10:1:17,20 D Q:YSZZ
36 S Y=YSAST_" ITEM REPORT",YSI1=$O(^YSTX(604.68,"B",Y,-1)) Q:YSI1'>0
37 F YSI=YSI1,20 D Q:YSZZ
38 . D CSR^YSASOSR(YSASDA,"^TMP($J,""YSASOSR1"","_YSI_")","^YSTX(604.68,"_YSI_",1)")
39 . D PRT
40 ;D HOME^%ZIS U IO
41 D ^%ZISC
42 Q
43PRT ; Print output
44 ;W @IOF,YSHDR,! W:'YSASIG ?25,"##### Unsigned Draft #####",!
45 S N=0 F S N=$O(^TMP($J,"YSASOSR1",YSI,N)) Q:N'>0!YSZZ D
46 . W !,^TMP($J,"YSASOSR1",YSI,N)
47 . I IOT'="HFS" D:$Y+4>IOSL WAIT ;ASF 3/7/03
48 ;
49 Q
50WAIT ;
51 F I0=1:1:IOSL-$Y-2 W !
52 N DTOUT,DUOUT,DIRUT
53 I IOST?1"C".E W $C(7) K DIR S DIR(0)="E" D ^DIR K DIR S YSZZ=$D(DIRUT)
54 Q:YSZZ
55 W @IOF,YSHDR,! W:'YSASIG ?25,"##### Unsigned Draft #####",!
56 Q
Note: See TracBrowser for help on using the repository browser.