Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: WVLETPR

WVLETPR.m

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