| [613] | 1 | WVLETDQ ;HCIOFO/FT,JR IHS/ANMC/MWR - PRINT QUEUED LETTERS;
|
|---|
| 2 | ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
|
|---|
| 3 | ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
|---|
| 4 | ;; CALLED BY OPTION: "WV PRINT QUEUED LETTERS" TO PRINT LETTERS
|
|---|
| 5 | ;; BY "APRT" XREF IN ^WV(790.4,"APRT".
|
|---|
| 6 | ;
|
|---|
| 7 | START ;EP
|
|---|
| 8 | D SETUP G:WVPOP EXIT
|
|---|
| 9 | D DEVICE G:WVPOP EXIT
|
|---|
| 10 | D PRINT
|
|---|
| 11 | ;
|
|---|
| 12 | EXIT ;EP
|
|---|
| 13 | D ^%ZISC
|
|---|
| 14 | D KILLALL^WVUTL8
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | SETUP ;EP
|
|---|
| 18 | D SETVARS^WVUTL5 S WVPOP=0 K DIR
|
|---|
| 19 | S WVDUZ2=$G(DUZ(2))
|
|---|
| 20 | D TITLE^WVUTL5("PRINT QUEUED PATIENT LETTERS")
|
|---|
| 21 | I '$D(^WV(790.4,"APRT")) D S WVPOP=1
|
|---|
| 22 | .S WVTITLE="* There are no letters waiting to be printed. *"
|
|---|
| 23 | .D CENTERT^WVUTL5(.WVTITLE)
|
|---|
| 24 | .W !!!!,WVTITLE,!!
|
|---|
| 25 | .D DIRZ^WVUTL3
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | DEVICE ;EP
|
|---|
| 29 | ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
|
|---|
| 30 | K %ZIS,IOP
|
|---|
| 31 | S ZTRTN="PRINT^WVLETDQ",ZTSAVE("WVDUZ2")=""
|
|---|
| 32 | D ZIS^WVUTL2(.WVPOP,1)
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | PRINT ;EP
|
|---|
| 36 | D SETVARS^WVUTL5
|
|---|
| 37 | S WVCRT=$S($E(IOST)="C":1,1:0)
|
|---|
| 38 | ;---> USE WVION TO PRESERVE ION WHEN PRINTING MULTIPLE LETTERS.
|
|---|
| 39 | S (WVN,WVM)=0,WVION=ION
|
|---|
| 40 | F S WVN=$O(^WV(790.4,"APRT",WVN)) Q:'WVN!(WVPOP)!(WVN>DT) D
|
|---|
| 41 | .S WVDA=0
|
|---|
| 42 | .F S WVDA=$O(^WV(790.4,"APRT",WVN,WVDA)) Q:'WVDA!(WVPOP) D
|
|---|
| 43 | ..;---> QUIT IF NOT ASSOCIATED WITH THE USER'S CURRENT FACILITY.
|
|---|
| 44 | ..N WVFACIL S WVFACIL=$P(^WV(790.4,WVDA,0),U,7)
|
|---|
| 45 | ..Q:((WVFACIL'=WVDUZ2)&(WVFACIL))
|
|---|
| 46 | ..;---> WVKDT=DATE USED TO KILL "APRT" XREF IN ^WVLETPR
|
|---|
| 47 | ..S WVKDT=WVN,ION=WVION
|
|---|
| 48 | ..D PRINT^WVLETPR
|
|---|
| 49 | ..S WVM=WVM+1 K WVKDT
|
|---|
| 50 | I 'WVM D
|
|---|
| 51 | .W !!?17,"No letters are due to be printed at this time.",!!
|
|---|
| 52 | .D:WVCRT DIRZ^WVUTL3 ;W:'WVCRT @IOF
|
|---|
| 53 | Q
|
|---|
