WVLETDQ.m

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 ---WVLETDQ   1533     printed  Feb 19, 2025@00:13:38                                                                                                                                                                                                     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