- 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 Feb 19, 2025@00:13:39 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