source: FOIAVistA/tag/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVQ.m@ 628

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1ABSVQ ;VAMC ALTOONA/CTB_TKW_RSD - QUE PRINTOUTS ;8/28/01 12:31 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**10,23,25**;JULY 6, 1994
3 ;IF ABSVQ("FORCEQ") IS DEFINED ROUTINE WILL FORCE %ZTLOAD
4 K IOP,ZTSK
5 G:$D(ZTIO) TIME
6 W:$D(ABSVQ("FORCEQ")) !,"QUEUE TO PRINT ON:"
7 S %ZIS("B")="",%ZIS="MNQ"
8 D ^%ZIS I POP W " <No Device Selected>",*7,! R X:2 S NODEV="" G EXIT
9 S (ABIOP,IOP)=ION_";"_IOST_";"_IOM_";"_IOSL
10 I IO=IO(0),'$D(ABSVQ("FORCEQ")),'$D(IO("Q")) D ^%ZIS D @ZTRTN D:$D(IO("S")) ^%ZISC G EXIT
11TIME I '$D(ZTDTH) D DQTIME I '% D CLOSE W:(IOM-$X)<20 ! W " <Nothing Queued>",*7 S NODEV="" G EXIT
12 S (ZTSAVE("DUZ"),ZTSAVE("ABIOP"))="" D ^%ZTLOAD,CLOSE W:(IOM-$X)<20 ! W " <Request Queued>",*7,!
13EXIT K %ZIS,I,IO("Q"),IOP,K,N,ABIOP,ABSVL,ABSVQ G ZTKILL
14CLOSE D ^%ZISC QUIT
15DQTIME S U="^",%=1 K ZTDTH W !,"Enter DATE & TIME to ",$S('$D(ZTIO):"print",ZTIO]"":"print",1:"run"),". NOW// " R X:$S($D(DTIME):DTIME,1:30) I X[U!('$T) S %=0 K X Q
16 S:X="" X="NOW" S %DT="ER" D ^%DT S %=0 I Y<0 G DQTIME
17 S X=Y D H^%DTC S Y=Y_"000",ZTDTH=%H_","_($E(Y,9,10)*60+$E(Y,11,12)*60),%=1
18 K %DT,%H,ABSVXY,X,Y Q
19MSG ;;PRINTS MESSAGE CONTAINED IN X. IF IT DOESNT FIT ON ONE LINE, X IS PRINTED ON THE NEXT LINE.
20 N X1,X2,ZX Q:'$D(X)
21 F Q:$E(X)'="!" W ! S X=$E(X,2,9999)
22 I $S('$D(IOM):1,IOM="":1,1:0) W $P(X,"*") W:X["*" *7 R X:2 K X Q
23 I ($L($P(X,"*"))+4+$X)>IOM W !,?(IOM-($L($P(X,"*"))+4))
24 F ZX=1:1 D BRK:($L(X)+6)>IOM W " ",$P(X,"*"),! Q:'$D(X1) S X=X1 K X1
25 W:X["*" *7
26 W:$E(X,$L(X))="!" !
27 Q
28BRK N I
29 S X1=X F I=1:1 Q:$L($P(X," ",1,I))>(IOM-6)!($L(X)<(IOM-6)) S X1=$P(X," ",1,I)
30 S X2=$P(X," ",I,999),X=X1,X1=X2 K X2 Q
31PAUSE ; MAKES TERMINAL PAUSE WHEN DISPLAYING DATA ONLINE
32 S %=1 W !!,"Press RETURN to continue or '^' to quit: " R X:DTIME S:'$T!(X["^") %=0 Q
33ENCON W !," ** Press RETURN to Continue **" R X:DTIME Q
34DIKILL ; KILL STANDARD FILE MANAGER VARIABLES
35 K %,%DT,ABSVXX,ABSVXY,BY,D,DA,DCC,DIC,DIE,DIJ,DIPT,DIPASS,DISYS,DP,DR,D0,D1,D2,DQ,DHD,DLAYGO,F,FLDS,FR,I,IOX,IOY,J,K,L,O,P,POP,W,X,Y,Z,ZTSK Q
36DIWKILL ; KILL FILE MANAGER WORD PROCESSING VARIABLES
37 K DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DWLW,X1 Q
38ZTKILL ; KILL VARIABLES USED BY UNIVERSAL TASK MANAGER
39 K %ZIS,POP,ZTRTN,ZTUCI,ZTDTH,ZTSAVE,ZTDESC,ZTIO,ZTSK,ZTSKT Q
40CNVD ; CONVERTS DATE FROM INTERNAL (YYYMMDD) STORAGE FORMAT TO MM/DD/YYYY
41 S (Y,ABSVXX)="" I X]"" S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_($E(X,1,3)+1700) S ABSVXX=Y_$S(X[".":" "_$E($P(X,".",2)_"0000",1,2)_":"_$E($P(X,".",2)_"0000",3,4),1:"")
42 Q
43NOW N %H,ABSVXI,ABSVXM,ABSVXD,ABSVXY S %H=$H D TT S %=$P($H,",",2),%=%#3600\60/100+(%\3600)/100,%=X_$S(%:%,1:"") S Y=% D D S ABSVXX=Y S Y=X D D Q
44TT D 7 S ABSVXI(1)=ABSVXM,ABSVXI(2)=ABSVXD,ABSVXI(3)=ABSVXY Q
457 S %=%H>21608+%H-.1,ABSVXY=%\365.25+141,%=%#365.25\1
46 S ABSVXD=%+306#(ABSVXY#4=0+365)#153#61#31+1,ABSVXM=%-ABSVXD\29+1
47 S X=ABSVXY_"00"+ABSVXM_"00"+ABSVXD Q
48 ;
49D ;CONVERTS FILEMAN INTERNAL DATE TO EXTERNAL FORMAT
50 S:Y Y=$S($E(Y,4,5):$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$E(Y,4,5))_" ",1:"")_$S($E(Y,6,7):+$E(Y,6,7)_",",1:"")_($E(Y,1,3)+1700)_$P("@"_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),"^",Y[".")
51 Q
52HILO S (ABSVHI,ABSVLO,ABSVNORM)="*0" I ^%ZOSF("OS")'["M/11" Q
53 N TMP I $D(IOST)["0" S IOP=$S($D(ION):ION,1:IO(0)) D ^%ZIS K IOP,POP
54 S:$D(^%ZIS(2,IOST(0),7)) TMP=^(7),ABSVHI=$P(TMP,"^",1),ABSVLO=$P(TMP,"^",2),ABSVNORM=$P(TMP,"^",3) I ABSVHI=""!(ABSVLO="")!(ABSVNORM="") S (ABSVLO,ABSVHI,ABSVNORM)="*0"
55 Q
56NA N X
57 S X=" <NO ACTION TAKEN>*" D MSG QUIT
Note: See TracBrowser for help on using the repository browser.