DGENACL2 ;ALB/MRY - NEW ENROLLEE APPOINTMENT CALL LIST - UPDATE ;08/14/2008
;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
;
N DGNAM,DGSSN,DGENRIEN,DGENR,DGENCAT,DGENSTA,DGSTA1,DGENPRI,DGENCV,DGENCVDT,DGENCVEL,DGCOM,DGPFSITE
N SDCNT,SDADT,SDARRY,SDCL,Y,FDATA,SDEXIT,DGRDTI,DGSTA
;get preferred facility
S DGPFSITE=$$GET1^DIQ(4,+$$GET1^DIQ(2,DFNIEN,27.02,"I"),99)
S DGPFTF=$S(+$$GET1^DIQ(2,DFNIEN,27.02,"I"):$$GET1^DIQ(2,DFNIEN,27.02,"I"),1:"NULL")
I +DGSITE'=+DGPFSITE Q ;if not same division skip
I DGPFTFLG=1,'$D(DGPFTF(DGPFTF)) Q ;selection of preferred facilities
;get enrollment information
S DGENRIEN=$$FINDCUR^DGENA(DFNIEN)
I DGENRIEN,$$GET^DGENA(DGENRIEN,.DGENR) ;set-up enrollment arry
I $G(DGENR("APP"))<3050801 Q
S DGENCAT=$$CATEGORY^DGENA4(,$G(DGENR("STATUS"))) ;enrollment category
I DGENCAT'="E" Q
S DGENCAT=$$EXTERNAL^DILFD(27.15,.02,"",DGENCAT)
S DGENSTA=$S($G(DGENR("STATUS")):$$EXT^DGENU("STATUS",DGENR("STATUS")),1:"")
S DGENPRI=$S($G(DGENR("PRIORITY")):DGENR("PRIORITY"),1:"")_$S($G(DGENR("SUBGRP")):$$EXT^DGENU("SUBGRP",DGENR("SUBGRP")),1:"")
D APPTCK ;check appts.
I +DGERROR Q ;RSA API error
I SDEXIT Q ;quit if appointment < 'date notified of request date'.
;if call list, quit if request status 'filled' or 'completed'.
I DGRPT=1 Q:(SDCNT>0)!(DGSTA="C")!(DGSTA="F")
S SDADT=$G(SDADT)
S DGNAM=$$GET1^DIQ(2,DFNIEN,.01),DGSSN=$E($$GET1^DIQ(2,DFNIEN,.09),6,9)
S DGENCV=$$CVEDT^DGCV(DFNIEN),DGENCVDT=$P($G(DGENCV),"^",2),DGENCVEL=$P($G(DGENCV),"^",3)
;build temp file
S DGPFTF=$S(+DGPFTF:$$GET1^DIQ(4,DGPFTF,.01)_"("_DGPFSITE_")",1:"ZZZZZ")
S DGSTA1=$S(DGSTA="":1,DGSTA="I":2,DGSTA="E":3,DGSTA="F":4,1:DGSTA)
S ^TMP($J,"DGEN NEACL",DGPFTF,DGSTA1,DGRDTI,DGNAM,DFNIEN)=SDADT
I $G(DGENCAT)'=""!($G(DGENSTA)'="")!($G(DGENPRI)'="")!($G(DGENCVEL)'="") D
. S ^TMP($J,"DGEN NEACL",DGPFTF,DGSTA1,DGRDTI,DGNAM,DFNIEN,"PRIORITY")=DGENCAT_"^"_DGENSTA_"^"_DGENPRI_"^"_DGENCVEL
Q
;
APPTCK ;
;quit, if no appointment questioned asked?
S DGRDTI=$$GET1^DIQ(2,DFNIEN,1010.1511,"I") I 'DGRDTI S SDEXIT=1 Q
;get request status
S DGSTA=$$GET1^DIQ(2,DFNIEN,1010.161,"I")
;look for any appointments made (quit if none, or appt. date < 'notify of request date'
K ^TMP($J,"SDAMA301")
S SDARRY(4)=DFNIEN
S SDARRY("FLDS")=1
S SDARRY("MAX")=1
S SDEXIT=0
S SDCNT=$$SDAPI^SDAMA301(.SDARRY) I SDCNT<0 S DGERROR=$$ERR() Q
Q:(SDCNT'>0) ;no appointment
;quit if appointment < 'notify of request date'
S SDCL=0 F S SDCL=$O(^TMP($J,"SDAMA301",DFNIEN,SDCL)) Q:'SDCL D I SDEXIT=1 Q
. I $O(^TMP($J,"SDAMA301",DFNIEN,SDCL,0))<DGRDTI S SDEXIT=1
;
K ^TMP($J,"SDAMA301")
;Check appointments (scheduled/kept, inpatient, no action)
S SDARRY(1)=DGRDTI_";" ;look out from 'notify of request date' to future.
S SDARRY(3)="R;I;NT"
S SDARRY(4)=DFNIEN,SDARRY("FLDS")=1
S SDCNT=$$SDAPI^SDAMA301(.SDARRY) Q:(SDCNT'>0)
;Exclude no count clinic appointments from appointment count
N SDCOUNT
S SDCOUNT=0 ;count clinic
S SDCL=0 F S SDCL=$O(^TMP($J,"SDAMA301",DFNIEN,SDCL)) Q:'SDCL D Q:SDCOUNT
. I $$GET1^DIQ(44,SDCL,2502,"I")="Y" Q ;don't include no-count
. S SDADT=$O(^TMP($J,"SDAMA301",DFNIEN,SDCL,0)) ;get appointment date of count clinic
. S SDCOUNT=SDCOUNT+1
I SDCOUNT=0 S SDCNT=0 Q ;if no-count clinics was only one found, keep on call list.
;if appointment found and status '="filled", set status to 'filled'
I DGSTA'="F" D
. S DGCOM=$$GET1^DIQ(2,DFNIEN,1010.163)
. S DGCOM=DGCOM_$S(DGCOM'="":"<>",1:"")_"AutoComm:"_$S(DGSTA="":"null",1:$S($$GET1^DIQ(2,DFNIEN,1010.161,"I")="I":"IN PROGRESS",1:$$GET1^DIQ(2,DFNIEN,1010.161)))_"|FILLED"
. S FDATA(2,DFNIEN_",",1010.161)="F"
. S FDATA(2,DFNIEN_",",1010.163)=DGCOM
. D FILE^DIE("","FDATA","DPTERR")
. S DGSTA=$$GET1^DIQ(2,DFNIEN,1010.161,"I")
Q
ERR() ; Process error message.
N DGERR
S DGERR=0
I $D(^TMP($J,"SDAMA301",101)) D
. S DGERR=101_"^"_" *** RSA: Process DATABASE IS UNAVAILABLE ***"
I $D(^TMP($J,"SDAMA301",115)) D
. S DGERR=115_"^"_" *** RSA: Appointment request filter contains invalid values ***"
I $D(^TMP($J,"SDAMA301",116)) D
. S DGERR=116_"^"_" *** RSA: Data doesn't exist error has occurred ***"
I $D(^TMP($J,"SDAMA301",117)) D
. S DGERR=117_"^"_" *** RSA: Other undefined error has occurred ***"
Q DGERR
DGENACL2 ;ALB/MRY - NEW ENROLLEE APPOINTMENT CALL LIST - UPDATE ;08/14/2008
+1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
+2 ;
+1 NEW DGNAM,DGSSN,DGENRIEN,DGENR,DGENCAT,DGENSTA,DGSTA1,DGENPRI,DGENCV,DGENCVDT,DGENCVEL,DGCOM,DGPFSITE
+2 NEW SDCNT,SDADT,SDARRY,SDCL,Y,FDATA,SDEXIT,DGRDTI,DGSTA
+3 ;get preferred facility
+4 SET DGPFSITE=$$GET1^DIQ(4,+$$GET1^DIQ(2,DFNIEN,27.02,"I"),99)
+5 SET DGPFTF=$SELECT(+$$GET1^DIQ(2,DFNIEN,27.02,"I"):$$GET1^DIQ(2,DFNIEN,27.02,"I"),1:"NULL")
+6 ;if not same division skip
IF +DGSITE'=+DGPFSITE
QUIT
+7 ;selection of preferred facilities
IF DGPFTFLG=1
IF '$DATA(DGPFTF(DGPFTF))
QUIT
+8 ;get enrollment information
+9 SET DGENRIEN=$$FINDCUR^DGENA(DFNIEN)
+10 ;set-up enrollment arry
IF DGENRIEN
IF $$GET^DGENA(DGENRIEN,.DGENR)
+11 IF $GET(DGENR("APP"))<3050801
QUIT
+12 ;enrollment category
SET DGENCAT=$$CATEGORY^DGENA4(,$GET(DGENR("STATUS")))
+13 IF DGENCAT'="E"
QUIT
+14 SET DGENCAT=$$EXTERNAL^DILFD(27.15,.02,"",DGENCAT)
+15 SET DGENSTA=$SELECT($GET(DGENR("STATUS")):$$EXT^DGENU("STATUS",DGENR("STATUS")),1:"")
+16 SET DGENPRI=$SELECT($GET(DGENR("PRIORITY")):DGENR("PRIORITY"),1:"")_$SELECT($GET(DGENR("SUBGRP")):$$EXT^DGENU("SUBGRP",DGENR("SUBGRP")),1:"")
+17 ;check appts.
DO APPTCK
+18 ;RSA API error
IF +DGERROR
QUIT
+19 ;quit if appointment < 'date notified of request date'.
IF SDEXIT
QUIT
+20 ;if call list, quit if request status 'filled' or 'completed'.
+21 IF DGRPT=1
IF (SDCNT>0)!(DGSTA="C")!(DGSTA="F")
QUIT
+22 SET SDADT=$GET(SDADT)
+23 SET DGNAM=$$GET1^DIQ(2,DFNIEN,.01)
SET DGSSN=$EXTRACT($$GET1^DIQ(2,DFNIEN,.09),6,9)
+24 SET DGENCV=$$CVEDT^DGCV(DFNIEN)
SET DGENCVDT=$PIECE($GET(DGENCV),"^",2)
SET DGENCVEL=$PIECE($GET(DGENCV),"^",3)
+25 ;build temp file
+26 SET DGPFTF=$SELECT(+DGPFTF:$$GET1^DIQ(4,DGPFTF,.01)_"("_DGPFSITE_")",1:"ZZZZZ")
+27 SET DGSTA1=$SELECT(DGSTA="":1,DGSTA="I":2,DGSTA="E":3,DGSTA="F":4,1:DGSTA)
+28 SET ^TMP($JOB,"DGEN NEACL",DGPFTF,DGSTA1,DGRDTI,DGNAM,DFNIEN)=SDADT
+29 IF $GET(DGENCAT)'=""!($GET(DGENSTA)'="")!($GET(DGENPRI)'="")!($GET(DGENCVEL)'="")
Begin DoDot:1
+30 SET ^TMP($JOB,"DGEN NEACL",DGPFTF,DGSTA1,DGRDTI,DGNAM,DFNIEN,"PRIORITY")=DGENCAT_"^"_DGENSTA_"^"_DGENPRI_"^"_DGENCVEL
End DoDot:1
+31 QUIT
+32 ;
APPTCK ;
+1 ;quit, if no appointment questioned asked?
+2 SET DGRDTI=$$GET1^DIQ(2,DFNIEN,1010.1511,"I")
IF 'DGRDTI
SET SDEXIT=1
QUIT
+3 ;get request status
+4 SET DGSTA=$$GET1^DIQ(2,DFNIEN,1010.161,"I")
+5 ;look for any appointments made (quit if none, or appt. date < 'notify of request date'
+6 KILL ^TMP($JOB,"SDAMA301")
+7 SET SDARRY(4)=DFNIEN
+8 SET SDARRY("FLDS")=1
+9 SET SDARRY("MAX")=1
+10 SET SDEXIT=0
+11 SET SDCNT=$$SDAPI^SDAMA301(.SDARRY)
IF SDCNT<0
SET DGERROR=$$ERR()
QUIT
+12 ;no appointment
IF (SDCNT'>0)
QUIT
+13 ;quit if appointment < 'notify of request date'
+14 SET SDCL=0
FOR
SET SDCL=$ORDER(^TMP($JOB,"SDAMA301",DFNIEN,SDCL))
IF 'SDCL
QUIT
Begin DoDot:1
+15 IF $ORDER(^TMP($JOB,"SDAMA301",DFNIEN,SDCL,0))<DGRDTI
SET SDEXIT=1
End DoDot:1
IF SDEXIT=1
QUIT
+16 ;
+17 KILL ^TMP($JOB,"SDAMA301")
+18 ;Check appointments (scheduled/kept, inpatient, no action)
+19 ;look out from 'notify of request date' to future.
SET SDARRY(1)=DGRDTI_";"
+20 SET SDARRY(3)="R;I;NT"
+21 SET SDARRY(4)=DFNIEN
SET SDARRY("FLDS")=1
+22 SET SDCNT=$$SDAPI^SDAMA301(.SDARRY)
IF (SDCNT'>0)
QUIT
+23 ;Exclude no count clinic appointments from appointment count
+24 NEW SDCOUNT
+25 ;count clinic
SET SDCOUNT=0
+26 SET SDCL=0
FOR
SET SDCL=$ORDER(^TMP($JOB,"SDAMA301",DFNIEN,SDCL))
IF 'SDCL
QUIT
Begin DoDot:1
+27 ;don't include no-count
IF $$GET1^DIQ(44,SDCL,2502,"I")="Y"
QUIT
+28 ;get appointment date of count clinic
SET SDADT=$ORDER(^TMP($JOB,"SDAMA301",DFNIEN,SDCL,0))
+29 SET SDCOUNT=SDCOUNT+1
End DoDot:1
IF SDCOUNT
QUIT
+30 ;if no-count clinics was only one found, keep on call list.
IF SDCOUNT=0
SET SDCNT=0
QUIT
+31 ;if appointment found and status '="filled", set status to 'filled'
+32 IF DGSTA'="F"
Begin DoDot:1
+33 SET DGCOM=$$GET1^DIQ(2,DFNIEN,1010.163)
+34 SET DGCOM=DGCOM_$SELECT(DGCOM'="":"<>",1:"")_"AutoComm:"_$SELECT(DGSTA="":"null",1:$SELECT($$GET1^DIQ(2,DFNIEN,1010.161,"I")="I":"IN PROGRESS",1:$$GET1^DIQ(2,DFNIEN,1010.161)))_"|FILLED"
+35 SET FDATA(2,DFNIEN_",",1010.161)="F"
+36 SET FDATA(2,DFNIEN_",",1010.163)=DGCOM
+37 DO FILE^DIE("","FDATA","DPTERR")
+38 SET DGSTA=$$GET1^DIQ(2,DFNIEN,1010.161,"I")
End DoDot:1
+39 QUIT
ERR() ; Process error message.
+1 NEW DGERR
+2 SET DGERR=0
+3 IF $DATA(^TMP($JOB,"SDAMA301",101))
Begin DoDot:1
+4 SET DGERR=101_"^"_" *** RSA: Process DATABASE IS UNAVAILABLE ***"
End DoDot:1
+5 IF $DATA(^TMP($JOB,"SDAMA301",115))
Begin DoDot:1
+6 SET DGERR=115_"^"_" *** RSA: Appointment request filter contains invalid values ***"
End DoDot:1
+7 IF $DATA(^TMP($JOB,"SDAMA301",116))
Begin DoDot:1
+8 SET DGERR=116_"^"_" *** RSA: Data doesn't exist error has occurred ***"
End DoDot:1
+9 IF $DATA(^TMP($JOB,"SDAMA301",117))
Begin DoDot:1
+10 SET DGERR=117_"^"_" *** RSA: Other undefined error has occurred ***"
End DoDot:1
+11 QUIT DGERR
