WVLETPR ;HCIOFO/FT,JR-WV PRINT LETTERS. ;1/10/00 16:45
;;1.0;WOMEN'S HEALTH;**7,9**;Sep 30, 1998
;; Original routine created by IHS/ANMC/MWR
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; CALLED BY OPTION: "WV PRINT INDIVIDUAL LETTERS" TO PRINT A
;; LETTER FOR A SINGLE INDIVIDUAL (AS OPPOSED TO ALL THOSE QUEUED).
;
D SETVARS^WVUTL5 S (WVPOP1,WVPOP)=0
N WVDA,WVTITLE
F S WVPOP=0 D Q:WVPOP1
.D SELECT Q:WVPOP
.D DEVICE Q:WVPOP
.S WVCRT=$S($E(IOST)="C":1,1:0)
.D PRINT
D ^%ZISC
;
EXIT ;EP
D KILLALL^WVUTL8
Q
;
SELECT ;EP
;---> SELECT PATIENT, THEN SELECT NOTIFICATION.
N DIC,X,Y
D TITLE^WVUTL5("PRINT INDIVIDUAL PATIENT LETTERS")
D PATLKUP^WVUTL8(.Y)
I Y<0 S (WVPOP,WVPOP1)=1 Q
S WVDFN=+Y,X=$$NAME^WVUTL1(WVDFN)
D DIC^WVFMAN(790.4,"EM",.Y,"","","",X,.WVPOP)
I $D(DUOUT)!($D(DTOUT)) S WVPOP=1 Q
I Y<0 D NONE S WVPOP=1 Q
S WVDA=+Y
;
;---> IF FACILITIES OF LETTER AND USER DON'T MATCH, QUIT.
N WVFACIL S WVFACIL=$P(^WV(790.4,WVDA,0),U,7)
I ((WVFACIL'=DUZ(2))&(WVFACIL)) D TEXT1,DIRZ^WVUTL3 S WVPOP=1 Q
;
S WVPURP=$P(^WV(790.4,WVDA,0),U,4)
S WVTYPE=$P(^WV(790.4,WVDA,0),U,3)
;
;---> CHECK IF PURPOSE HAS BEEN ENTERED.
I 'WVPURP D Q
.W !!?5,"No Purpose has been entered for this Notification."
.D DIRZ^WVUTL3 S WVPOP=1 Q
;
;---> CHECK IF THIS PURPOSE OF NOTIFICATION HAS A LETTER.
I '$D(^WV(790.404,WVPURP,1,0)) D Q
.W !!!?5,"No letter has been entered for this Purpose of Notification."
.W !?5,"Programmer information: Notification=^WV(790.4,"_WVDA_",0)."
.W !?5," Purpose IEN=",WVPURP
.W !?5," Patient IEN=",WVDFN
.D DIRZ^WVUTL3 S WVPOP=1 Q
;
;---> CHECK IF TYPE OF NOTIFICATION FOR THIS NOTIFICATION IS PRINTABLE.
I 'WVTYPE D CANTPRT Q
I '$P(^WV(790.403,WVTYPE,0),U,2) D CANTPRT Q
Q
;
CANTPRT ;EP
;---> CAN'T PRINT THIS NOTIFICATION.
W !!?5,"This Type of Notification"
W:WVTYPE ", ",$P(^WV(790.403,WVTYPE,0),U),"," W " is not printable."
D DIRZ^WVUTL3 S WVPOP=1
Q
;
DEVICE ;EP
;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
K %ZIS,IOP
S ZTRTN="PRINT^WVLETPR",ZTSAVE("WVDA")=""
D ZIS^WVUTL2(.WVPOP,1)
Q
;
PRINT ;EP
;---> REQUIRED VARIABLE: WVDA=IEN IN ^WV(790.4, ION=DEVICE
;---> NEXT LINE: IOP WILL INHIBIT ^DIWF FROM PROMPTING FOR DEVICE.
D SETVARS^WVUTL5
N WVDFN,WVPURP,IOP
S IOP=ION
;---> IF FACILITIES OF LETTER AND USER DON'T MATCH, QUIT (IF NULL, OK).
N WVFACIL S WVFACIL=$P(^WV(790.4,WVDA,0),U,7)
I ((WVFACIL'=DUZ(2))&(WVFACIL)) D TEXT1 H 5 S WVPOP=1 Q
;
S WVDFN=$P(^WV(790.4,WVDA,0),U)
S WVPURP=$P(^WV(790.4,WVDA,0),U,4)
;---> WVN=DATE OF "PRINT DATE", USE TO KILL "APRT" XREF BELOW.
S:'$D(WVKDT) WVKDT=$P(^WV(790.4,WVDA,0),U,11)
;---> IF NO PURPOSE (DELETED), KILL "APRT" XREF AND QUIT.
I 'WVPURP D Q
.W !!?5,"No Purpose of Notification has been chosen; therefore, this"
.W !?5,"notification cannot be printed."
.D KILLXREF(WVDA,WVKDT)
;---> IF QUEUED AND WVCRT IS NOT SET, THEN SET IT.
S:'$D(WVCRT) WVCRT=$S($E(IOST)="C":1,1:0)
S DIWF="^WV(790.404,WVPURP,1,"
S DIWF(1)=790
S BY="INTERNAL(#.01)="_WVDFN
;---> IF LOCKED, PROMPT DEVICE, QUIT AND LEAVE IN THE QUEUE.
L +^WV(790.4,WVDA):0 I '$T U IO D D PROMPT Q
.W !!?5,"The selected Notification is being edited by another user."
.W !?5,"Programmer information: Notification=^WV(790.4,"_WVDA_",0)."
.W:'WVCRT @IOF
;
;---> IF PATIENT IS DECEASED, DON'T PRINT LETTER; PRINT EXPLANATION,
;---> CHANGE THE STATUS OF THE NOTIFICATION TO "CLOSED", AND GIVE
;---> THE OUTCOME OF "PATIENT DECEASED".
I $$DECEASED^WVUTL1(WVDFN) D DECEASED Q
;---> Compute future appointments
D KAPPT^WVUTL9(WVDFN) ;kill off old computed appts.
D GAPPT^WVUTL9(WVDFN) ;get future appts
D SAPPT^WVUTL9(WVDFN) ;set appts in File 790
D KILLUG^WVUTL9 ;kill off Utility global off future appts
D KADD^WVUTL9(WVDFN) ;kill off old computed address
D GADD^WVUTL9(WVDFN) ;get current complete address
D SADD^WVUTL9(WVDFN) ;set complete address in File 790
D KVAR^WVUTL9 ;clean-up VADPT variables used
;---> PRINT IT TO IOP, PRESERVE WVPOP.
D EN2^DIWF
D PROMPT
;---> DON'T STUFF "DATE PRINTED" IF IT ALREADY HAS A "DATE PRINTED".
I $P(^WV(790.4,WVDA,0),U,10)]"" D KILLXREF(WVDA,WVKDT) L -^WV(790.4,WVDA) Q
;
;---> DON'T STUFF "DATE PRINTED" IF IT'S JUST TO THE SCREEN.
I WVCRT D Q
.W !!?3,"NOTE: Because this letter was only displayed on a screen and"
.W !?9,"not printed on a printer, it will NOT yet be logged by the"
.W !?9,"program as having been ""PRINTED"".",!
.L -^WV(790.4,WVDA) D DIRZ^WVUTL3
;
;---> NEXT LINES KILL "APRT" XREF AND SET "DATE PRINTED"=TODAY.
;---> ("APRT" XREF INDICATE A NOTIFICATION IS QUEUED TO BE PRINTED.)
D KILLXREF(WVDA,WVKDT)
D DIE^WVFMAN(790.4,".1////"_DT,WVDA)
L -^WV(790.4,WVDA) Q
Q
;
KILLXREF(WVDA,WVKDT) ;EP
;---> KILL "APRT" XREF (REMOVE LETTER FROM QUEUE).
Q:'$G(WVDA) Q:'$G(WVKDT)
K ^WV(790.4,"APRT",WVKDT,WVDA)
Q
;
DECEASED ;EP
;---> IF THE PATIENT IS DECEASED.
;---> DON'T STUFF "DATE PRINTED" IF IT'S JUST TO THE SCREEN.
W !!?3,"NOTE: Because this patient, ",$$NAME^WVUTL1(WVDFN)," #"
W $$SSN^WVUTL1(WVDFN),", is now"
W !?9,"registered as deceased, the letter will NOT be printed."
W !?9,"Instead, this notification will be given a status of CLOSED"
W !?9,"and an outcome of ""Patient Deceased""."
D:WVCRT&('$D(IO("S"))) DIRZ^WVUTL3
W:'WVCRT @IOF
S DR=".14////c;.05///Patient Deceased"
D DIE^WVFMAN(790.4,DR,WVDA)
;---> KILL "APRT" XREF (FLAGS NOTIFICATION AS QUEUED TO BE PRINTED).
D KILLXREF(WVDA,WVKDT)
L -^WV(790.4,WVDA)
Q
;
PROMPT ;EP
;---> PROMPT IF NECESSARY, PROMPT DEVICE.
D:WVCRT DIRZ^WVUTL3
Q
;
NONE ;EP
S WVTITLE="* No letters selected for printing. *"
D CENTERT^WVUTL5(.WVTITLE)
W !!!!,WVTITLE,!!
D DIRZ^WVUTL3
Q
;
TEXT1 ;EP
;;
;;* NOTE: The Facility with which this letter is associated does not
;; match the Facility under which you are currently logged on.
;; To print this Notification, you must either edit the Facility
;; for this Notification, or log off and log back in under the
;; same Facility with which the Notification is associated.
S WVTAB=5,WVLINL="TEXT1" D PRINTX
Q
;
PRINTX ;EP
N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVLETPR 6427 printed Dec 13, 2024@02:47:12 Page 2
WVLETPR ;HCIOFO/FT,JR-WV PRINT LETTERS. ;1/10/00 16:45
+1 ;;1.0;WOMEN'S HEALTH;**7,9**;Sep 30, 1998
+2 ;; Original routine created by IHS/ANMC/MWR
+3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+4 ;; CALLED BY OPTION: "WV PRINT INDIVIDUAL LETTERS" TO PRINT A
+5 ;; LETTER FOR A SINGLE INDIVIDUAL (AS OPPOSED TO ALL THOSE QUEUED).
+6 ;
+7 DO SETVARS^WVUTL5
SET (WVPOP1,WVPOP)=0
+8 NEW WVDA,WVTITLE
+9 FOR
SET WVPOP=0
Begin DoDot:1
+10 DO SELECT
if WVPOP
QUIT
+11 DO DEVICE
if WVPOP
QUIT
+12 SET WVCRT=$SELECT($EXTRACT(IOST)="C":1,1:0)
+13 DO PRINT
End DoDot:1
if WVPOP1
QUIT
+14 DO ^%ZISC
+15 ;
EXIT ;EP
+1 DO KILLALL^WVUTL8
+2 QUIT
+3 ;
SELECT ;EP
+1 ;---> SELECT PATIENT, THEN SELECT NOTIFICATION.
+2 NEW DIC,X,Y
+3 DO TITLE^WVUTL5("PRINT INDIVIDUAL PATIENT LETTERS")
+4 DO PATLKUP^WVUTL8(.Y)
+5 IF Y<0
SET (WVPOP,WVPOP1)=1
QUIT
+6 SET WVDFN=+Y
SET X=$$NAME^WVUTL1(WVDFN)
+7 DO DIC^WVFMAN(790.4,"EM",.Y,"","","",X,.WVPOP)
+8 IF $DATA(DUOUT)!($DATA(DTOUT))
SET WVPOP=1
QUIT
+9 IF Y<0
DO NONE
SET WVPOP=1
QUIT
+10 SET WVDA=+Y
+11 ;
+12 ;---> IF FACILITIES OF LETTER AND USER DON'T MATCH, QUIT.
+13 NEW WVFACIL
SET WVFACIL=$PIECE(^WV(790.4,WVDA,0),U,7)
+14 IF ((WVFACIL'=DUZ(2))&(WVFACIL))
DO TEXT1
DO DIRZ^WVUTL3
SET WVPOP=1
QUIT
+15 ;
+16 SET WVPURP=$PIECE(^WV(790.4,WVDA,0),U,4)
+17 SET WVTYPE=$PIECE(^WV(790.4,WVDA,0),U,3)
+18 ;
+19 ;---> CHECK IF PURPOSE HAS BEEN ENTERED.
+20 IF 'WVPURP
Begin DoDot:1
+21 WRITE !!?5,"No Purpose has been entered for this Notification."
+22 DO DIRZ^WVUTL3
SET WVPOP=1
QUIT
End DoDot:1
QUIT
+23 ;
+24 ;---> CHECK IF THIS PURPOSE OF NOTIFICATION HAS A LETTER.
+25 IF '$DATA(^WV(790.404,WVPURP,1,0))
Begin DoDot:1
+26 WRITE !!!?5,"No letter has been entered for this Purpose of Notification."
+27 WRITE !?5,"Programmer information: Notification=^WV(790.4,"_WVDA_",0)."
+28 WRITE !?5," Purpose IEN=",WVPURP
+29 WRITE !?5," Patient IEN=",WVDFN
+30 DO DIRZ^WVUTL3
SET WVPOP=1
QUIT
End DoDot:1
QUIT
+31 ;
+32 ;---> CHECK IF TYPE OF NOTIFICATION FOR THIS NOTIFICATION IS PRINTABLE.
+33 IF 'WVTYPE
DO CANTPRT
QUIT
+34 IF '$PIECE(^WV(790.403,WVTYPE,0),U,2)
DO CANTPRT
QUIT
+35 QUIT
+36 ;
CANTPRT ;EP
+1 ;---> CAN'T PRINT THIS NOTIFICATION.
+2 WRITE !!?5,"This Type of Notification"
+3 if WVTYPE
WRITE ", ",$PIECE(^WV(790.403,WVTYPE,0),U),","
WRITE " is not printable."
+4 DO DIRZ^WVUTL3
SET WVPOP=1
+5 QUIT
+6 ;
DEVICE ;EP
+1 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
+2 KILL %ZIS,IOP
+3 SET ZTRTN="PRINT^WVLETPR"
SET ZTSAVE("WVDA")=""
+4 DO ZIS^WVUTL2(.WVPOP,1)
+5 QUIT
+6 ;
PRINT ;EP
+1 ;---> REQUIRED VARIABLE: WVDA=IEN IN ^WV(790.4, ION=DEVICE
+2 ;---> NEXT LINE: IOP WILL INHIBIT ^DIWF FROM PROMPTING FOR DEVICE.
+3 DO SETVARS^WVUTL5
+4 NEW WVDFN,WVPURP,IOP
+5 SET IOP=ION
+6 ;---> IF FACILITIES OF LETTER AND USER DON'T MATCH, QUIT (IF NULL, OK).
+7 NEW WVFACIL
SET WVFACIL=$PIECE(^WV(790.4,WVDA,0),U,7)
+8 IF ((WVFACIL'=DUZ(2))&(WVFACIL))
DO TEXT1
HANG 5
SET WVPOP=1
QUIT
+9 ;
+10 SET WVDFN=$PIECE(^WV(790.4,WVDA,0),U)
+11 SET WVPURP=$PIECE(^WV(790.4,WVDA,0),U,4)
+12 ;---> WVN=DATE OF "PRINT DATE", USE TO KILL "APRT" XREF BELOW.
+13 if '$DATA(WVKDT)
SET WVKDT=$PIECE(^WV(790.4,WVDA,0),U,11)
+14 ;---> IF NO PURPOSE (DELETED), KILL "APRT" XREF AND QUIT.
+15 IF 'WVPURP
Begin DoDot:1
+16 WRITE !!?5,"No Purpose of Notification has been chosen; therefore, this"
+17 WRITE !?5,"notification cannot be printed."
+18 DO KILLXREF(WVDA,WVKDT)
End DoDot:1
QUIT
+19 ;---> IF QUEUED AND WVCRT IS NOT SET, THEN SET IT.
+20 if '$DATA(WVCRT)
SET WVCRT=$SELECT($EXTRACT(IOST)="C":1,1:0)
+21 SET DIWF="^WV(790.404,WVPURP,1,"
+22 SET DIWF(1)=790
+23 SET BY="INTERNAL(#.01)="_WVDFN
+24 ;---> IF LOCKED, PROMPT DEVICE, QUIT AND LEAVE IN THE QUEUE.
+25 LOCK +^WV(790.4,WVDA):0
IF '$TEST
USE IO
Begin DoDot:1
+26 WRITE !!?5,"The selected Notification is being edited by another user."
+27 WRITE !?5,"Programmer information: Notification=^WV(790.4,"_WVDA_",0)."
+28 if 'WVCRT
WRITE @IOF
End DoDot:1
DO PROMPT
QUIT
+29 ;
+30 ;---> IF PATIENT IS DECEASED, DON'T PRINT LETTER; PRINT EXPLANATION,
+31 ;---> CHANGE THE STATUS OF THE NOTIFICATION TO "CLOSED", AND GIVE
+32 ;---> THE OUTCOME OF "PATIENT DECEASED".
+33 IF $$DECEASED^WVUTL1(WVDFN)
DO DECEASED
QUIT
+34 ;---> Compute future appointments
+35 ;kill off old computed appts.
DO KAPPT^WVUTL9(WVDFN)
+36 ;get future appts
DO GAPPT^WVUTL9(WVDFN)
+37 ;set appts in File 790
DO SAPPT^WVUTL9(WVDFN)
+38 ;kill off Utility global off future appts
DO KILLUG^WVUTL9
+39 ;kill off old computed address
DO KADD^WVUTL9(WVDFN)
+40 ;get current complete address
DO GADD^WVUTL9(WVDFN)
+41 ;set complete address in File 790
DO SADD^WVUTL9(WVDFN)
+42 ;clean-up VADPT variables used
DO KVAR^WVUTL9
+43 ;---> PRINT IT TO IOP, PRESERVE WVPOP.
+44 DO EN2^DIWF
+45 DO PROMPT
+46 ;---> DON'T STUFF "DATE PRINTED" IF IT ALREADY HAS A "DATE PRINTED".
+47 IF $PIECE(^WV(790.4,WVDA,0),U,10)]""
DO KILLXREF(WVDA,WVKDT)
LOCK -^WV(790.4,WVDA)
QUIT
+48 ;
+49 ;---> DON'T STUFF "DATE PRINTED" IF IT'S JUST TO THE SCREEN.
+50 IF WVCRT
Begin DoDot:1
+51 WRITE !!?3,"NOTE: Because this letter was only displayed on a screen and"
+52 WRITE !?9,"not printed on a printer, it will NOT yet be logged by the"
+53 WRITE !?9,"program as having been ""PRINTED"".",!
+54 LOCK -^WV(790.4,WVDA)
DO DIRZ^WVUTL3
End DoDot:1
QUIT
+55 ;
+56 ;---> NEXT LINES KILL "APRT" XREF AND SET "DATE PRINTED"=TODAY.
+57 ;---> ("APRT" XREF INDICATE A NOTIFICATION IS QUEUED TO BE PRINTED.)
+58 DO KILLXREF(WVDA,WVKDT)
+59 DO DIE^WVFMAN(790.4,".1////"_DT,WVDA)
+60 LOCK -^WV(790.4,WVDA)
QUIT
+61 QUIT
+62 ;
KILLXREF(WVDA,WVKDT) ;EP
+1 ;---> KILL "APRT" XREF (REMOVE LETTER FROM QUEUE).
+2 if '$GET(WVDA)
QUIT
if '$GET(WVKDT)
QUIT
+3 KILL ^WV(790.4,"APRT",WVKDT,WVDA)
+4 QUIT
+5 ;
DECEASED ;EP
+1 ;---> IF THE PATIENT IS DECEASED.
+2 ;---> DON'T STUFF "DATE PRINTED" IF IT'S JUST TO THE SCREEN.
+3 WRITE !!?3,"NOTE: Because this patient, ",$$NAME^WVUTL1(WVDFN)," #"
+4 WRITE $$SSN^WVUTL1(WVDFN),", is now"
+5 WRITE !?9,"registered as deceased, the letter will NOT be printed."
+6 WRITE !?9,"Instead, this notification will be given a status of CLOSED"
+7 WRITE !?9,"and an outcome of ""Patient Deceased""."
+8 if WVCRT&('$DATA(IO("S")))
DO DIRZ^WVUTL3
+9 if 'WVCRT
WRITE @IOF
+10 SET DR=".14////c;.05///Patient Deceased"
+11 DO DIE^WVFMAN(790.4,DR,WVDA)
+12 ;---> KILL "APRT" XREF (FLAGS NOTIFICATION AS QUEUED TO BE PRINTED).
+13 DO KILLXREF(WVDA,WVKDT)
+14 LOCK -^WV(790.4,WVDA)
+15 QUIT
+16 ;
PROMPT ;EP
+1 ;---> PROMPT IF NECESSARY, PROMPT DEVICE.
+2 if WVCRT
DO DIRZ^WVUTL3
+3 QUIT
+4 ;
NONE ;EP
+1 SET WVTITLE="* No letters selected for printing. *"
+2 DO CENTERT^WVUTL5(.WVTITLE)
+3 WRITE !!!!,WVTITLE,!!
+4 DO DIRZ^WVUTL3
+5 QUIT
+6 ;
TEXT1 ;EP
+1 ;;
+2 ;;* NOTE: The Facility with which this letter is associated does not
+3 ;; match the Facility under which you are currently logged on.
+4 ;; To print this Notification, you must either edit the Facility
+5 ;; for this Notification, or log off and log back in under the
+6 ;; same Facility with which the Notification is associated.
+7 SET WVTAB=5
SET WVLINL="TEXT1"
DO PRINTX
+8 QUIT
+9 ;
PRINTX ;EP
+1 NEW I,T,X
SET T=$$REPEAT^XLFSTR(" ",WVTAB)
+2 FOR I=1:1
SET X=$TEXT(@WVLINL+I)
if X'[";;"
QUIT
WRITE !,T,$PIECE(X,";;",2)
+3 QUIT
