SDRRTSK ;10N20/MAH;Recall Reminder-Clinic Print Task; 01/15/2008
;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
;THIS ROUTINE WILL PRINT LETTER FOR SELECTED METHOD OF PRINTING
;WILL LOOK AT CLINIC RECALL LOCATION
DATE ;lOOKS TO SEE HOW MANY DAYS IN ADVANCE TO PRINT LETTER
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["C"
.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 (MESSAGE,D0,LETTER)=0 F S D0=$O(^SD(403.5,"C",PROV,D0)) Q:D0="" S (CLINIC,FAIL)=0 S CLINIC=$P($G(^SD(403.5,D0,0)),"^",2) D
....S DTA=$G(^SD(403.5,D0,0))
....I CLINIC="" S MESSAGE="***NO CLINIC ON FILE**"
....I CLINIC'="" I '$D(^SD(403.52,"B",CLINIC)) S MESSAGE="***NO CLINIC LETTER ON FILE**" S FAIL=1
....I CLINIC'="",(FAIL=0) S ZDIV=CLINIC S LETTER=0,LETTER=$O(^SD(403.52,"B",CLINIC,LETTER))
....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":"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:"")
....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 ;NEW CODE
....Q:$D(CHECK)
....U IO
....W @IOF F L=1:1:11 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 LETTER=0 W !!!!!,?25,MESSAGE
....I TIME'="" W !!!!?2,"**"_TIME
....I LAB'="" W !!!!!,?2,"*"_LAB
....W !!!
....S:'$D(MESSAGE) LETTER=$O(^SD(403.52,"B",CLINIC,LETTER))
....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)
..D ^%ZISC
K DPTR,DEVSB,DEVSB1,DIQ,DEVSB1,DA,DA1,DR
K MESSAGE,LETTER
QUIT K DEV,PRT,ADTA,D0,DFN,DIC,DIR,DIRUT,DTA,I,L,PN,POP,Y,ZDIV,ZEDT,ZPR,ZSDT,FAST,TIME,ACC,LAB,STATE
K LINE,LETTER,MESSAGE,TEST,CLINIC,DA,DATE,DEV1,DEVSB,DOD,FAIL,PROV,TEAM,X,PROV,TEAM,CRP,DATE,TYPE,SDRR,DPT,VA
D KVAR^VADPT
Q
SDRRTSK ;10N20/MAH;Recall Reminder-Clinic Print Task; 01/15/2008
+1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
+2 ;THIS ROUTINE WILL PRINT LETTER FOR SELECTED METHOD OF PRINTING
+3 ;WILL LOOK AT CLINIC RECALL LOCATION
DATE ;lOOKS TO SEE HOW MANY DAYS IN ADVANCE TO PRINT LETTER
+1 IF '$DATA(^SD(403.53,0))
QUIT
+2 SET CRP=0
+3 FOR
SET CRP=$ORDER(^SD(403.53,CRP))
IF 'CRP
QUIT
Begin DoDot:1
+4 SET TYPE=$PIECE($GET(^SD(403.53,CRP,0)),"^",2)
+5 IF TYPE["C"
QUIT
+6 ;IF NOT SET ROUTINE WILL QUIT
SET DATE=$PIECE($GET(^SD(403.53,CRP,0)),"^",4)
IF DATE=""
QUIT
+7 SET X="T+"_DATE
DO ^%DT
SET (ZSDT,ZEDT)=Y
KILL Y
+8 SET (PRT,TEAM)=0
+9 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
+10 IF PRT=""
QUIT
+11 SET DA=PRT
+12 SET DIC="^%ZIS(1,"
SET DR=".01;1;3"
SET DIQ="DPTR"
SET DIQ(0)="I"
DO EN^DIQ1
+13 NEW IOP
SET IOP=$GET(DPTR("3.5",DA,".01","I"))
DO ^%ZIS
+14 SET PROV=0
FOR
SET PROV=$ORDER(^SD(403.54,"C",TEAM,PROV))
IF PROV=""
QUIT
Begin DoDot:3
+15 SET (MESSAGE,D0,LETTER)=0
FOR
SET D0=$ORDER(^SD(403.5,"C",PROV,D0))
IF D0=""
QUIT
SET (CLINIC,FAIL)=0
SET CLINIC=$PIECE($GET(^SD(403.5,D0,0)),"^",2)
Begin DoDot:4
+16 SET DTA=$GET(^SD(403.5,D0,0))
+17 IF CLINIC=""
SET MESSAGE="***NO CLINIC ON FILE**"
+18 IF CLINIC'=""
IF '$DATA(^SD(403.52,"B",CLINIC))
SET MESSAGE="***NO CLINIC LETTER ON FILE**"
SET FAIL=1
+19 IF CLINIC'=""
IF (FAIL=0)
SET ZDIV=CLINIC
SET LETTER=0
SET LETTER=$ORDER(^SD(403.52,"B",CLINIC,LETTER))
+20 SET TIME=""
+21 IF $PIECE(^SD(403.5,D0,0),"^",9)>45
SET TIME=$PIECE(^SD(403.5,D0,0),"^",9)
SET TIME="**"_TIME_"**"
+22 SET LAB=$SELECT($PIECE($GET(^SD(403.5,D0,0)),"^",8)="f":"Lab test(s) have been ordered that require you to FAST",$PIECE(^SD(403.5,D0,0),"^",8)="n":"Lab test(s) have been ordered,which need to be done before an ap
pointment is made",1:"")
+23 SET DFN=+DTA
+24 IF $PIECE(DTA,U,6)<ZSDT!($PIECE(DTA,U,6)>ZEDT)
QUIT
+25 IF $$TESTPAT^VADPT(DFN)
QUIT
+26 DO ADD^VADPT
DO DEM^VADPT
+27 SET STATE=$PIECE(VAPA(5),"^",1)
SET STATE=$$GET1^DIQ(5,STATE_",",1)
+28 SET PN=$PIECE(VADM(1),U)
+29 IF $GET(VADM(6),U)'=""
QUIT
+30 NEW CHECK
+31 IF $$BADADR^DGUTL3(DFN)
SET CHECK=1
SET XMSUB="Bad Address for Recall Reminder Patient"
SET XMTEXT="SDRR("
Begin DoDot:5
+32 SET XMY("G.SDRR BAD ADDRESS")=""
SET XMDUZ=.5
+33 SET SDRR(1)="Bad Address- card will not be printed for:"_" "_PN_" "_VA("BID")
+34 DO ^XMD
+35 KILL XMY,XMSUB,XMTEXT,XMDUZ
+36 QUIT
End DoDot:5
+37 ;ADDED THE DATE INFORMATION
+38 ;NEW CODE
IF '$DATA(CHECK)
SET $PIECE(^SD(403.5,D0,0),"^",10)=DT
+39 IF $DATA(CHECK)
QUIT
+40 USE IO
+41 WRITE @IOF
FOR L=1:1:11
WRITE !
+42 WRITE !?20,$PIECE(PN,",",2)," ",$PIECE(PN,",")
+43 IF $PIECE(VAPA(1),U)'=""
WRITE !?20,$PIECE(VAPA(1),U)
+44 IF $PIECE(VAPA(2),U)'=""
WRITE !?20,$PIECE(VAPA(2),U)
+45 IF $PIECE(VAPA(3),U)'=""
WRITE !?20,$PIECE(VAPA(3),U)
+46 WRITE !?20,$PIECE(VAPA(4),U),", "_STATE_" ",$PIECE(VAPA(6),U)
+47 IF LETTER=0
WRITE !!!!!,?25,MESSAGE
+48 IF TIME'=""
WRITE !!!!?2,"**"_TIME
+49 IF LAB'=""
WRITE !!!!!,?2,"*"_LAB
+50 WRITE !!!
+51 IF '$DATA(MESSAGE)
SET LETTER=$ORDER(^SD(403.52,"B",CLINIC,LETTER))
+52 IF LETTER>0
SET LINE=0
FOR
SET LINE=$ORDER(^SD(403.52,LETTER,1,LINE))
IF 'LINE
QUIT
WRITE !,?2,$PIECE(^SD(403.52,LETTER,1,LINE,0),"^",1)
End DoDot:4
End DoDot:3
+53 DO ^%ZISC
End DoDot:2
End DoDot:1
+54 KILL DPTR,DEVSB,DEVSB1,DIQ,DEVSB1,DA,DA1,DR
+55 KILL MESSAGE,LETTER
QUIT KILL DEV,PRT,ADTA,D0,DFN,DIC,DIR,DIRUT,DTA,I,L,PN,POP,Y,ZDIV,ZEDT,ZPR,ZSDT,FAST,TIME,ACC,LAB,STATE
+1 KILL LINE,LETTER,MESSAGE,TEST,CLINIC,DA,DATE,DEV1,DEVSB,DOD,FAIL,PROV,TEAM,X,PROV,TEAM,CRP,DATE,TYPE,SDRR,DPT,VA
+2 DO KVAR^VADPT
+3 QUIT
