| [613] | 1 | PRPFQ ;ALTOONA/CTB-RSD/ID TKW/BOISE QUE PRINTOUTS ;5/10/02
|
|---|
| 2 | V ;;3.0;PATIENT FUNDS;**6,10,13**;JUNE 1, 1989
|
|---|
| 3 | ;INPUT REQUIRED STANDARD ZT VARIABLES
|
|---|
| 4 | ;IF PRPFQ("FORCEQ") IS DEFINED ROUTINE WILL FORCE %ZTLOAD TO BE INVOKED
|
|---|
| 5 | S XION=ION K IOP,ZTSK W:$D(PRPFQ("FORCEQ")) !,"QUEUE TO PRINT ON:" S %ZIS("B")="",%ZIS="NQ" D ^%ZIS I POP W " <No Device Selected>",*7,! S IOP=XION D ^%ZIS K XION R X:2 G EXIT
|
|---|
| 6 | K XION S (PRIOP,IOP)=ION_";"_IOST_";"_IOM_";"_IOSL I IO=IO(0),'$D(PRPFQ("FORCEQ")) D ^%ZIS D @ZTRTN D CLOSE G EXIT
|
|---|
| 7 | D DQTIME I '% W " <Nothing Queued>",*7 D CLOSE G EXIT
|
|---|
| 8 | S (ZTSAVE("DUZ"),ZTSAVE("PRIOP"))="" D ^%ZTLOAD W " <Request Queued>",*7,!
|
|---|
| 9 | EXIT K %ZIS,I,IOP,K,N,PRIOP,PRPFL,PRPFQ G ZTKILL
|
|---|
| 10 | CLOSE X ^%ZIS("C") Q
|
|---|
| 11 | MSG ;;PRINTS MESSAGE CONTAINED IN X. IF IT DOESNT FIT ON ONE LINE, X IS PRINTED ON THE NEXT LINE.
|
|---|
| 12 | Q:$D(ZTQUEUED)
|
|---|
| 13 | N X1,X2,ZX Q:'$D(X) I $S('$D(IOM):1,IOM="":1,1:0) W $P(X,"*") W:X["*" *7 R X:2 K X Q
|
|---|
| 14 | I ($L($P(X,"*"))+4+$X)>IOM W !,?(IOM-($L($P(X,"*"))+4))
|
|---|
| 15 | W:X["*" *7 F ZX=1:1 D BRK:($L(X)+6)>IOM W " ",$P(X,"*"),! Q:'$D(X1) S X=X1 K X1
|
|---|
| 16 | Q
|
|---|
| 17 | BRK N I
|
|---|
| 18 | 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)
|
|---|
| 19 | S X2=$P(X," ",I,999),X=X1,X1=X2 K X2 Q
|
|---|
| 20 | DQTIME S U="^",%=1 K ZTDTH R !,"Enter DATE & TIME to print: NOW// ",X:$S($D(DTIME):DTIME,1:30) I X[U!('$T) S %=0 K X Q
|
|---|
| 21 | S:X="" X="NOW" S %DT="ER" D ^%DT S %=0 I Y<0 G DQTIME
|
|---|
| 22 | S X=Y D H^%DTC S Y=Y_"000",ZTDTH=%H_","_($E(Y,9,10)*60+$E(Y,11,12)*60),%=1
|
|---|
| 23 | K %DT,%H,%Y,X,Y Q
|
|---|
| 24 | DRNG ;SELECT RANGE OF DATES
|
|---|
| 25 | K %DT W ! S %DT="EAT",%DT("A")="Enter Beginning Date: " D ^%DT I Y<0 K %H,%I,%DT,TO,FR,X,Y S %=0 Q
|
|---|
| 26 | S FR=+Y S %DT("A")=" Enter Ending Date: " D ^%DT I X["^" K %DT,%H,%I,FR,Y S %=0 Q
|
|---|
| 27 | I Y<0 W "??",!,*7 K %DT,FR G DRNG
|
|---|
| 28 | S TO=+Y I TO<FR W !,*7,"Illogical range of dates. Try again.",! G DRNG
|
|---|
| 29 | S %=1 K %DT,%H,%I Q
|
|---|
| 30 | RNG ; ALLOW ENTRY OF BEGINNING AND ENDING RANGE
|
|---|
| 31 | S %=0,FR="",TO="z" S:'$D(DTIME) DTIME=120 W !!,"Start with "_M_": FIRST// " R FR:DTIME S:$T=0 FR="^" G:FR["^" RQ I FR["?",'$D(PRPFD) G RQ
|
|---|
| 32 | S:FR="" FR="@" I FR'["@" I $D(PRPFD) S %DT="ET",X=FR D ^%DT G:Y<0 RNG S FR=Y
|
|---|
| 33 | TO W !,"Go to "_M_": LAST// " R TO:DTIME S:$T=0 TO="^" G:TO["^" RQ G:TO["?"&('$D(PRPFD)) RNG S:TO="" TO="z" I TO="z" G RQ1
|
|---|
| 34 | I TO'["@" I $D(PRPFD) S X=TO D ^%DT G:Y<0 TO S TO=Y
|
|---|
| 35 | I (FR["@")!(TO["@") S %=1 Q
|
|---|
| 36 | I (+FR=FR)&(+TO=TO) I FR>TO W *7,!,"INVALID RANGE" G RNG
|
|---|
| 37 | I (+FR'=FR)!(+TO'=TO) I FR]TO W *7,!,"INVALID RANGE" G RNG
|
|---|
| 38 | Q
|
|---|
| 39 | RQ S %=0 K FR,TO,%DT,X,Y Q
|
|---|
| 40 | RQ1 S %=1 K %DT,M,PRPFD,X,Y Q
|
|---|
| 41 | PAUSE ; MAKES TERMINAL PAUSE WHEN DISPLAYING DATA ONLINE
|
|---|
| 42 | Q:$E($G(IOST),1,2)'="C-"
|
|---|
| 43 | W !!," ^ TO QUIT" R X:DTIME S:$T=0 X="^" S J=0
|
|---|
| 44 | Q
|
|---|
| 45 | ENCON I $E($G(IOST),1,2)="C-" W !," ** Press RETURN to Continue **" R X:DTIME K X
|
|---|
| 46 | QUIT
|
|---|
| 47 | DIKILL ; KILL STANDARD FILE MANAGER VARIABLES
|
|---|
| 48 | K %,%DT,%X,%Y,BY,D,DA,DCC,DIC,DIE,DIJ,DIOEND,DIPT,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
|
|---|
| 49 | DIWKILL ; KILL FILE MANAGER WORD PROCESSING VARIABLES
|
|---|
| 50 | K DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DWLW,X1 Q
|
|---|
| 51 | ZTKILL ; KILL VARIABLES USED BY UNIVERSAL TASK MANAGER
|
|---|
| 52 | K %ZIS,POP,ZTRTN,ZTUCI,ZTDTH,ZTSAVE,ZTDESC,ZTIO,ZTSK,ZTSKT,ZTDHD,ZTREQ Q
|
|---|
| 53 | LOCK ;LOCK GLOBAL THAT IS BEING ACCESSED BY ANOTHER USER
|
|---|
| 54 | L @(DIC_DA_"):30") S PRPFL=$T Q:PRPFL W !!,$C(7),"THIS ENTRY IS BEING EDITED BY ANOTHER USER. TRY LATER." Q
|
|---|
| 55 | D ;CONVERTS FILEMAN INTERNAL DATE TO EXTERNAL FORMAT
|
|---|
| 56 | 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[".")
|
|---|
| 57 | Q
|
|---|
| 58 | CNVD ; CONVERTS DATE FROM INTERNAL (YYYMMDD) STORAGE FORMAT TO MM/DD/YY
|
|---|
| 59 | S X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) Q
|
|---|
| 60 | NOW S %H=$H
|
|---|
| 61 | ; PRPF*3*10 - Changed (Y2K issue) to call %DTC
|
|---|
| 62 | D YX^%DTC S %X=Y
|
|---|
| 63 | Q
|
|---|
| 64 | SELRNG S PRPFRNG=""
|
|---|
| 65 | S DIR(0)="SA^A:ALL;S:SINGLE",DIR("A")="Single Station List or All Station List: ",DIR("B")="ALL"
|
|---|
| 66 | S DIR("?")="You may enter (A)LL or (S)ingle",DIR("?",1)="Selecting SINGLE will run this report for one Station only."
|
|---|
| 67 | D ^DIR K DIR I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) Q
|
|---|
| 68 | A S PRPFRNG=""
|
|---|
| 69 | S:Y="A" PRPFRNG="@"
|
|---|
| 70 | I Y="S" S DIC(0)="AEQMZ",DIC=4 W !! D ^DIC K DIC I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) Q
|
|---|
| 71 | I PRPFRNG="" I $$GET1^DIQ(4,$P(Y,U),99)="" W !!,"You cannot select a STATION that does not have a STATION NUMBER assigned to it!" S Y="S" D A Q
|
|---|
| 72 | S:PRPFRNG'="@" PRPFRNG=$$GET1^DIQ(4,$P(Y,U),99)
|
|---|
| 73 | Q
|
|---|
