SDRRINQ ;10N20/MAH;-Recall Reminder PATIENT INQUIRY ;01/28/2008 11:32
;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
; Option: SDRR PATIENT INQUIRY
EN ;Looping through both active recalls and archive entries
N DFN
K ^TMP("SDRRINQ",$J)
S (SHOW,SHOW1)=1
D ^DPTLK Q:Y<0 S DFN=+Y K Y
I '$D(^SD(403.5,"B",DFN)) W !!,"**No Active Clinic Recall on file",! S SHOW=0
I '$D(^SD(403.56,"B",DFN)) W !,"**No Archive Clinic Recalls on file",! S SHOW1=0
G:(SHOW<1)&(SHOW1<1) QUIT
D DATE
I $D(ERR) K ERR Q
SELDT I RANGE=1 S %DT="AEX",%DT("A")="Beginning Date: " D ^%DT Q:Y<0 S SDT=Y,%DT("A")="Ending DATE: " D ^%DT I Y<SDT W $C(7)," ??" G SELDT
S EDT=Y
I RANGE=0 S (SDT,EDT)=0
I RANGE=0 D PRT
I $D(ERROR) K ERROR Q
I Y=1 G QUE^SDRRINQ1
I RANGE=0 D ACT,ARC,REPORT,REPORT1 G QUIT
I RANGE=1 D SEL,SEL1,REPORT,REPORT1 G QUIT
Q
SEL I $D(^SD(403.5,"B",DFN)) S (RSENT,SSENT,PRDT,TYPE)="" S IEN=0 F S IEN=$O(^SD(403.5,"B",DFN,IEN)) Q:'IEN S NODE=$G(^SD(403.5,IEN,0)) D
.S CLINIC=$P($G(NODE),"^",2),CLINIC=$$GET1^DIQ(44,CLINIC_",",.01),ACCINFOR=$P($G(NODE),"^",3)
.S TYPE=$P($G(NODE),"^",4) I TYPE'="" S TYPE=$P(^SD(403.51,TYPE,0),"^",1)
.S PROVIDER=$P(NODE,"^",5) I PROVIDER'="" S PROVIDER=$P($G(^SD(403.54,PROVIDER,0)),"^",1) S PROVIDER=$$NAME^XUSER(PROVIDER,"F")
.I PROVIDER="" S PROVIDER="Unknown"
.S RDT=""
.S Y=$P(NODE,"^",6) Q:Y<SDT!(Y>EDT)
.I Y>SDT,(Y<EDT) D DD^%DT S RDT=Y K Y,X
.S COMMENT=$P($G(NODE),"^",7)
.S FAST=$S($P(NODE,"^",8)["n":"NO",$P(NODE,"^",8)["f":"YES",1:"")
.S LOA=$P(NODE,"^",9)
.S Y=$P($G(NODE),"^",10) I Y'="" D DD^%DT S RSENT=Y K Y,X
.I RSENT="" S RSENT="NOTSENT"
.S USER=$P($G(NODE),"^",11),USER=$$NAME^XUSER(USER,"F")
.S Y=$P(NODE,"^",12) I Y'="" D DD^%DT S PRDT=Y K Y,X
.S Y=$P(NODE,"^",13) I Y'="" D DD^%DT S SSENT="*"_Y K Y,X
.S ^TMP("SDRRINQ",$J,"ACT",IEN)=CLINIC_"^"_ACCINFOR_"^"_TYPE_"^"_PROVIDER_"^"_RDT_"^"_COMMENT_"^"_FAST_"^"_LOA_"^"_RSENT_"^"_USER_"^"_PRDT_"^"_SSENT
Q
SEL1 I $D(^SD(403.56,"B",DFN)) S (SSENT,RSENT,PRDTA,TYPE)="" S IENA=0 F S IENA=$O(^SD(403.56,"B",DFN,IENA)) Q:'IENA S NODEA=$G(^SD(403.56,IENA,0)) D
.S CLINIC=$P($G(NODEA),"^",2),CLINIC=$$GET1^DIQ(44,CLINIC_",",.01),ACCINFOR=$P($G(NODEA),"^",3)
.S TYPE=$P($G(NODEA),"^",4) I TYPE'="" S TYPE=$P(^SD(403.51,TYPE,0),"^",1)
.S PROVIDER=$P(NODEA,"^",5) I PROVIDER'="" S PROVIDER=$P($G(^SD(403.54,PROVIDER,0)),"^",1) S PROVIDER=$$NAME^XUSER(PROVIDER,"F")
.I PROVIDER="" S PROVIDER="Unknown"
.S RDT=""
.S Y=$P(NODEA,"^",6) Q:Y<SDT!(Y>EDT)
.I Y>SDT&(Y<EDT) D DD^%DT S RDT=Y K Y,X
.S COMMENT=$P($G(NODEA),"^",7)
.S FAST=$S($P(NODEA,"^",8)["n":"NO",$P(NODEA,"^",8)["f":"YES",1:"")
.S LOA=$P(NODEA,"^",9)
.S Y=$P($G(NODEA),"^",10) I Y'="" D DD^%DT S RSENT=Y K Y,X
.I RSENT="" S RSENT="NOTSENT"
.S USER=$P($G(NODEA),"^",11),USER=$$NAME^XUSER(USER,"F")
.I $D(^SD(403.56,IENA,2)) S NODEA2=$G(^SD(403.56,IENA,2)) D
..S Y=$P(NODEA2,"^",1) D DD^%DT S PRDTA=Y K Y,X
..S USER2=$P($G(NODEA2),"^",2),USER2=$$NAME^XUSER(USER2,"F")
..S SDRREASN=$S($P(NODEA2,"^",3)=1:"FTR",$P(NODEA2,"^",3)=2:"MOVED",$P(NODEA2,"^",3)=3:"DECEASED",$P(NODEA2,"^",3)=4:"DNWC",$P(NODEA2,"^",3)=5:"RCOVA",$P(NODEA2,"^",3)=6:"OTHER",$P(NODEA2,"^",3)=7:"Scheduled",1:"")
..S ^TMP("SDRRINQ",$J,"ARC",IENA)=CLINIC_"^"_ACCINFOR_"^"_TYPE_"^"_PROVIDER_"^"_RDT_"^"_COMMENT_"^"_FAST_"^"_LOA_"^"_RSENT_"^"_USER2_"^"_SSENT_"^"_SDRREASN_"^"_PRDTA
Q
HDR ;Review all Recall Reminder on screen for all
D DEM^VADPT S NAME=VADM(1),LAST4=VA("BID"),DOB=$P(VADM(3),"^",2) S HDR="Patient Name: "_NAME_" Date of Birth: "_DOB_" Last4: "_LAST4
W @IOF,HDR
Q
ACT I $D(^SD(403.5,"B",DFN)) S (RSENT,SSENT,IEN,PRDT,TYPE)="" F S IEN=$O(^SD(403.5,"B",DFN,IEN)) Q:'IEN S NODE=$G(^SD(403.5,IEN,0)) D
.S CLINIC=$P($G(NODE),"^",2),CLINIC=$$GET1^DIQ(44,CLINIC_",",.01),ACCINFOR=$P($G(NODE),"^",3)
.S TYPE=$P($G(NODE),"^",4) I TYPE'="" S TYPE=$P(^SD(403.51,TYPE,0),"^",1)
.S PROVIDER=$P(NODE,"^",5) I PROVIDER'="" S PROVIDER=$P($G(^SD(403.54,PROVIDER,0)),"^",1) S PROVIDER=$$NAME^XUSER(PROVIDER,"F")
.I PROVIDER="" S PROVIDER="Unknown"
.S RDT=""
.S Y=$P(NODE,"^",6) D DD^%DT S RDT=Y K Y,X
.S COMMENT=$P($G(NODE),"^",7)
.S FAST=$S($P(NODE,"^",8)["n":"NO",$P(NODE,"^",8)["f":"YES",1:"")
.S LOA=$P(NODE,"^",9)
.S Y=$P($G(NODE),"^",10) I Y'="" D DD^%DT S RSENT=Y K Y,X
.I RSENT="" S RSENT="NOTSENT"
.S USER=$P($G(NODE),"^",11),USER=$$NAME^XUSER(USER,"F")
.S Y=$P(NODE,"^",12) I Y'="" D DD^%DT S PRDT=Y K Y,X
.S Y=$P(NODE,"^",13) I Y'="" D DD^%DT S SSENT="*"_Y K Y,X
.S ^TMP("SDRRINQ",$J,"ACT",IEN)=CLINIC_"^"_ACCINFOR_"^"_TYPE_"^"_PROVIDER_"^"_RDT_"^"_COMMENT_"^"_FAST_"^"_LOA_"^"_RSENT_"^"_USER_"^"_PRDT_"^"_SSENT
Q
ARC I $D(^SD(403.56,"B",DFN)) S (SSENT,RSENT,PRDTA,TYPE)="" S IENA=0 F S IENA=$O(^SD(403.56,"B",DFN,IENA)) Q:'IENA S NODEA=$G(^SD(403.56,IENA,0)) D
.S CLINIC=$P($G(NODEA),"^",2),CLINIC=$$GET1^DIQ(44,CLINIC_",",.01),ACCINFOR=$P($G(NODEA),"^",3)
.S TYPE=$P($G(NODEA),"^",4) I TYPE'="" S TYPE=$P(^SD(403.51,TYPE,0),"^",1)
.S PROVIDER=$P(NODEA,"^",5) I PROVIDER'="" S PROVIDER=$P($G(^SD(403.54,PROVIDER,0)),"^",1) S PROVIDER=$$NAME^XUSER(PROVIDER,"F")
.I PROVIDER="" S PROVIDER="Unknown"
.S RDT=""
.S Y=$P(NODEA,"^",6) D DD^%DT S RDT=Y K Y,X
.S COMMENT=$P($G(NODEA),"^",7)
.S FAST=$S($P(NODEA,"^",8)["n":"NO",$P(NODEA,"^",8)["f":"YES",1:"")
.S LOA=$P(NODEA,"^",9)
.S Y=$P($G(NODEA),"^",10) I Y'="" D DD^%DT S RSENT=Y K Y,X
.I RSENT="" S RSENT="NOTSENT"
.S USER=$P($G(NODEA),"^",11),USER=$$NAME^XUSER(USER,"F")
.I $D(^SD(403.56,IENA,2)) S NODEA2=$G(^SD(403.56,IENA,2)) D
..S Y=$P(NODEA2,"^",1) D DD^%DT S PRDTA=Y K Y,X
..S USER2=$P($G(NODEA2),"^",2),USER2=$$NAME^XUSER(USER2,"F")
..S SDRREASN=$S($P(NODEA2,"^",3)=1:"FTR",$P(NODEA2,"^",3)=2:"MOVED",$P(NODEA2,"^",3)=3:"DECEASED",$P(NODEA2,"^",3)=4:"DNWC",$P(NODEA2,"^",3)=5:"RCOVA",$P(NODEA2,"^",3)=6:"OTHER",$P(NODEA2,"^",3)=7:"Scheduled",1:"")
..S ^TMP("SDRRINQ",$J,"ARC",IENA)=CLINIC_"^"_ACCINFOR_"^"_TYPE_"^"_PROVIDER_"^"_RDT_"^"_COMMENT_"^"_FAST_"^"_LOA_"^"_RSENT_"^"_USER2_"^"_SSENT_"^"_SDRREASN_"^"_PRDTA
Q
DATE ; DIR call
S (YES,RANGE)=0,DIR("B")="All" K SDHDR
S DIR(0)="S^R:Range;A:All",DIR("A")="Do you want a (R)ange or (A)ll" I $D(DIRUT) S ERR=1 G QUIT
S DIR("?",1)="",DIR("?",2)=" (A)ll gives the user all dates.",DIR("?")=" (R)ange allows the user to select a range of dates."
D ^DIR K DIR I $D(DIRUT) S ERR=1 G QUIT
I "RA"'[Y W !!,"Enter 'R' for a date range or 'A' for all dates." G DATE
I "R"[Y S RANGE=1
Q
PRT ;
S YES=0
S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to print the profile"
S DIR("?",1)=" Enter 'YES' to print the profile.",DIR("?")=" If you enter 'NO', it will take you to the Recall Reminder report."
D ^DIR K DIR I $D(DIRUT) S ERROR=1 G QUIT
Q
REPORT D HDR
I '$D(^TMP("SDRRINQ",$J,"ACT")) W !!,?25,"No ACTIVE Recalls Reminders on file" Q
I $D(^TMP("SDRRINQ",$J,"ACT")) W !!,?25,"ACTIVE RECALL REMINDERS"
S ITEM=0 F S ITEM=$O(^TMP("SDRRINQ",$J,"ACT",ITEM)) Q:'ITEM D
.S INFOR=$G(^TMP("SDRRINQ",$J,"ACT",ITEM))
.W !!,?5,"Clinic: "_$P($G(INFOR),"^",1),?45,"Recall Date: "_$P($G(INFOR),"^",5)
.W !,?5,"Provider: "_$P($G(INFOR),"^",4),?45,"Appt/Type: "_$P($G(INFOR),"^",3)
.W !,?5,"Fasting/NonFasting: "_$P($G(INFOR),"^",7)
.W !,?5,"Appt Requested Length: "_$P($G(INFOR),"^",8),?45,"Date Reminder Sent: "_$P($G(INFOR),"^",9)
.W !,?5,"User who Entered: "_$P($G(INFOR),"^",10),?45,"Patient Requested Dt: "_$P($G(INFOR),"^",11)
.W !,?5,"Date Second Reminder Sent: "_$P($G(INFOR),"^",12)
.W !,?5,"Comments: "_$P($G(INFOR),"^",6)
.I $Y>(IOSL-6) K DIR S DIR(0)="E",DIR("A")="Press Return for more Information.." D ^DIR Q:$D(DUOUT)!($D(DTOUT)) D HDR
K DIR S DIR(0)="E",DIR("A")="Press Return to continue.." D ^DIR Q:$D(DUOUT)!($D(DTOUT))
Q
REPORT1 D HDR
I '$D(^TMP("SDRRINQ",$J,"ARC")) W !!,?25,"No INACTIVE Recalls Reminders on file" Q
I $D(^TMP("SDRRINQ",$J,"ARC")) W !!,?25,"INACTIVE RECALL REMINDERS"
S ITEM=0 F S ITEM=$O(^TMP("SDRRINQ",$J,"ARC",ITEM)) Q:'ITEM D
.S INFOR=$G(^TMP("SDRRINQ",$J,"ARC",ITEM))
.W !!,?5,"Clinic: "_$P($G(INFOR),"^",1),?45,"Recall Date: "_$P($G(INFOR),"^",5)
.W !,?5,"Provider: "_$P($G(INFOR),"^",4),?45,"Appt/Type: "_$P($G(INFOR),"^",3)
.W !,?5,"Fasting/NonFasting: "_$P($G(INFOR),"^",7)
.W !,?5,"Appt Requested Length: "_$P($G(INFOR),"^",8),?45,"Date Reminder Sent: "_$P($G(INFOR),"^",9)
.W !,?5,"User who Entered: "_$P($G(INFOR),"^",10),?45,"Patient Requested Dt: "_$P($G(INFOR),"^",11)
.W !,?5,"Date Removed from Active File: "_$P($G(INFOR),"^",13)
.W !,?5,"Reason for Removal: "_$P($G(INFOR),"^",12)
.W !,?5,"User who Deleted Entry: "_$P($G(INFOR),"^",10)
.W !,?5,"Comments: "_$P($G(INFOR),"^",6)
.I $Y>(IOSL-6) K DIR S DIR(0)="E",DIR("A")="Press Return for more Information.." D ^DIR Q:$D(DUOUT)!($D(DTOUT)) D HDR
K DIR S DIR(0)="E",DIR("A")="Press Return to continue.." D ^DIR Q:$D(DUOUT)!($D(DTOUT))
Q
QUIT K DFN,Y,SHOW,SHOW1,ACCINFOR,CLINIC,COMMENT,DOB,DIRUT,DTOUT,DUOUT,EDT,FAST,HDR,IEN,IENA,INFOR,ITEM,LAST4,LOA,NAME
K NODE,NODEA,PRDT,PRDTA,PROVIDER,RANGE,RDT,RSENT,SDRREASN,SDT,SSENT,TYPE,USER,USER2,NODEA2,DIR,YES
K ^TMP("SDRRINQ",$J),%DT,VA,VADM,YES
Q
SDRRINQ ;10N20/MAH;-Recall Reminder PATIENT INQUIRY ;01/28/2008 11:32
+1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
+2 ; Option: SDRR PATIENT INQUIRY
EN ;Looping through both active recalls and archive entries
+1 NEW DFN
+2 KILL ^TMP("SDRRINQ",$JOB)
+3 SET (SHOW,SHOW1)=1
+4 DO ^DPTLK
IF Y<0
QUIT
SET DFN=+Y
KILL Y
+5 IF '$DATA(^SD(403.5,"B",DFN))
WRITE !!,"**No Active Clinic Recall on file",!
SET SHOW=0
+6 IF '$DATA(^SD(403.56,"B",DFN))
WRITE !,"**No Archive Clinic Recalls on file",!
SET SHOW1=0
+7 IF (SHOW<1)&(SHOW1<1)
GOTO QUIT
+8 DO DATE
+9 IF $DATA(ERR)
KILL ERR
QUIT
SELDT IF RANGE=1
SET %DT="AEX"
SET %DT("A")="Beginning Date: "
DO ^%DT
IF Y<0
QUIT
SET SDT=Y
SET %DT("A")="Ending DATE: "
DO ^%DT
IF Y<SDT
WRITE $CHAR(7)," ??"
GOTO SELDT
+1 SET EDT=Y
+2 IF RANGE=0
SET (SDT,EDT)=0
+3 IF RANGE=0
DO PRT
+4 IF $DATA(ERROR)
KILL ERROR
QUIT
+5 IF Y=1
GOTO QUE^SDRRINQ1
+6 IF RANGE=0
DO ACT
DO ARC
DO REPORT
DO REPORT1
GOTO QUIT
+7 IF RANGE=1
DO SEL
DO SEL1
DO REPORT
DO REPORT1
GOTO QUIT
+8 QUIT
SEL IF $DATA(^SD(403.5,"B",DFN))
SET (RSENT,SSENT,PRDT,TYPE)=""
SET IEN=0
FOR
SET IEN=$ORDER(^SD(403.5,"B",DFN,IEN))
IF 'IEN
QUIT
SET NODE=$GET(^SD(403.5,IEN,0))
Begin DoDot:1
+1 SET CLINIC=$PIECE($GET(NODE),"^",2)
SET CLINIC=$$GET1^DIQ(44,CLINIC_",",.01)
SET ACCINFOR=$PIECE($GET(NODE),"^",3)
+2 SET TYPE=$PIECE($GET(NODE),"^",4)
IF TYPE'=""
SET TYPE=$PIECE(^SD(403.51,TYPE,0),"^",1)
+3 SET PROVIDER=$PIECE(NODE,"^",5)
IF PROVIDER'=""
SET PROVIDER=$PIECE($GET(^SD(403.54,PROVIDER,0)),"^",1)
SET PROVIDER=$$NAME^XUSER(PROVIDER,"F")
+4 IF PROVIDER=""
SET PROVIDER="Unknown"
+5 SET RDT=""
+6 SET Y=$PIECE(NODE,"^",6)
IF Y<SDT!(Y>EDT)
QUIT
+7 IF Y>SDT
IF (Y<EDT)
DO DD^%DT
SET RDT=Y
KILL Y,X
+8 SET COMMENT=$PIECE($GET(NODE),"^",7)
+9 SET FAST=$SELECT($PIECE(NODE,"^",8)["n":"NO",$PIECE(NODE,"^",8)["f":"YES",1:"")
+10 SET LOA=$PIECE(NODE,"^",9)
+11 SET Y=$PIECE($GET(NODE),"^",10)
IF Y'=""
DO DD^%DT
SET RSENT=Y
KILL Y,X
+12 IF RSENT=""
SET RSENT="NOTSENT"
+13 SET USER=$PIECE($GET(NODE),"^",11)
SET USER=$$NAME^XUSER(USER,"F")
+14 SET Y=$PIECE(NODE,"^",12)
IF Y'=""
DO DD^%DT
SET PRDT=Y
KILL Y,X
+15 SET Y=$PIECE(NODE,"^",13)
IF Y'=""
DO DD^%DT
SET SSENT="*"_Y
KILL Y,X
+16 SET ^TMP("SDRRINQ",$JOB,"ACT",IEN)=CLINIC_"^"_ACCINFOR_"^"_TYPE_"^"_PROVIDER_"^"_RDT_"^"_COMMENT_"^"_FAST_"^"_LOA_"^"_RSENT_"^"_USER_"^"_PRDT_"^"_SSENT
End DoDot:1
+17 QUIT
SEL1 IF $DATA(^SD(403.56,"B",DFN))
SET (SSENT,RSENT,PRDTA,TYPE)=""
SET IENA=0
FOR
SET IENA=$ORDER(^SD(403.56,"B",DFN,IENA))
IF 'IENA
QUIT
SET NODEA=$GET(^SD(403.56,IENA,0))
Begin DoDot:1
+1 SET CLINIC=$PIECE($GET(NODEA),"^",2)
SET CLINIC=$$GET1^DIQ(44,CLINIC_",",.01)
SET ACCINFOR=$PIECE($GET(NODEA),"^",3)
+2 SET TYPE=$PIECE($GET(NODEA),"^",4)
IF TYPE'=""
SET TYPE=$PIECE(^SD(403.51,TYPE,0),"^",1)
+3 SET PROVIDER=$PIECE(NODEA,"^",5)
IF PROVIDER'=""
SET PROVIDER=$PIECE($GET(^SD(403.54,PROVIDER,0)),"^",1)
SET PROVIDER=$$NAME^XUSER(PROVIDER,"F")
+4 IF PROVIDER=""
SET PROVIDER="Unknown"
+5 SET RDT=""
+6 SET Y=$PIECE(NODEA,"^",6)
IF Y<SDT!(Y>EDT)
QUIT
+7 IF Y>SDT&(Y<EDT)
DO DD^%DT
SET RDT=Y
KILL Y,X
+8 SET COMMENT=$PIECE($GET(NODEA),"^",7)
+9 SET FAST=$SELECT($PIECE(NODEA,"^",8)["n":"NO",$PIECE(NODEA,"^",8)["f":"YES",1:"")
+10 SET LOA=$PIECE(NODEA,"^",9)
+11 SET Y=$PIECE($GET(NODEA),"^",10)
IF Y'=""
DO DD^%DT
SET RSENT=Y
KILL Y,X
+12 IF RSENT=""
SET RSENT="NOTSENT"
+13 SET USER=$PIECE($GET(NODEA),"^",11)
SET USER=$$NAME^XUSER(USER,"F")
+14 IF $DATA(^SD(403.56,IENA,2))
SET NODEA2=$GET(^SD(403.56,IENA,2))
Begin DoDot:2
+15 SET Y=$PIECE(NODEA2,"^",1)
DO DD^%DT
SET PRDTA=Y
KILL Y,X
+16 SET USER2=$PIECE($GET(NODEA2),"^",2)
SET USER2=$$NAME^XUSER(USER2,"F")
+17 SET SDRREASN=$SELECT($PIECE(NODEA2,"^",3)=1:"FTR",$PIECE(NODEA2,"^",3)=2:"MOVED",$PIECE(NODEA2,"^",3)=3:"DECEASED",$PIECE(NODEA2,"^",3)=4:"DNWC",$PIECE(NODEA2,"^",3)=5:"RCOVA",$PIECE(NODEA2,"^",3)=6:"OTHER",$PIECE(NODEA2,"^"
,3)=7:"Scheduled",1:"")
+18 SET ^TMP("SDRRINQ",$JOB,"ARC",IENA)=CLINIC_"^"_ACCINFOR_"^"_TYPE_"^"_PROVIDER_"^"_RDT_"^"_COMMENT_"^"_FAST_"^"_LOA_"^"_RSENT_"^"_USER2_"^"_SSENT_"^"_SDRREASN_"^"_PRDTA
End DoDot:2
End DoDot:1
+19 QUIT
HDR ;Review all Recall Reminder on screen for all
+1 DO DEM^VADPT
SET NAME=VADM(1)
SET LAST4=VA("BID")
SET DOB=$PIECE(VADM(3),"^",2)
SET HDR="Patient Name: "_NAME_" Date of Birth: "_DOB_" Last4: "_LAST4
+2 WRITE @IOF,HDR
+3 QUIT
ACT IF $DATA(^SD(403.5,"B",DFN))
SET (RSENT,SSENT,IEN,PRDT,TYPE)=""
FOR
SET IEN=$ORDER(^SD(403.5,"B",DFN,IEN))
IF 'IEN
QUIT
SET NODE=$GET(^SD(403.5,IEN,0))
Begin DoDot:1
+1 SET CLINIC=$PIECE($GET(NODE),"^",2)
SET CLINIC=$$GET1^DIQ(44,CLINIC_",",.01)
SET ACCINFOR=$PIECE($GET(NODE),"^",3)
+2 SET TYPE=$PIECE($GET(NODE),"^",4)
IF TYPE'=""
SET TYPE=$PIECE(^SD(403.51,TYPE,0),"^",1)
+3 SET PROVIDER=$PIECE(NODE,"^",5)
IF PROVIDER'=""
SET PROVIDER=$PIECE($GET(^SD(403.54,PROVIDER,0)),"^",1)
SET PROVIDER=$$NAME^XUSER(PROVIDER,"F")
+4 IF PROVIDER=""
SET PROVIDER="Unknown"
+5 SET RDT=""
+6 SET Y=$PIECE(NODE,"^",6)
DO DD^%DT
SET RDT=Y
KILL Y,X
+7 SET COMMENT=$PIECE($GET(NODE),"^",7)
+8 SET FAST=$SELECT($PIECE(NODE,"^",8)["n":"NO",$PIECE(NODE,"^",8)["f":"YES",1:"")
+9 SET LOA=$PIECE(NODE,"^",9)
+10 SET Y=$PIECE($GET(NODE),"^",10)
IF Y'=""
DO DD^%DT
SET RSENT=Y
KILL Y,X
+11 IF RSENT=""
SET RSENT="NOTSENT"
+12 SET USER=$PIECE($GET(NODE),"^",11)
SET USER=$$NAME^XUSER(USER,"F")
+13 SET Y=$PIECE(NODE,"^",12)
IF Y'=""
DO DD^%DT
SET PRDT=Y
KILL Y,X
+14 SET Y=$PIECE(NODE,"^",13)
IF Y'=""
DO DD^%DT
SET SSENT="*"_Y
KILL Y,X
+15 SET ^TMP("SDRRINQ",$JOB,"ACT",IEN)=CLINIC_"^"_ACCINFOR_"^"_TYPE_"^"_PROVIDER_"^"_RDT_"^"_COMMENT_"^"_FAST_"^"_LOA_"^"_RSENT_"^"_USER_"^"_PRDT_"^"_SSENT
End DoDot:1
+16 QUIT
ARC IF $DATA(^SD(403.56,"B",DFN))
SET (SSENT,RSENT,PRDTA,TYPE)=""
SET IENA=0
FOR
SET IENA=$ORDER(^SD(403.56,"B",DFN,IENA))
IF 'IENA
QUIT
SET NODEA=$GET(^SD(403.56,IENA,0))
Begin DoDot:1
+1 SET CLINIC=$PIECE($GET(NODEA),"^",2)
SET CLINIC=$$GET1^DIQ(44,CLINIC_",",.01)
SET ACCINFOR=$PIECE($GET(NODEA),"^",3)
+2 SET TYPE=$PIECE($GET(NODEA),"^",4)
IF TYPE'=""
SET TYPE=$PIECE(^SD(403.51,TYPE,0),"^",1)
+3 SET PROVIDER=$PIECE(NODEA,"^",5)
IF PROVIDER'=""
SET PROVIDER=$PIECE($GET(^SD(403.54,PROVIDER,0)),"^",1)
SET PROVIDER=$$NAME^XUSER(PROVIDER,"F")
+4 IF PROVIDER=""
SET PROVIDER="Unknown"
+5 SET RDT=""
+6 SET Y=$PIECE(NODEA,"^",6)
DO DD^%DT
SET RDT=Y
KILL Y,X
+7 SET COMMENT=$PIECE($GET(NODEA),"^",7)
+8 SET FAST=$SELECT($PIECE(NODEA,"^",8)["n":"NO",$PIECE(NODEA,"^",8)["f":"YES",1:"")
+9 SET LOA=$PIECE(NODEA,"^",9)
+10 SET Y=$PIECE($GET(NODEA),"^",10)
IF Y'=""
DO DD^%DT
SET RSENT=Y
KILL Y,X
+11 IF RSENT=""
SET RSENT="NOTSENT"
+12 SET USER=$PIECE($GET(NODEA),"^",11)
SET USER=$$NAME^XUSER(USER,"F")
+13 IF $DATA(^SD(403.56,IENA,2))
SET NODEA2=$GET(^SD(403.56,IENA,2))
Begin DoDot:2
+14 SET Y=$PIECE(NODEA2,"^",1)
DO DD^%DT
SET PRDTA=Y
KILL Y,X
+15 SET USER2=$PIECE($GET(NODEA2),"^",2)
SET USER2=$$NAME^XUSER(USER2,"F")
+16 SET SDRREASN=$SELECT($PIECE(NODEA2,"^",3)=1:"FTR",$PIECE(NODEA2,"^",3)=2:"MOVED",$PIECE(NODEA2,"^",3)=3:"DECEASED",$PIECE(NODEA2,"^",3)=4:"DNWC",$PIECE(NODEA2,"^",3)=5:"RCOVA",$PIECE(NODEA2,"^",3)=6:"OTHER",$PIECE(NODEA2,"^"
,3)=7:"Scheduled",1:"")
+17 SET ^TMP("SDRRINQ",$JOB,"ARC",IENA)=CLINIC_"^"_ACCINFOR_"^"_TYPE_"^"_PROVIDER_"^"_RDT_"^"_COMMENT_"^"_FAST_"^"_LOA_"^"_RSENT_"^"_USER2_"^"_SSENT_"^"_SDRREASN_"^"_PRDTA
End DoDot:2
End DoDot:1
+18 QUIT
DATE ; DIR call
+1 SET (YES,RANGE)=0
SET DIR("B")="All"
KILL SDHDR
+2 SET DIR(0)="S^R:Range;A:All"
SET DIR("A")="Do you want a (R)ange or (A)ll"
IF $DATA(DIRUT)
SET ERR=1
GOTO QUIT
+3 SET DIR("?",1)=""
SET DIR("?",2)=" (A)ll gives the user all dates."
SET DIR("?")=" (R)ange allows the user to select a range of dates."
+4 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ERR=1
GOTO QUIT
+5 IF "RA"'[Y
WRITE !!,"Enter 'R' for a date range or 'A' for all dates."
GOTO DATE
+6 IF "R"[Y
SET RANGE=1
+7 QUIT
PRT ;
+1 SET YES=0
+2 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Do you want to print the profile"
+3 SET DIR("?",1)=" Enter 'YES' to print the profile."
SET DIR("?")=" If you enter 'NO', it will take you to the Recall Reminder report."
+4 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ERROR=1
GOTO QUIT
+5 QUIT
REPORT DO HDR
+1 IF '$DATA(^TMP("SDRRINQ",$JOB,"ACT"))
WRITE !!,?25,"No ACTIVE Recalls Reminders on file"
QUIT
+2 IF $DATA(^TMP("SDRRINQ",$JOB,"ACT"))
WRITE !!,?25,"ACTIVE RECALL REMINDERS"
+3 SET ITEM=0
FOR
SET ITEM=$ORDER(^TMP("SDRRINQ",$JOB,"ACT",ITEM))
IF 'ITEM
QUIT
Begin DoDot:1
+4 SET INFOR=$GET(^TMP("SDRRINQ",$JOB,"ACT",ITEM))
+5 WRITE !!,?5,"Clinic: "_$PIECE($GET(INFOR),"^",1),?45,"Recall Date: "_$PIECE($GET(INFOR),"^",5)
+6 WRITE !,?5,"Provider: "_$PIECE($GET(INFOR),"^",4),?45,"Appt/Type: "_$PIECE($GET(INFOR),"^",3)
+7 WRITE !,?5,"Fasting/NonFasting: "_$PIECE($GET(INFOR),"^",7)
+8 WRITE !,?5,"Appt Requested Length: "_$PIECE($GET(INFOR),"^",8),?45,"Date Reminder Sent: "_$PIECE($GET(INFOR),"^",9)
+9 WRITE !,?5,"User who Entered: "_$PIECE($GET(INFOR),"^",10),?45,"Patient Requested Dt: "_$PIECE($GET(INFOR),"^",11)
+10 WRITE !,?5,"Date Second Reminder Sent: "_$PIECE($GET(INFOR),"^",12)
+11 WRITE !,?5,"Comments: "_$PIECE($GET(INFOR),"^",6)
+12 IF $Y>(IOSL-6)
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return for more Information.."
DO ^DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
DO HDR
End DoDot:1
+13 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue.."
DO ^DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+14 QUIT
REPORT1 DO HDR
+1 IF '$DATA(^TMP("SDRRINQ",$JOB,"ARC"))
WRITE !!,?25,"No INACTIVE Recalls Reminders on file"
QUIT
+2 IF $DATA(^TMP("SDRRINQ",$JOB,"ARC"))
WRITE !!,?25,"INACTIVE RECALL REMINDERS"
+3 SET ITEM=0
FOR
SET ITEM=$ORDER(^TMP("SDRRINQ",$JOB,"ARC",ITEM))
IF 'ITEM
QUIT
Begin DoDot:1
+4 SET INFOR=$GET(^TMP("SDRRINQ",$JOB,"ARC",ITEM))
+5 WRITE !!,?5,"Clinic: "_$PIECE($GET(INFOR),"^",1),?45,"Recall Date: "_$PIECE($GET(INFOR),"^",5)
+6 WRITE !,?5,"Provider: "_$PIECE($GET(INFOR),"^",4),?45,"Appt/Type: "_$PIECE($GET(INFOR),"^",3)
+7 WRITE !,?5,"Fasting/NonFasting: "_$PIECE($GET(INFOR),"^",7)
+8 WRITE !,?5,"Appt Requested Length: "_$PIECE($GET(INFOR),"^",8),?45,"Date Reminder Sent: "_$PIECE($GET(INFOR),"^",9)
+9 WRITE !,?5,"User who Entered: "_$PIECE($GET(INFOR),"^",10),?45,"Patient Requested Dt: "_$PIECE($GET(INFOR),"^",11)
+10 WRITE !,?5,"Date Removed from Active File: "_$PIECE($GET(INFOR),"^",13)
+11 WRITE !,?5,"Reason for Removal: "_$PIECE($GET(INFOR),"^",12)
+12 WRITE !,?5,"User who Deleted Entry: "_$PIECE($GET(INFOR),"^",10)
+13 WRITE !,?5,"Comments: "_$PIECE($GET(INFOR),"^",6)
+14 IF $Y>(IOSL-6)
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return for more Information.."
DO ^DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
DO HDR
End DoDot:1
+15 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue.."
DO ^DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+16 QUIT
QUIT KILL DFN,Y,SHOW,SHOW1,ACCINFOR,CLINIC,COMMENT,DOB,DIRUT,DTOUT,DUOUT,EDT,FAST,HDR,IEN,IENA,INFOR,ITEM,LAST4,LOA,NAME
+1 KILL NODE,NODEA,PRDT,PRDTA,PROVIDER,RANGE,RDT,RSENT,SDRREASN,SDT,SSENT,TYPE,USER,USER2,NODEA2,DIR,YES
+2 KILL ^TMP("SDRRINQ",$JOB),%DT,VA,VADM,YES
+3 QUIT
