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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVLETDQ 1533 printed Oct 16, 2024@18:47:39 Page 2
WVLETDQ ;HCIOFO/FT,JR IHS/ANMC/MWR - PRINT QUEUED LETTERS;
+1 ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; CALLED BY OPTION: "WV PRINT QUEUED LETTERS" TO PRINT LETTERS
+4 ;; BY "APRT" XREF IN ^WV(790.4,"APRT".
+5 ;
START ;EP
+1 DO SETUP
if WVPOP
GOTO EXIT
+2 DO DEVICE
if WVPOP
GOTO EXIT
+3 DO PRINT
+4 ;
EXIT ;EP
+1 DO ^%ZISC
+2 DO KILLALL^WVUTL8
+3 QUIT
+4 ;
SETUP ;EP
+1 DO SETVARS^WVUTL5
SET WVPOP=0
KILL DIR
+2 SET WVDUZ2=$GET(DUZ(2))
+3 DO TITLE^WVUTL5("PRINT QUEUED PATIENT LETTERS")
+4 IF '$DATA(^WV(790.4,"APRT"))
Begin DoDot:1
+5 SET WVTITLE="* There are no letters waiting to be printed. *"
+6 DO CENTERT^WVUTL5(.WVTITLE)
+7 WRITE !!!!,WVTITLE,!!
+8 DO DIRZ^WVUTL3
End DoDot:1
SET WVPOP=1
+9 QUIT
+10 ;
DEVICE ;EP
+1 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
+2 KILL %ZIS,IOP
+3 SET ZTRTN="PRINT^WVLETDQ"
SET ZTSAVE("WVDUZ2")=""
+4 DO ZIS^WVUTL2(.WVPOP,1)
+5 QUIT
+6 ;
PRINT ;EP
+1 DO SETVARS^WVUTL5
+2 SET WVCRT=$SELECT($EXTRACT(IOST)="C":1,1:0)
+3 ;---> USE WVION TO PRESERVE ION WHEN PRINTING MULTIPLE LETTERS.
+4 SET (WVN,WVM)=0
SET WVION=ION
+5 FOR
SET WVN=$ORDER(^WV(790.4,"APRT",WVN))
if 'WVN!(WVPOP)!(WVN>DT)
QUIT
Begin DoDot:1
+6 SET WVDA=0
+7 FOR
SET WVDA=$ORDER(^WV(790.4,"APRT",WVN,WVDA))
if 'WVDA!(WVPOP)
QUIT
Begin DoDot:2
+8 ;---> QUIT IF NOT ASSOCIATED WITH THE USER'S CURRENT FACILITY.
+9 NEW WVFACIL
SET WVFACIL=$PIECE(^WV(790.4,WVDA,0),U,7)
+10 if ((WVFACIL'=WVDUZ2)&(WVFACIL))
QUIT
+11 ;---> WVKDT=DATE USED TO KILL "APRT" XREF IN ^WVLETPR
+12 SET WVKDT=WVN
SET ION=WVION
+13 DO PRINT^WVLETPR
+14 SET WVM=WVM+1
KILL WVKDT
End DoDot:2
End DoDot:1
+15 IF 'WVM
Begin DoDot:1
+16 WRITE !!?17,"No letters are due to be printed at this time.",!!
+17 ;W:'WVCRT @IOF
if WVCRT
DO DIRZ^WVUTL3
End DoDot:1
+18 QUIT
