- 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
