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

SDRRRECL.m

Go to the documentation of this file. 
  1. SDRRRECL ;10N20/MAH;Recall Reminder Manual Printing; 09/20/2004
  1.  ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
  1.  ;;This routine is called from SDRRLRP 
  1.  ;;If the site has set TYPE OF NOTIFICATION to LETTER this routine
  1.  ;;will run.
  1.  K TYPE
  1. MEN ;SET UP WHAT ARE THEY WOULD LIKE TO PRINT FOR LETTERS
  1.  K DIR,Y,DTOUT,DIROUT,DIRUT,DUOUT
  1.  S DIR(0)="SO^1:Print Letters by Clinic;2:Print Letters by Provider;3:Print Letters by Team;4:Print a Letter by Patient;5:Print Letters for Nonresponsive Patients"
  1.  W ! S DIR("A")="Please select what you are looking for"
  1.  D ^DIR G:$D(DUOUT)!($D(DTOUT)!($D(DIRUT))) QUIT S Q=Y
  1.  I Q=1 G EN
  1.  I Q=2 G EN1
  1.  I Q=3 G EN3
  1.  I Q=4 G EN4
  1.  I Q=5 G EN5
  1.  Q
  1. EN ;PRINT BY CLINIC
  1.  S DIC="^SC(",DIC(0)="AEQMZ" D ^DIC Q:Y<0  S DIV=+Y G:Y<0 QUIT
  1.  I '$D(^SD(403.52,"B",DIV)) W !,?5,"**NO RECALL LETTER ON FILE**" G QUIT
  1.  D SELDT G:Y<0 QUIT  ;SD*561 quit if no date range entered
  1.  S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Recall Letters by Clinic",ZTRTN="DQD^SDRRRECL" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
  1. DQD K ^TMP($J)
  1.  U IO S D0=0 F  S D0=$O(^SD(403.5,"E",DIV,D0)) Q:D0=""  S DTA=$G(^SD(403.5,D0,0)) D:DTA]""
  1.  .S TIME=""
  1.  .I $P(^SD(403.5,D0,0),"^",9)>30 S TIME=$P(^SD(403.5,D0,0),"^",9) S TIME="**"_TIME_"**"
  1.  .S LAB=$S($P($G(^SD(403.5,D0,0)),"^",8)="f":"Lab test(s) have been ordered that require you to FAST",$P(^SD(403.5,D0,0),"^",8)="n":"Lab test(s) have been ordered, which need to be done before an appointment is made",1:"")
  1.  .S DFN=+DTA
  1.  .Q:$P(DTA,U,6)<SDT!($P(DTA,U,6)>EDT)
  1.  .Q:$$TESTPAT^VADPT(DFN)
  1.  .D ADD^VADPT,DEM^VADPT
  1.  .S STATE=$P(VAPA(5),"^",1),STATE=$$GET1^DIQ(5,STATE_",",1)
  1.  .S PN=$P(VADM(1),U)
  1.  .I $G(VADM(6),U)'="" Q
  1.  .S CHECK=$$BADADR^DGUTL3 I CHECK>0 S XMSUB="Bad Address for Recall Reminder Patient",XMTEXT="SDRR(" D
  1.  ..S XMY("G.SDRR BAD ADDRESS")="",XMDUZ=.5
  1.  ..S SDRR(1)="Bad Address- card will not be printed for:"_"   "_PN_"   "_VA("BID")
  1.  ..D ^XMD
  1.  ..K XMY,XMSUB,XMTEXT,XMDUZ
  1.  .;ADDED THE DATE INFORMATION
  1.  .S $P(^SD(403.5,D0,0),"^",10)=DT
  1.  .D PR
  1.  D ^%ZISC G QUIT
  1.  ;;done and tested
  1. QUIT K ADTA,D0,DFN,DIC,DIR,DIRUT,DTA,I,L,PN,POP,Y,DIV,EDT,PR,SDT,FAST,TIME,ACC
  1.  K LINE,LETTER,MESSAGE,TEST,DOD,CLINIC,FAIL,TEAM,LAB,SDRR,Q,%DT,%ZIS,CHECK,VA,ZTDESC,ZTIO,ZTRTN,ZTSAVE,STATE Q
  1.  D KVAR^VADPT
  1.  Q
  1. SELDT S %DT="AEX",%DT("A")="Start with RECALL DATE: " D ^%DT Q:Y<0  S SDT=Y,%DT("A")="End with RECALL DATE: " D ^%DT I Y<SDT W $C(7),"  ??" G SELDT
  1.  S EDT=Y Q
  1. PR S LETTER=0
  1.  W @IOF F L=1:1:11 W !
  1.  W !?20,$P(PN,",",2)," ",$P(PN,",")
  1.  I $P(VAPA(1),U)'="" W !?20,$P(VAPA(1),U)
  1.  I $P(VAPA(2),U)'="" W !?20,$P(VAPA(2),U)
  1.  I $P(VAPA(3),U)'="" W !?20,$P(VAPA(3),U)
  1.  W !?20,$P(VAPA(4),U),", "_STATE_"  ",$P(VAPA(6),U)
  1.  I $D(MESSAGE) W !!!!!,?25,MESSAGE
  1.  ; SD*569 - Adjust the tab starting position
  1.  I TIME'="" W !!!!?2,TIME
  1.  I LAB'="" W !!!!!,?2,"*"_LAB
  1.  W !!!
  1.  S:'$D(MESSAGE) LETTER=$O(^SD(403.52,"B",DIV,LETTER))
  1.  I LETTER>0 S LINE=0 F  S LINE=$O(^SD(403.52,LETTER,1,LINE)) Q:'LINE  W !,?2,$P(^SD(403.52,LETTER,1,LINE,0),"^",1)
  1.  K MESSAGE
  1.  Q
  1. EN1 ;print letters by provider
  1.  S DIC="^SD(403.54,",DIC(0)="AEQMZ",DIC("A")="Select Provider: " D ^DIC G:Y<0 QUIT S PR=+Y
  1.  D SELDT G:Y<0 QUIT  ;SD*5.3*561 quit if no date range entered
  1.  S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Recall Letters by Provider",ZTRTN="DQD1^SDRRRECL" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
  1. DQD1 K ^TMP($J)
  1.  U IO S D0=0 F  S D0=$O(^SD(403.5,"C",PR,D0)) Q:D0=""  S (CLINIC,FAIL)=0 S CLINIC=$P($G(^SD(403.5,D0,0)),"^",2) D
  1.  .S DTA=$G(^SD(403.5,D0,0))
  1.  .I CLINIC="" S FAIL=1 S MESSAGE="***NO CLINIC ON FILE**"
  1.  .I CLINIC'=""  I '$D(^SD(403.52,"B",CLINIC))  S MESSAGE="***NO CLINIC LETTER ON FILE**" S FAIL=1
  1.  .I CLINIC'="",(FAIL=0) S DIV=CLINIC S LETTER=0,LETTER=$O(^SD(403.52,"B",CLINIC,LETTER))
  1.  .S TIME=""
  1.  .I $P(^SD(403.5,D0,0),"^",9)>30 S TIME=$P(^SD(403.5,D0,0),"^",9) S TIME="**"_TIME_"**"
  1.  .S LAB=$S($P($G(^SD(403.5,D0,0)),"^",8)="f":"Lab test(s) have been ordered that require you to FAST",$P(^SD(403.5,D0,0),"^",8)="n":"Lab test(s) have been ordered, which need to be done before an appointment is made",1:"")
  1.  .S DFN=+DTA
  1.  .Q:$P(DTA,U,6)<SDT!($P(DTA,U,6)>EDT)
  1.  .Q:$$TESTPAT^VADPT(DFN)
  1.  .D ADD^VADPT,DEM^VADPT
  1.  .S STATE=$P(VAPA(5),"^",1),STATE=$$GET1^DIQ(5,STATE_",",1)
  1.  .S PN=$P(VADM(1),U)
  1.  .I $G(VADM(6),U)'="" Q
  1.  .S CHECK=$$BADADR^DGUTL3 I CHECK>0 S XMSUB="Bad Address for Recall Reminder Patient",XMTEXT="SDRR(" D
  1.  ..S XMY("G.SDRR BAD ADDRESS")="",XMDUZ=.5
  1.  ..S SDRR(1)="Bad Address- card will not be printed for:"_"   "_PN_"   "_VA("BID")
  1.  ..D ^XMD
  1.  ..K XMY,XMSUB,XMTEXT,XMDUZ
  1.  .;ADDED THE DATE INFORMATION
  1.  .S $P(^SD(403.5,D0,0),"^",10)=DT
  1.  .D PR
  1.  D ^%ZISC G QUIT
  1. EN3 ;PRINT LETTER FOR A TEAM
  1.  W ! S DIC="^SD(403.55,",DIC(0)="AEQMZ",DIC("A")="Select Clinic Recall Team: " D ^DIC S TEAM=+Y K DIC G:Y<0 QUIT
  1.  D SELDT G:Y<0 QUIT  ;SD*561 quit if no date range entered
  1.  S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Recall Letters for a Team",ZTRTN="DQD4^SDRRRECL" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
  1. DQD4 S PR=0 F  S PR=$O(^SD(403.54,"C",TEAM,PR)) Q:'PR  S D0=0 D
  1.  .F  S D0=$O(^SD(403.5,"C",PR,D0)) Q:D0=""  S (CLINIC,FAIL)=0 S CLINIC=$P($G(^SD(403.5,D0,0)),"^",2) D
  1.  ..S DTA=$G(^SD(403.5,D0,0))
  1.  ..I CLINIC="" S FAIL=1 S MESSAGE="***NO CLINIC ON FILE**"
  1.  ..I CLINIC'=""  I '$D(^SD(403.52,"B",CLINIC))  S MESSAGE="***NO CLINIC LETTER ON FILE**" S FAIL=1
  1.  ..I CLINIC'="",(FAIL=0) S DIV=CLINIC S LETTER=0,LETTER=$O(^SD(403.52,"B",CLINIC,LETTER))
  1.  ..S TIME=""
  1.  ..I $P(^SD(403.5,D0,0),"^",9)>30 S TIME=$P(^SD(403.5,D0,0),"^",9) S TIME="**"_TIME_"**"
  1.  ..S LAB=$S($P($G(^SD(403.5,D0,0)),"^",8)="f":"Lab test(s) have been ordered that require you to FAST",$P(^SD(403.5,D0,0),"^",8)="n":"Lab test(s) have been ordered, which need to be done before an appointment is made",1:"")
  1.  ..S DFN=+DTA
  1.  ..Q:$P(DTA,U,6)<SDT!($P(DTA,U,6)>EDT)  ;SD*561 check selected date range
  1.  ..Q:$$TESTPAT^VADPT(DFN)
  1.  ..D ADD^VADPT,DEM^VADPT
  1.  ..S STATE=$P(VAPA(5),"^",1),STATE=$$GET1^DIQ(5,STATE_",",1)
  1.  ..S PN=$P(VADM(1),U)
  1.  ..I $G(VADM(6),U)'="" Q
  1.  ..S CHECK=$$BADADR^DGUTL3 I CHECK>0 S XMSUB="Bad Address for Recall Reminder Patient",XMTEXT="SDRR(" D
  1.  ...S XMY("G.SDRR BAD ADDRESS")="",XMDUZ=.5
  1.  ...S SDRR(1)="Bad Address- card will not be printed for:"_"   "_PN_"   "_VA("BID")
  1.  ...D ^XMD
  1.  ...K XMY,XMSUB,XMTEXT,XMDUZ
  1.  ..;ADDED THE DATE INFORMATION
  1.  ..S $P(^SD(403.5,D0,0),"^",10)=DT
  1.  ..D PR
  1.  D ^%ZISC G QUIT
  1.  ;done and tested
  1. EN4 ;PRINT LETTER FOR ONE PATIENT
  1.  W ! S DIC="^SD(403.5,",DIC(0)="AEQMZ",DIC("A")="Select Patient: " D ^DIC S D0=+Y K DIC G:Y<0 QUIT
  1.  S DIC="^SC(",DIC(0)="AEQMZ" D ^DIC Q:Y<0  S DIV=+Y K DIC G:Y<0 QUIT
  1.  I '$D(^SD(403.52,"B",DIV)) W !,?5,"**NO RECALL LETTER ON FILE**" G QUIT
  1.  I '$D(^SD(403.5,"E",DIV,D0)) W *7,!!,?5,"**This patient does not have a recall reminder for the selected clinic**",!! G QUIT
  1.  S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Recall Letters for a Patient",ZTRTN="DQD3^SDRRRECL" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
  1. DQD3 K ^TMP($J)
  1.  S DTA=$G(^SD(403.5,D0,0)) D:DTA]""
  1.  .; SD*569 - Quit if patient's clinic does not match the selected hospital location.
  1.  .I $P(DTA,"^",2)'=DIV Q
  1.  .S TIME=""
  1.  .I $P(^SD(403.5,D0,0),"^",9)>30 S TIME=$P(^SD(403.5,D0,0),"^",9) S TIME="**"_TIME_"**"
  1.  .S LAB=$S($P($G(^SD(403.5,D0,0)),"^",8)="f":"Lab test(s) have been ordered that require you to FAST",$P(^SD(403.5,D0,0),"^",8)="n":"Lab test(s) have been ordered, which need to be done before an appointment is made",1:"")
  1.  .S DFN=+DTA
  1.  .Q:$$TESTPAT^VADPT(DFN)
  1.  .D ADD^VADPT,DEM^VADPT
  1.  .S STATE=$P(VAPA(5),"^",1),STATE=$$GET1^DIQ(5,STATE_",",1)
  1.  .S PN=$P(VADM(1),U)
  1.  .I $G(VADM(6),U)'="" Q
  1.  .S CHECK=$$BADADR^DGUTL3 I CHECK>0 S XMSUB="Bad Address for Recall Reminder Patient",XMTEXT="SDRR(" D
  1.  ..S XMY("G.SDRR BAD ADDRESS")="",XMDUZ=.5
  1.  ..S SDRR(1)="Bad Address- card will not be printed for:"_"   "_PN_"   "_VA("BID")
  1.  ..D ^XMD
  1.  ..K XMY,XMSUB,XMTEXT,XMDUZ
  1.  .;ADDED THE DATE INFORMATION
  1.  .S $P(^SD(403.5,D0,0),"^",10)=DT
  1.  .D PR
  1.  D ^%ZISC G QUIT
  1. EN5 ;Print LETTERS for Nonresponsive
  1.  S TEAM=""
  1.  S DIC="^SD(403.55,",DIC(0)="AEQMZ",DIC("A")="Select Clinic Recall Team: " D ^DIC S TEAM=+Y K DIC G:TEAM<0 QUIT
  1.  S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Recall Letters for Nonresponsive",ZTRTN="DQD5^SDRRRECL" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
  1. DQD5 N CHKDATE
  1.  ;SD*5.3*561 remove extraneous write command following $O on next line
  1.  S PR=0,CHKDATE=5 F  S PR=$O(^SD(403.54,"C",TEAM,PR)) Q:'PR  D
  1.  .S D0=0 F  S D0=$O(^SD(403.5,"C",PR,D0)) Q:'D0  S (CLINIC,FAIL)=0 S CLINIC=$P($G(^SD(403.5,D0,0)),"^",2) D
  1.  ..I $P($G(^SD(403.5,D0,0)),"^",10)="" QUIT
  1.  ..; SD*569 - Prevent from printing more than ONE second letter.
  1.  ..I $P($G(^SD(403.5,D0,0)),"^",13)'="" QUIT
  1.  ..S RDATE=$P($G(^SD(403.5,D0,0)),"^",6) S CHECK=$$FMDIFF^XLFDT(RDATE,DT) I CHECK>CHKDATE K RDATE QUIT
  1.  ..S DTA=$G(^SD(403.5,D0,0))
  1.  ..I CLINIC="" S FAIL=1 S MESSAGE="***NO CLINIC ON FILE**"
  1.  ..I CLINIC'=""  I '$D(^SD(403.52,"B",CLINIC))  S MESSAGE="***NO CLINIC LETTER ON FILE**" S FAIL=1
  1.  ..I CLINIC'="",(FAIL=0) S DIV=CLINIC S LETTER=0,LETTER=$O(^SD(403.52,"B",CLINIC,LETTER))
  1.  ..S TIME=""
  1.  ..I $P(^SD(403.5,D0,0),"^",9)>30 S TIME=$P(^SD(403.5,D0,0),"^",9) S TIME="**"_TIME_"**"
  1.  ..S LAB=$S($P($G(^SD(403.5,D0,0)),"^",8)="f":"Lab test(s) have been ordered that require you to FAST",$P(^SD(403.5,D0,0),"^",8)="n":"Lab test(s) have been ordered, which need to be done before an appointment is made",1:"")
  1.  ..S DFN=+DTA
  1.  ..Q:$$TESTPAT^VADPT(DFN)
  1.  ..D ADD^VADPT,DEM^VADPT
  1.  ..S STATE=$P(VAPA(5),"^",1),STATE=$$GET1^DIQ(5,STATE_",",1)
  1.  ..S PN=$P(VADM(1),U)
  1.  ..I $G(VADM(6),U)'="" Q
  1.  ..S CHECK=$$BADADR^DGUTL3 I CHECK>0 S XMSUB="Bad Address for Recall Reminder Patient",XMTEXT="SDRR(" D
  1.  ...S XMY("G.SDRR BAD ADDRESS")="",XMDUZ=.5
  1.  ...S SDRR(1)="Bad Address- card will not be printed for:"_"   "_PN_"   "_VA("BID")
  1.  ...D ^XMD
  1.  ...K XMY,XMSUB,XMTEXT,XMDUZ
  1.  ..;ADDED THE DATE INFORMATION
  1.  ..S $P(^SD(403.5,D0,0),"^",13)=DT
  1.  ..D PR
  1.  D ^%ZISC G QUIT
  1.  Q