SDRRCLR ;10N20/MAH;-Reminder Recall CLEAN UP ;01/18/2008 11:32
;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
; 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))
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 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 SDARRAY(2)=CLINIC
... S SDARRAY(4)=DFN
... S SDARRAY("FLDS")="1;2;3"
... S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
... I SDCOUNT>0 D
.... S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",DFN,CLINIC,SDDATE)) Q:SDDATE="" D
..... S SDAPPT=$G(^TMP($J,"SDAMA301",DFN,CLINIC,SDDATE))
..... S STATUS=$P($G(SDAPPT),"^",3)
..... S STATUS=$P(STATUS,";",1)
..... I STATUS'="R" Q
..... 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)
..... I CAP>-PDT,CAP<PDT I CLIN1=CLINIC S DA=SDRRDA,SDRRFTR=7,DIK="^SD(403.5," D ^DIK K DA,DIK
..... Q
... 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
SDRRCLR ;10N20/MAH;-Reminder Recall CLEAN UP ;01/18/2008 11:32
+1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
+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 SET CRP=0
FOR
SET CRP=$ORDER(^SD(403.53,CRP))
IF 'CRP
QUIT
Begin DoDot:1
+2 SET PDT=$PIECE($GET(^SD(403.53,CRP,0)),"^",5)
IF PDT=""
QUIT
+3 SET (CNT,SDRRDA)=1
+4 FOR
SET CNT=$ORDER(^SD(403.5,"D",CNT))
IF CNT<1
QUIT
Begin DoDot:2
+5 FOR
SET SDRRDA=$ORDER(^SD(403.5,"D",CNT,SDRRDA))
IF SDRRDA<1
QUIT
Begin DoDot:3
+6 SET PROV=$PIECE($GET(^SD(403.5,SDRRDA,0)),"^",5)
IF PROV=""
QUIT
+7 SET TEAM=$PIECE($GET(^SD(403.54,PROV,0)),"^",2)
IF TEAM=""
QUIT
+8 SET DIV=$PIECE($GET(^SD(403.55,TEAM,0)),"^",4)
IF DIV'=CRP
QUIT
+9 SET DFN=$PIECE($GET(^SD(403.5,SDRRDA,0)),"^",1)
IF DFN=""
QUIT
+10 SET CLINIC=$PIECE($GET(^SD(403.5,SDRRDA,0)),"^",2)
IF CLINIC=""
QUIT
+11 SET REDT=$PIECE($GET(^SD(403.5,SDRRDA,0)),"^",6)
IF REDT=""
QUIT
+12 DO DEM^VADPT
+13 IF $GET(VADM(6),U)'=""
SET DA=SDRRDA
SET SDRRFTR=3
SET DIK="^SD(403.5,"
DO ^DIK
KILL DA,DIK
QUIT
+14 NEW SDARRAY,SDCOUNT,SDDATE,SDAPPT,STATUS,APPT,CC,EDT,SDT
+15 SET X1=REDT
SET X2=+PDT
DO C^%DTC
SET EDT=$PIECE(X,".",1)
KILL X,X1,X2
+16 SET X1=REDT
SET X2=-PDT
DO C^%DTC
SET SDT=$PIECE(X,".",1)
KILL X,X1,X2
+17 SET SDARRAY(1)=""_SDT_";"_EDT_""
+18 SET SDARRAY(2)=CLINIC
+19 SET SDARRAY(4)=DFN
+20 SET SDARRAY("FLDS")="1;2;3"
+21 SET SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
+22 IF SDCOUNT>0
Begin DoDot:4
+23 SET SDDATE=0
FOR
SET SDDATE=$ORDER(^TMP($JOB,"SDAMA301",DFN,CLINIC,SDDATE))
IF SDDATE=""
QUIT
Begin DoDot:5
+24 SET SDAPPT=$GET(^TMP($JOB,"SDAMA301",DFN,CLINIC,SDDATE))
+25 SET STATUS=$PIECE($GET(SDAPPT),"^",3)
+26 SET STATUS=$PIECE(STATUS,";",1)
+27 IF STATUS'="R"
QUIT
+28 SET APPT=$PIECE(SDAPPT,"^",1)
+29 SET CK1=$PIECE(APPT,".",1)
+30 SET CC=$PIECE(SDAPPT,"^",2)
+31 SET CLIN1=$PIECE(CC,";",1)
+32 SET CAP=$$FMDIFF^XLFDT(CK1,REDT)
+33 IF CAP>-PDT
IF CAP<PDT
IF CLIN1=CLINIC
SET DA=SDRRDA
SET SDRRFTR=7
SET DIK="^SD(403.5,"
DO ^DIK
KILL DA,DIK
+34 QUIT
End DoDot:5
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
