SDRRTSK1 ;10N20/MAH;Recall Reminder-Clinic Print Task; 09/20/2004
;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
;;This routine is called from SDRR TASK JOB CARD
;;and will be called if PARAM IS cards
START Q:'$D(^SD(403.53,0))
S CRP=0
F S CRP=$O(^SD(403.53,CRP)) Q:'CRP D
.S TYPE=$P($G(^SD(403.53,CRP,0)),"^",2)
.Q:TYPE["L"
.S DATE=$P($G(^SD(403.53,CRP,0)),"^",4) Q:DATE="" ;IF NOT SET ROUTINE WILL QUIT
.S X="T+"_DATE D ^%DT S (ZSDT,ZEDT)=Y K Y
.S (PRT,TEAM)=0
.F S TEAM=$O(^SD(403.55,"C",CRP,TEAM)) Q:TEAM="" S PRT=$P($G(^SD(403.55,TEAM,0)),"^",3) D
..Q:PRT=""
..S DA=PRT
..S DIC="^%ZIS(1,",DR=".01;1;3",DIQ="DPTR",DIQ(0)="I" D EN^DIQ1
..N IOP S IOP=$G(DPTR("3.5",DA,".01","I")) D ^%ZIS
..S PROV=0 F S PROV=$O(^SD(403.54,"C",TEAM,PROV)) Q:PROV="" D
...S D0=0 F S D0=$O(^SD(403.5,"C",PROV,D0)) Q:D0="" D
....S DTA=$G(^SD(403.5,D0,0))
....S TIME=""
....I $P(^SD(403.5,D0,0),"^",9)>45 S TIME=$P(^SD(403.5,D0,0),"^",9) S TIME="**"_TIME_"**"
....S LAB=$S($P($G(^SD(403.5,D0,0)),"^",8)="f":"**FL",$P(^SD(403.5,D0,0),"^",8)="n":"**NFL",1:"")
....S DFN=+DTA
....Q:$P(DTA,U,6)<ZSDT!($P(DTA,U,6)>ZEDT)
....Q:$$TESTPAT^VADPT(DFN)
....D ADD^VADPT,DEM^VADPT
....S STATE=$P(VAPA(5),"^",1),STATE=$$GET1^DIQ(5,STATE_",",1)
....S PN=$P(VADM(1),U)
....I $G(VADM(6),U)'="" Q
....N CHECK
....I $$BADADR^DGUTL3(DFN) S CHECK=1 S XMSUB="Bad Address for Recall Reminder Patient",XMTEXT="SDRR(" D
.....S XMY("G.SDRR BAD ADDRESS")="",XMDUZ=.5
.....S SDRR(1)="Bad Address- card will not be printed for:"_" "_PN_" "_VA("BID")
.....D ^XMD
.....K XMY,XMSUB,XMTEXT,XMDUZ
.....Q
.....;ADDED THE DATE INFORMATION
....I '$D(CHECK) S $P(^SD(403.5,D0,0),"^",10)=DT
....Q:$D(CHECK)
....U IO
....W @IOF F L=1:1:7 W !
....W !?20,$P(PN,",",2)," ",$P(PN,",")
....I $P(VAPA(1),U)'="" W !?20,$P(VAPA(1),U)
....I $P(VAPA(2),U)'="" W !?20,$P(VAPA(2),U)
....I $P(VAPA(3),U)'="" W !?20,$P(VAPA(3),U)
....W !?20,$P(VAPA(4),U),", "_STATE_" ",$P(VAPA(6),U)
....I TIME'="" W !!?45,TIME
....I LAB'="" W !,?45,LAB
..D ^%ZISC
K DPTR,DEVSB,DEVSB1,DIQ,DEVSB1,DA,DA1,DR
QUIT K DEV,PRT,ADTA,D0,DFN,DIC,DIR,DIRUT,DTA,I,L,PN,POP,Y,ZDIV,ZEDT,ZPR,ZSDT,FAST,TIME,ACC,TYPE,PTN,CRP,STATE
K LINE,LETTER,MESSAGE,TEST,CLINIC,DA,DATE,DEV1,DEVSB,DOD,FAIL,PROV,TEAM,X,DPT,LAB,SDRR,VA,LAB,DPT,SDRR,VA
D KVAR^VADPT
Q
SDRRTSK1 ;10N20/MAH;Recall Reminder-Clinic Print Task; 09/20/2004
+1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
+2 ;;This routine is called from SDRR TASK JOB CARD
+3 ;;and will be called if PARAM IS cards
START IF '$DATA(^SD(403.53,0))
QUIT
+1 SET CRP=0
+2 FOR
SET CRP=$ORDER(^SD(403.53,CRP))
IF 'CRP
QUIT
Begin DoDot:1
+3 SET TYPE=$PIECE($GET(^SD(403.53,CRP,0)),"^",2)
+4 IF TYPE["L"
QUIT
+5 ;IF NOT SET ROUTINE WILL QUIT
SET DATE=$PIECE($GET(^SD(403.53,CRP,0)),"^",4)
IF DATE=""
QUIT
+6 SET X="T+"_DATE
DO ^%DT
SET (ZSDT,ZEDT)=Y
KILL Y
+7 SET (PRT,TEAM)=0
+8 FOR
SET TEAM=$ORDER(^SD(403.55,"C",CRP,TEAM))
IF TEAM=""
QUIT
SET PRT=$PIECE($GET(^SD(403.55,TEAM,0)),"^",3)
Begin DoDot:2
+9 IF PRT=""
QUIT
+10 SET DA=PRT
+11 SET DIC="^%ZIS(1,"
SET DR=".01;1;3"
SET DIQ="DPTR"
SET DIQ(0)="I"
DO EN^DIQ1
+12 NEW IOP
SET IOP=$GET(DPTR("3.5",DA,".01","I"))
DO ^%ZIS
+13 SET PROV=0
FOR
SET PROV=$ORDER(^SD(403.54,"C",TEAM,PROV))
IF PROV=""
QUIT
Begin DoDot:3
+14 SET D0=0
FOR
SET D0=$ORDER(^SD(403.5,"C",PROV,D0))
IF D0=""
QUIT
Begin DoDot:4
+15 SET DTA=$GET(^SD(403.5,D0,0))
+16 SET TIME=""
+17 IF $PIECE(^SD(403.5,D0,0),"^",9)>45
SET TIME=$PIECE(^SD(403.5,D0,0),"^",9)
SET TIME="**"_TIME_"**"
+18 SET LAB=$SELECT($PIECE($GET(^SD(403.5,D0,0)),"^",8)="f":"**FL",$PIECE(^SD(403.5,D0,0),"^",8)="n":"**NFL",1:"")
+19 SET DFN=+DTA
+20 IF $PIECE(DTA,U,6)<ZSDT!($PIECE(DTA,U,6)>ZEDT)
QUIT
+21 IF $$TESTPAT^VADPT(DFN)
QUIT
+22 DO ADD^VADPT
DO DEM^VADPT
+23 SET STATE=$PIECE(VAPA(5),"^",1)
SET STATE=$$GET1^DIQ(5,STATE_",",1)
+24 SET PN=$PIECE(VADM(1),U)
+25 IF $GET(VADM(6),U)'=""
QUIT
+26 NEW CHECK
+27 IF $$BADADR^DGUTL3(DFN)
SET CHECK=1
SET XMSUB="Bad Address for Recall Reminder Patient"
SET XMTEXT="SDRR("
Begin DoDot:5
+28 SET XMY("G.SDRR BAD ADDRESS")=""
SET XMDUZ=.5
+29 SET SDRR(1)="Bad Address- card will not be printed for:"_" "_PN_" "_VA("BID")
+30 DO ^XMD
+31 KILL XMY,XMSUB,XMTEXT,XMDUZ
+32 QUIT
+33 ;ADDED THE DATE INFORMATION
End DoDot:5
+34 IF '$DATA(CHECK)
SET $PIECE(^SD(403.5,D0,0),"^",10)=DT
+35 IF $DATA(CHECK)
QUIT
+36 USE IO
+37 WRITE @IOF
FOR L=1:1:7
WRITE !
+38 WRITE !?20,$PIECE(PN,",",2)," ",$PIECE(PN,",")
+39 IF $PIECE(VAPA(1),U)'=""
WRITE !?20,$PIECE(VAPA(1),U)
+40 IF $PIECE(VAPA(2),U)'=""
WRITE !?20,$PIECE(VAPA(2),U)
+41 IF $PIECE(VAPA(3),U)'=""
WRITE !?20,$PIECE(VAPA(3),U)
+42 WRITE !?20,$PIECE(VAPA(4),U),", "_STATE_" ",$PIECE(VAPA(6),U)
+43 IF TIME'=""
WRITE !!?45,TIME
+44 IF LAB'=""
WRITE !,?45,LAB
End DoDot:4
End DoDot:3
+45 DO ^%ZISC
End DoDot:2
End DoDot:1
+46 KILL DPTR,DEVSB,DEVSB1,DIQ,DEVSB1,DA,DA1,DR
QUIT KILL DEV,PRT,ADTA,D0,DFN,DIC,DIR,DIRUT,DTA,I,L,PN,POP,Y,ZDIV,ZEDT,ZPR,ZSDT,FAST,TIME,ACC,TYPE,PTN,CRP,STATE
+1 KILL LINE,LETTER,MESSAGE,TEST,CLINIC,DA,DATE,DEV1,DEVSB,DOD,FAIL,PROV,TEAM,X,DPT,LAB,SDRR,VA,LAB,DPT,SDRR,VA
+2 DO KVAR^VADPT
+3 QUIT
