SDRRCLR ;10N20/MAH/JLS - Reminder Recall CLEAN UP ;APR 08, 2016
;;5.3;Scheduling;**536,642,790**;Aug 13, 1993;Build 11
; Option: SDRR CLEAN-UP
EN ;Entry point
;Will look at the "D" in file SD(403.5 - and loop through file 2
;to see if appt. has been made then delete entry in file 687065
;SDRRDA=IEN FOR FILE SD(403.5
;DFN= THE PATIENTS NUMBER
;REDT = RECALL DATE
;CLINIC = CLINIC ASSIGNED FOR THAT RECALL VISIT
;CLIN1 = CLINIC ASSIGN FOR THE APPT - IN FILE 2
;CK = APPT DATE IN FILE 2
;CK1 = IS THE APPT DATE MINUS TIME
;CAP = DIFFERENCE BETWEEN RECALL DATE AND APPT DATE - LOOKS AT -30 TO +30
DIV Q:'$D(^SD(403.53,0))
Q ;SD*5.3*790 - Decom Menu Option
N SDCL,SDKF,SDRRCS,SDRRCRS ;alb/sat 642
S CRP=0 F S CRP=$O(^SD(403.53,CRP)) Q:'CRP D
. S PDT=$P($G(^SD(403.53,CRP,0)),"^",5) Q:PDT=""
. S (CNT,SDRRDA)=1
. F S CNT=$O(^SD(403.5,"D",CNT)) Q:CNT<1 D
.. F S SDRRDA=$O(^SD(403.5,"D",CNT,SDRRDA)) Q:SDRRDA<1 D
...S PROV=$P($G(^SD(403.5,SDRRDA,0)),"^",5) Q:PROV=""
...S TEAM=$P($G(^SD(403.54,PROV,0)),"^",2) Q:TEAM=""
...S DIV=$P($G(^SD(403.55,TEAM,0)),"^",4) Q:DIV'=CRP
...S DFN=$P($G(^SD(403.5,SDRRDA,0)),"^",1) I DFN="" Q
...S CLINIC=$P($G(^SD(403.5,SDRRDA,0)),"^",2) I CLINIC="" Q
...S SDRRCS=$$GET1^DIQ(44,CLINIC_",",8,"I") S:SDRRCS'="" SDRRCS=$$GET1^DIQ(40.7,SDRRCS_",",1,"E") ;alb/sat 642
...S SDRRCRS=$$GET1^DIQ(44,CLINIC_",",2503,"I") S:SDRRCRS'="" SDRRCRS=$$GET1^DIQ(40.7,SDRRCRS_",",1,"E") ;alb/sat 642
...S REDT=$P($G(^SD(403.5,SDRRDA,0)),"^",6) I REDT="" Q
...D DEM^VADPT
...I $G(VADM(6),U)'="" S DA=SDRRDA,SDRRFTR=3,DIK="^SD(403.5," D ^DIK K DA,DIK Q
...N SDARRAY,SDCOUNT,SDDATE,SDAPPT,STATUS,APPT,CC,EDT,SDT
...S X1=REDT,X2=+PDT D C^%DTC S EDT=$P(X,".",1) K X,X1,X2
...S X1=REDT,X2=-PDT D C^%DTC S SDT=$P(X,".",1) K X,X1,X2
...S SDARRAY(1)=""_SDT_";"_EDT_""
...S:(SDRRCS="")&(SDRRCRS="") SDARRAY(2)=CLINIC ;alb/sat 642 SDAPI does not return based on stop code of CLINIC is passed in
...S SDARRAY(4)=DFN
...S SDARRAY("FLDS")="1;2;3;13;14" ;alb/sat 642 added 13,14
...S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
...I SDCOUNT>0 D
....S SDKF=0
....S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",DFN,CLINIC,SDDATE)) Q:SDDATE="" D Q:+SDKF
.....S SDAPPT=$G(^TMP($J,"SDAMA301",DFN,CLINIC,SDDATE))
.....S SDKF=$$PROCESS(DFN,CLINIC,SDAPPT,SDDATE,REDT,PDT,SDRRCS,SDRRCRS,SDRRDA) ;alb/sat 642 moved logic to tag PROCESS
....I 'SDKF S SDCL=0 F S SDCL=$O(^TMP($J,"SDAMA301",DFN,SDCL)) Q:SDCL="" D Q:+SDKF ;alb/sat 642
.....S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",DFN,SDCL,SDDATE)) Q:SDDATE="" D Q:+SDKF
......S SDAPPT=$G(^TMP($J,"SDAMA301",DFN,SDCL,SDDATE))
......S SDKF=$$PROCESS(DFN,CLINIC,SDAPPT,SDDATE,REDT,PDT,SDRRCS,SDRRCRS,SDRRDA) ;alb/sat 642 moved logic to tag PROCESS
...I SDCOUNT<0 K ^TMP($J,"SDAMA301")
..Q
QUIT K CNT,SDRRDA,DFN,CLINIC,CLIN1,REDT,CK,CK1,X,CAP,STATUS,PDT,TEAM,DIV,PROV,CRP,DEATH,SDRRFTR,VADM,^TMP($J,"SDAMA301")
D KVAR^VADPT
Q
;
PROCESS(DFN,CLINIC,SDAPPT,SDDATE,REDT,PDT,SDRRCS,SDRRCRS,SDRRDA) ;alb/sat 642
N APPT,CAP,CC,CK1,CLIN1,DA,DIK,SDAPPCST,SDAPPSTP,SDCS,SDCRS,SDKF,SDRRFTR,STATUS
S SDKF=0
S SDAPPSTP=$P($P(SDAPPT,U,13),";",2)
S SDAPPCST=$P($P(SDAPPT,U,14),";",2)
S STATUS=$P($G(SDAPPT),"^",3)
S STATUS=$P(STATUS,";",1)
I STATUS'="R" Q SDKF
S APPT=$P(SDAPPT,"^",1)
S CK1=$P(APPT,".",1)
S CC=$P(SDAPPT,"^",2)
S CLIN1=$P(CC,";",1)
S CAP=$$FMDIFF^XLFDT(CK1,REDT)
S SDCS=$S((SDAPPSTP="")&(SDRRCS=""):1,SDAPPSTP=SDRRCS:1,1:0) ;clinic stop
S SDCRS=$S((SDAPPCST="")&(SDRRCRS=""):1,SDAPPCST=SDRRCRS:1,1:0) ;credit stop
I CAP>-PDT,CAP<PDT I (CLIN1=CLINIC)!(SDCS&SDCRS) S DA=SDRRDA,SDRRFTR=7,DIK="^SD(403.5," D ^DIK K DA,DIK S SDKF=1
Q SDKF
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDRRCLR 3739 printed Dec 13, 2024@03:00:37 Page 2
SDRRCLR ;10N20/MAH/JLS - Reminder Recall CLEAN UP ;APR 08, 2016
+1 ;;5.3;Scheduling;**536,642,790**;Aug 13, 1993;Build 11
+2 ; Option: SDRR CLEAN-UP
EN ;Entry point
+1 ;Will look at the "D" in file SD(403.5 - and loop through file 2
+2 ;to see if appt. has been made then delete entry in file 687065
+3 ;SDRRDA=IEN FOR FILE SD(403.5
+4 ;DFN= THE PATIENTS NUMBER
+5 ;REDT = RECALL DATE
+6 ;CLINIC = CLINIC ASSIGNED FOR THAT RECALL VISIT
+7 ;CLIN1 = CLINIC ASSIGN FOR THE APPT - IN FILE 2
+8 ;CK = APPT DATE IN FILE 2
+9 ;CK1 = IS THE APPT DATE MINUS TIME
+10 ;CAP = DIFFERENCE BETWEEN RECALL DATE AND APPT DATE - LOOKS AT -30 TO +30
DIV if '$DATA(^SD(403.53,0))
QUIT
+1 ;SD*5.3*790 - Decom Menu Option
QUIT
+2 ;alb/sat 642
NEW SDCL,SDKF,SDRRCS,SDRRCRS
+3 SET CRP=0
FOR
SET CRP=$ORDER(^SD(403.53,CRP))
if 'CRP
QUIT
Begin DoDot:1
+4 SET PDT=$PIECE($GET(^SD(403.53,CRP,0)),"^",5)
if PDT=""
QUIT
+5 SET (CNT,SDRRDA)=1
+6 FOR
SET CNT=$ORDER(^SD(403.5,"D",CNT))
if CNT<1
QUIT
Begin DoDot:2
+7 FOR
SET SDRRDA=$ORDER(^SD(403.5,"D",CNT,SDRRDA))
if SDRRDA<1
QUIT
Begin DoDot:3
+8 SET PROV=$PIECE($GET(^SD(403.5,SDRRDA,0)),"^",5)
if PROV=""
QUIT
+9 SET TEAM=$PIECE($GET(^SD(403.54,PROV,0)),"^",2)
if TEAM=""
QUIT
+10 SET DIV=$PIECE($GET(^SD(403.55,TEAM,0)),"^",4)
if DIV'=CRP
QUIT
+11 SET DFN=$PIECE($GET(^SD(403.5,SDRRDA,0)),"^",1)
IF DFN=""
QUIT
+12 SET CLINIC=$PIECE($GET(^SD(403.5,SDRRDA,0)),"^",2)
IF CLINIC=""
QUIT
+13 ;alb/sat 642
SET SDRRCS=$$GET1^DIQ(44,CLINIC_",",8,"I")
if SDRRCS'=""
SET SDRRCS=$$GET1^DIQ(40.7,SDRRCS_",",1,"E")
+14 ;alb/sat 642
SET SDRRCRS=$$GET1^DIQ(44,CLINIC_",",2503,"I")
if SDRRCRS'=""
SET SDRRCRS=$$GET1^DIQ(40.7,SDRRCRS_",",1,"E")
+15 SET REDT=$PIECE($GET(^SD(403.5,SDRRDA,0)),"^",6)
IF REDT=""
QUIT
+16 DO DEM^VADPT
+17 IF $GET(VADM(6),U)'=""
SET DA=SDRRDA
SET SDRRFTR=3
SET DIK="^SD(403.5,"
DO ^DIK
KILL DA,DIK
QUIT
+18 NEW SDARRAY,SDCOUNT,SDDATE,SDAPPT,STATUS,APPT,CC,EDT,SDT
+19 SET X1=REDT
SET X2=+PDT
DO C^%DTC
SET EDT=$PIECE(X,".",1)
KILL X,X1,X2
+20 SET X1=REDT
SET X2=-PDT
DO C^%DTC
SET SDT=$PIECE(X,".",1)
KILL X,X1,X2
+21 SET SDARRAY(1)=""_SDT_";"_EDT_""
+22 ;alb/sat 642 SDAPI does not return based on stop code of CLINIC is passed in
if (SDRRCS="")&(SDRRCRS="")
SET SDARRAY(2)=CLINIC
+23 SET SDARRAY(4)=DFN
+24 ;alb/sat 642 added 13,14
SET SDARRAY("FLDS")="1;2;3;13;14"
+25 SET SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
+26 IF SDCOUNT>0
Begin DoDot:4
+27 SET SDKF=0
+28 SET SDDATE=0
FOR
SET SDDATE=$ORDER(^TMP($JOB,"SDAMA301",DFN,CLINIC,SDDATE))
if SDDATE=""
QUIT
Begin DoDot:5
+29 SET SDAPPT=$GET(^TMP($JOB,"SDAMA301",DFN,CLINIC,SDDATE))
+30 ;alb/sat 642 moved logic to tag PROCESS
SET SDKF=$$PROCESS(DFN,CLINIC,SDAPPT,SDDATE,REDT,PDT,SDRRCS,SDRRCRS,SDRRDA)
End DoDot:5
if +SDKF
QUIT
+31 ;alb/sat 642
IF 'SDKF
SET SDCL=0
FOR
SET SDCL=$ORDER(^TMP($JOB,"SDAMA301",DFN,SDCL))
if SDCL=""
QUIT
Begin DoDot:5
+32 SET SDDATE=0
FOR
SET SDDATE=$ORDER(^TMP($JOB,"SDAMA301",DFN,SDCL,SDDATE))
if SDDATE=""
QUIT
Begin DoDot:6
+33 SET SDAPPT=$GET(^TMP($JOB,"SDAMA301",DFN,SDCL,SDDATE))
+34 ;alb/sat 642 moved logic to tag PROCESS
SET SDKF=$$PROCESS(DFN,CLINIC,SDAPPT,SDDATE,REDT,PDT,SDRRCS,SDRRCRS,SDRRDA)
End DoDot:6
if +SDKF
QUIT
End DoDot:5
if +SDKF
QUIT
End DoDot:4
+35 IF SDCOUNT<0
KILL ^TMP($JOB,"SDAMA301")
End DoDot:3
+36 QUIT
End DoDot:2
End DoDot:1
QUIT KILL CNT,SDRRDA,DFN,CLINIC,CLIN1,REDT,CK,CK1,X,CAP,STATUS,PDT,TEAM,DIV,PROV,CRP,DEATH,SDRRFTR,VADM,^TMP($JOB,"SDAMA301")
+1 DO KVAR^VADPT
+2 QUIT
+3 ;
PROCESS(DFN,CLINIC,SDAPPT,SDDATE,REDT,PDT,SDRRCS,SDRRCRS,SDRRDA) ;alb/sat 642
+1 NEW APPT,CAP,CC,CK1,CLIN1,DA,DIK,SDAPPCST,SDAPPSTP,SDCS,SDCRS,SDKF,SDRRFTR,STATUS
+2 SET SDKF=0
+3 SET SDAPPSTP=$PIECE($PIECE(SDAPPT,U,13),";",2)
+4 SET SDAPPCST=$PIECE($PIECE(SDAPPT,U,14),";",2)
+5 SET STATUS=$PIECE($GET(SDAPPT),"^",3)
+6 SET STATUS=$PIECE(STATUS,";",1)
+7 IF STATUS'="R"
QUIT SDKF
+8 SET APPT=$PIECE(SDAPPT,"^",1)
+9 SET CK1=$PIECE(APPT,".",1)
+10 SET CC=$PIECE(SDAPPT,"^",2)
+11 SET CLIN1=$PIECE(CC,";",1)
+12 SET CAP=$$FMDIFF^XLFDT(CK1,REDT)
+13 ;clinic stop
SET SDCS=$SELECT((SDAPPSTP="")&(SDRRCS=""):1,SDAPPSTP=SDRRCS:1,1:0)
+14 ;credit stop
SET SDCRS=$SELECT((SDAPPCST="")&(SDRRCRS=""):1,SDAPPCST=SDRRCRS:1,1:0)
+15 IF CAP>-PDT
IF CAP<PDT
IF (CLIN1=CLINIC)!(SDCS&SDCRS)
SET DA=SDRRDA
SET SDRRFTR=7
SET DIK="^SD(403.5,"
DO ^DIK
KILL DA,DIK
SET SDKF=1
+16 QUIT SDKF
