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

SDRRRECP.m

Go to the documentation of this file. 
  1. SDRRRECP ;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 CARDS this routine
  1.  ;;will run.
  1.  K TYPE
  1. MEN ;SET UP WHAT ARE THEY WOULD LIKE TO PRINT FOR CARDS
  1.  K DIR,Y,DTOUT,DIROUT,DIRUT,DUOUT
  1.  S DIR(0)="SO^1:Print Cards by Division;2:Print Cards by Clinic;3:Print Cards by Provider;4:Print Cards by Team;5:Print a Card by Patient;6:Print Cards 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 EN3
  1.  I Q=2 G EN
  1.  I Q=3 G EN2
  1.  I Q=4 G EN1
  1.  I Q=5 G EN4
  1.  I Q=6 G EN5
  1.  Q
  1.  ;ALLK Q,Y,DIR
  1. EN3 ;PRINT BY DIVISION
  1.  S DIC="^DG(40.8,",DIC(0)="AEQMZ" D ^DIC G:Y<0 QUIT S DIV=+Y D SELDT G:Y<0 QUIT
  1.  S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDSC="Print Recall Cards by Division",ZTRTN="DQD1^SDRRRECP" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
  1. DQD1 K ^TMP($J)
  1.  S PR=0 F  S PR=$O(^SD(403.5,"C",PR)) Q:PR=""  I $P($G(^SD(403.54,PR,0)),"^",3)=DIV S D0=0 F  S D0=$O(^SD(403.5,"C",PR,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)["60" 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":"**FL",$P(^SD(403.5,D0,0),"^",8)="n":"**NFL",1:"")
  1.  .S DFN=+DTA
  1.  .Q:$$TESTPAT^VADPT(DFN)
  1.  .D ADD^VADPT,DEM^VADPT
  1.  .S PN=$P(VADM(1),U)
  1.  .S STATE=$P(VAPA(5),"^",1),STATE=$$GET1^DIQ(5,STATE_",",1)
  1.  .I $G(VADM(6),U)'="" Q
  1.  .Q:$P(DTA,"^",6)<SDT!($P(DTA,"^",6)>EDT) 
  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. EN ;PRINT BY CLINIC
  1.  S DIC="^SC(",DIC(0)="AEQMZ" D ^DIC Q:Y<0  S DIV=+Y D SELDT G:Y<0 QUIT
  1.  S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Recall Cards by Clinic",ZTRTN="DQD^SDRRRECP" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
  1. DQD K ^TMP($J)
  1.  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)["60" 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":"**FL",$P(^SD(403.5,D0,0),"^",8)="n":"**NFL",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.  .Q:$P(DTA,"^",6)<SDT!($P(DTA,"^",6)>EDT) 
  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. QUIT K ADTA,D0,DFN,DIC,DIR,DIRUT,DTA,I,L,PN,POP,Y,DIV,EDT,PR,SDT,TIME,LAB,Y,STATE
  1.  K DATE,DOD,X,Q,%DT,%ZIS,SDRR,VA,CHECK,ZTDESC,ZTDSC,ZTEAM,ZTIO,ZTRTN,ZTSAVE
  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 W @IOF F L=1:1:7 W !
  1.  W !?20,$P($P(PN,",",2)," ",1)_" "_$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 TIME'="" W !!?45,TIME
  1.  I LAB'="" W !!?45,LAB
  1.  Q
  1. EN1 ;PRINT BY TEAM
  1.  S DIC="^SD(403.55,",DIC(0)="AEQMZ",DIC("A")="Select Clinic Team: " D ^DIC Q:Y<0  S ZTEAM=+Y D SELDT G:Y<0 QUIT
  1.  S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Recall Cards by Team",ZTRTN="DQT^SDRRRECP" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
  1. DQT K ^TMP($J)
  1.  S PR=0 F  S PR=$O(^SD(403.5,"C",PR)) Q:PR=""  I $P($G(^SD(403.54,PR,0)),U,2)=+ZTEAM S D0=0 F  S D0=$O(^SD(403.5,"C",PR,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)["60" 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":"**FL",$P(^SD(403.5,D0,0),"^",8)="n":"**NFL",1:"")
  1.  .S DFN=+DTA
  1.  .Q:$$TESTPAT^VADPT(DFN)
  1.  .D ADD^VADPT,DEM^VADPT
  1.  .S PN=$P(VADM(1),U)
  1.  .S STATE=$P(VAPA(5),"^",1),STATE=$$GET1^DIQ(5,STATE_",",1)
  1.  .I $G(VADM(6),U)'="" Q
  1.  .Q:$P(DTA,"^",6)<SDT!($P(DTA,"^",6)>EDT) 
  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.  ..D ^%ZISC G QUIT
  1.  .;ADDED THE DATE INFORMATION
  1.  .S $P(^SD(403.5,D0,0),"^",10)=DT
  1.  .D PR
  1.  D ^%ZISC G QUIT
  1. EN2 ;PRINT BY PROV
  1.  S DIC="^SD(403.54,",DIC(0)="AEQMZ",DIC("A")="Select Provider: " D ^DIC G:Y<0 QUIT S PR=+Y  D SELDT G:Y<0 QUIT
  1.  S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Recall Cards by Prov",ZTRTN="DQP^SDRRRECP" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
  1. DQP K ^TMP($J)
  1.  S D0=0 F  S D0=$O(^SD(403.5,"C",PR,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":"**FL",$P(^SD(403.5,D0,0),"^",8)="n":"**NFL",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.  .Q:$P(DTA,"^",6)<SDT!($P(DTA,"^",6)>EDT) 
  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. EN4 ;PRINT BY Patient
  1.  W ! S DIC="^SD(403.5,",DIC(0)="AEQMZ",DIC("A")="Select Patient: " D ^DIC G:Y<0 QUIT S D0=+Y
  1.  S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Recall Cards by Prov",ZTRTN="DPP^SDRRRECP" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
  1. DPP K ^TMP($J)
  1.  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":"**FL",$P(^SD(403.5,D0,0),"^",8)="n":"**NFL",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 BY TEAM
  1.  S DIC="^SD(403.55,",DIC(0)="AEQMZ",DIC("A")="Select Clinic Team: " D ^DIC S ZTEAM=+Y G:Y<0 QUIT
  1.  S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Nonresponsive Recall Cards by Team",ZTRTN="DQDD^SDRRRECP" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
  1. DQDD K ^TMP($J)
  1.  N CHKDATE
  1.  S PR=0 F  S PR=$O(^SD(403.5,"C",PR)) Q:PR=""  I $P($G(^SD(403.54,PR,0)),U,2)=+ZTEAM S D0=0 F  S D0=$O(^SD(403.5,"C",PR,D0)) Q:D0=""  S DTA=$G(^SD(403.5,D0,0)) D:DTA]""
  1.  .I $P($G(^SD(403.5,D0,0)),"^",10)="" QUIT
  1.  .; SD*569 - Prevent from printing more than ONE second card
  1.  .I $P($G(^SD(403.5,D0,0)),"^",13)'="" QUIT
  1.  .S CHKDATE=5 S RDATE=$P($G(^SD(403.5,D0,0)),"^",6) S CHECK=$$FMDIFF^XLFDT(RDATE,DT) I CHECK>CHKDATE K RDATE QUIT
  1.  .S TIME=""
  1.  .I $P(^SD(403.5,D0,0),"^",9)["60" 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":"**FL",$P(^SD(403.5,D0,0),"^",8)="n":"**NFL",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