54 lines
1.4 KiB
Mathematica
54 lines
1.4 KiB
Mathematica
WVLETDQ ;HCIOFO/FT,JR IHS/ANMC/MWR - PRINT QUEUED LETTERS;
|
|
;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
|
|
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
|
;; CALLED BY OPTION: "WV PRINT QUEUED LETTERS" TO PRINT LETTERS
|
|
;; BY "APRT" XREF IN ^WV(790.4,"APRT".
|
|
;
|
|
START ;EP
|
|
D SETUP G:WVPOP EXIT
|
|
D DEVICE G:WVPOP EXIT
|
|
D PRINT
|
|
;
|
|
EXIT ;EP
|
|
D ^%ZISC
|
|
D KILLALL^WVUTL8
|
|
Q
|
|
;
|
|
SETUP ;EP
|
|
D SETVARS^WVUTL5 S WVPOP=0 K DIR
|
|
S WVDUZ2=$G(DUZ(2))
|
|
D TITLE^WVUTL5("PRINT QUEUED PATIENT LETTERS")
|
|
I '$D(^WV(790.4,"APRT")) D S WVPOP=1
|
|
.S WVTITLE="* There are no letters waiting to be printed. *"
|
|
.D CENTERT^WVUTL5(.WVTITLE)
|
|
.W !!!!,WVTITLE,!!
|
|
.D DIRZ^WVUTL3
|
|
Q
|
|
;
|
|
DEVICE ;EP
|
|
;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
|
|
K %ZIS,IOP
|
|
S ZTRTN="PRINT^WVLETDQ",ZTSAVE("WVDUZ2")=""
|
|
D ZIS^WVUTL2(.WVPOP,1)
|
|
Q
|
|
;
|
|
PRINT ;EP
|
|
D SETVARS^WVUTL5
|
|
S WVCRT=$S($E(IOST)="C":1,1:0)
|
|
;---> USE WVION TO PRESERVE ION WHEN PRINTING MULTIPLE LETTERS.
|
|
S (WVN,WVM)=0,WVION=ION
|
|
F S WVN=$O(^WV(790.4,"APRT",WVN)) Q:'WVN!(WVPOP)!(WVN>DT) D
|
|
.S WVDA=0
|
|
.F S WVDA=$O(^WV(790.4,"APRT",WVN,WVDA)) Q:'WVDA!(WVPOP) D
|
|
..;---> QUIT IF NOT ASSOCIATED WITH THE USER'S CURRENT FACILITY.
|
|
..N WVFACIL S WVFACIL=$P(^WV(790.4,WVDA,0),U,7)
|
|
..Q:((WVFACIL'=WVDUZ2)&(WVFACIL))
|
|
..;---> WVKDT=DATE USED TO KILL "APRT" XREF IN ^WVLETPR
|
|
..S WVKDT=WVN,ION=WVION
|
|
..D PRINT^WVLETPR
|
|
..S WVM=WVM+1 K WVKDT
|
|
I 'WVM D
|
|
.W !!?17,"No letters are due to be printed at this time.",!!
|
|
.D:WVCRT DIRZ^WVUTL3 ;W:'WVCRT @IOF
|
|
Q
|