Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGENACL2

DGENACL2.m

Go to the documentation of this file.
  1. DGENACL2 ;ALB/MRY,ARF,ARF - NEW ENROLLEE APPOINTMENT CALL LIST - UPDATE ;08/14/2008
  1. ;;5.3;Registration;**788,893,982,1015**;08/13/93;Build 7
  1. ;
  1. EXTRACT ;
  1. N DGNAM,DGSSN,DGENRIEN,DGENR,DGENCAT,DGENSTA,DGSTA1,DGENPRI,DGENCV,DGENCVDT,DGENCVEL,DGCOM,DGPFSITE
  1. N SDCNT,SDADT,SDARRY,SDCL,Y,FDATA,SDEXIT,DGRDTI,DGSTA
  1. ;get preferred facility
  1. S DGPFSITE=$$GET1^DIQ(4,+$$GET1^DIQ(2,DFNIEN,27.02,"I"),99)
  1. S DGPFTF=$S(+$$GET1^DIQ(2,DFNIEN,27.02,"I"):$$GET1^DIQ(2,DFNIEN,27.02,"I"),1:"NULL")
  1. I $E(DGSITE,1,3)'=$E(DGPFSITE,1,3) Q ;DG*5.3*893 LLS replaced: I +DGSITE'=+DGPFSITE Q ;if not same division skip
  1. I DGPFTFLG=1,'$D(DGPFTF(DGPFTF)) Q ;selection of preferred facilities
  1. ;get enrollment information
  1. S DGENRIEN=$$FINDCUR^DGENA(DFNIEN)
  1. I DGENRIEN,$$GET^DGENA(DGENRIEN,.DGENR) ;set-up enrollment arry
  1. I $G(DGENR("APP"))<3050801 Q
  1. S DGENCAT=$$CATEGORY^DGENA4(,$G(DGENR("STATUS"))) ;enrollment category
  1. I DGENCAT'="E" Q
  1. S DGENCAT=$$EXTERNAL^DILFD(27.15,.02,"",DGENCAT)
  1. S DGENSTA=$S($G(DGENR("STATUS")):$$EXT^DGENU("STATUS",DGENR("STATUS")),1:"")
  1. S DGENPRI=$S($G(DGENR("PRIORITY")):DGENR("PRIORITY"),1:"")_$S($G(DGENR("SUBGRP")):$$EXT^DGENU("SUBGRP",DGENR("SUBGRP")),1:"")
  1. D APPTCK ;check appts.
  1. I +DGERROR Q ;RSA API error
  1. I SDEXIT Q ;quit if appointment < 'date notified of request date'.
  1. ;if call list, quit if request status 'filled' or 'cancelled'.
  1. ; jam - dg*5.3*982 - remove (SDCNT>0) condition (number of appts) - The number of appointments is irrelevant to whether or not a patient is on the call list
  1. ;I DGRPT=1 Q:(SDCNT>0)!(DGSTA="C")!(DGSTA="F")
  1. I DGRPT=1 Q:(DGSTA="C")!(DGSTA="F")
  1. S SDADT=$G(SDADT)
  1. S DGNAM=$$GET1^DIQ(2,DFNIEN,.01),DGSSN=$E($$GET1^DIQ(2,DFNIEN,.09),6,9)
  1. S DGENCV=$$CVEDT^DGCV(DFNIEN),DGENCVDT=$P($G(DGENCV),"^",2),DGENCVEL=$P($G(DGENCV),"^",3)
  1. ;build temp file
  1. S DGPFTF=$S(+DGPFTF:$$GET1^DIQ(4,DGPFTF,.01)_"("_DGPFSITE_")",1:"ZZZZZ")
  1. S DGSTA1=$S(DGSTA="":1,DGSTA="I":2,DGSTA="E":3,DGSTA="F":4,1:DGSTA)
  1. S ^TMP($J,"DGEN NEACL",DGPFTF,DGSTA1,DGRDTI,DGNAM,DFNIEN)=SDADT
  1. I $G(DGENCAT)'=""!($G(DGENSTA)'="")!($G(DGENPRI)'="")!($G(DGENCVEL)'="") D
  1. . S ^TMP($J,"DGEN NEACL",DGPFTF,DGSTA1,DGRDTI,DGNAM,DFNIEN,"PRIORITY")=DGENCAT_"^"_DGENSTA_"^"_DGENPRI_"^"_DGENCVEL
  1. Q
  1. ;
  1. APPTCK ;
  1. ;quit, if no appointment questioned asked?
  1. S DGRDTI=$$GET1^DIQ(2,DFNIEN,1010.1511,"I") I 'DGRDTI S SDEXIT=1 Q
  1. ;get request status
  1. S DGSTA=$$GET1^DIQ(2,DFNIEN,1010.161,"I")
  1. ;look for any appointments made (quit if none, or appt. date < 'notify of request date'
  1. K ^TMP($J,"SDAMA301")
  1. S SDARRY(4)=DFNIEN
  1. S SDARRY("FLDS")=1
  1. S SDARRY("MAX")=1
  1. S SDEXIT=0
  1. S SDCNT=$$SDAPI^SDAMA301(.SDARRY) I SDCNT<0 S DGERROR=$$ERR() Q
  1. Q:(SDCNT'>0) ;no appointment
  1. ;quit if appointment < 'notify of request date'
  1. S SDCL=0 F S SDCL=$O(^TMP($J,"SDAMA301",DFNIEN,SDCL)) Q:'SDCL D I SDEXIT=1 Q
  1. . I $O(^TMP($J,"SDAMA301",DFNIEN,SDCL,0))<DGRDTI S SDEXIT=1
  1. ;
  1. K ^TMP($J,"SDAMA301")
  1. ;Check appointments (scheduled/kept, inpatient, no action)
  1. S SDARRY(1)=DGRDTI_";" ;look out from 'notify of request date' to future.
  1. S SDARRY(3)="R;I;NT"
  1. S SDARRY(4)=DFNIEN,SDARRY("FLDS")=1 ;arf - DG*5.3*1015 - added SDARRY("FLDS")
  1. ; jam; DG*5.3*982; add fields 13, 14 and 15 (Primary Stop Code and IEN and Credit Stop Code and IEN and Non-Count Clinic indicator)
  1. ;S SDARRY("FLDS")="13;14;15" ;arf - DG*5.3*1015 - line commented out
  1. K SDARRY("MAX") ;DG*5.3*893 LLS - added
  1. ;jam DG*5.3*982 - add check for error returned from API
  1. ; call to API ($$SDAPI^SDAMA301) is supported by ICR #4433
  1. S SDCNT=$$SDAPI^SDAMA301(.SDARRY) I SDCNT<0 S DGERROR=$$ERR() Q
  1. Q:(SDCNT'>0)
  1. ;
  1. ;N DGSTOP,DGCREDIT,DGAPPT ;DG*5.3*982 - arf - added new variables ;arf - DG*5.3*1015 line commented out
  1. ;DG*5.3*893 - LLS - This is the begin of the modified section.
  1. K ^TMP("DGEN",$J,"BY_APPT_DT")
  1. S SDCL=0 F S SDCL=$O(^TMP($J,"SDAMA301",DFNIEN,SDCL)) Q:'SDCL D ;re-sort by appt dt/tm
  1. . I $$GET1^DIQ(44,SDCL,2502,"I")="Y" Q ;don't include no-count clinic appointment
  1. . S SDADT="" F S SDADT=$O(^TMP($J,"SDAMA301",DFNIEN,SDCL,SDADT)) Q:'SDADT D
  1. . . S ^TMP("DGEN",$J,"BY_APPT_DT",SDADT)=^TMP($J,"SDAMA301",DFNIEN,SDCL,SDADT)
  1. ;. S SDADT="" F S SDADT=$O(^TMP($J,"SDAMA301",DFNIEN,SDCL,SDADT)) Q:'SDADT D ;arf - DG*5.3*1015 next 8 lines commented to remove functionality
  1. ;. . S DGAPPT=^TMP($J,"SDAMA301",DFNIEN,SDCL,SDADT)
  1. ;. . I $P(DGAPPT,U,15)="Y" Q ; - do not include non-count clinic appointments - DG*5.3*982 - modified - use p15 instead of global reference
  1. ;. . ; DG*5.3*982 Check for Primary Care Appointments:
  1. ;. . S DGCREDIT=$P($P(DGAPPT,U,14),";",2) ; - Set the appointment's Credit Stop Code
  1. ;. . S DGSTOP=$P($P(DGAPPT,U,13),";",2) ; - Set the appointment's Stop Code Number
  1. ;. . I '$$PCACHK(DGSTOP,DGCREDIT) Q ; - Check for a Primary Care Appointment match - quit if not
  1. ;. . S ^TMP("DGEN",$J,"BY_APPT_DT",SDADT)=^TMP($J,"SDAMA301",DFNIEN,SDCL,SDADT) ; - Only Primary Care Appointments ;arf - DG*5.3*1015 end
  1. ;
  1. S SDADT=$O(^TMP("DGEN",$J,"BY_APPT_DT",""))
  1. I SDADT="" Q ;no appointments found for 'count' clinics, so keep on call list
  1. ;DG*5.3*893 - LLS - This is the end of the modified section.
  1. ;
  1. ;if appointment found and status '="filled", set status to 'filled'
  1. I DGSTA'="F" D
  1. . S DGCOM=$$GET1^DIQ(2,DFNIEN,1010.163)
  1. . 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"
  1. . S FDATA(2,DFNIEN_",",1010.161)="F"
  1. . S FDATA(2,DFNIEN_",",1010.163)=DGCOM
  1. . D FILE^DIE("","FDATA","DPTERR")
  1. . S DGSTA=$$GET1^DIQ(2,DFNIEN,1010.161,"I")
  1. Q
  1. ERR() ; Process error message.
  1. N DGERR
  1. S DGERR=0
  1. I $D(^TMP($J,"SDAMA301",101)) D
  1. . S DGERR=101_"^"_" *** RSA: Process DATABASE IS UNAVAILABLE ***"
  1. I $D(^TMP($J,"SDAMA301",115)) D
  1. . S DGERR=115_"^"_" *** RSA: Appointment request filter contains invalid values ***"
  1. I $D(^TMP($J,"SDAMA301",116)) D
  1. . S DGERR=116_"^"_" *** RSA: Data doesn't exist error has occurred ***"
  1. I $D(^TMP($J,"SDAMA301",117)) D
  1. . S DGERR=117_"^"_" *** RSA: Other undefined error has occurred ***"
  1. Q DGERR
  1. ;
  1. PCACHK(DGSTCODE,DGCRCODE) ; Check for Primary Care Appt. ; jam; DG*5.3*982
  1. ; Input: DGSTCODE - Stop Code
  1. ; DGCRCODE - Credit Stop Code
  1. ; Returns; TRUE if Stop Code and Credit Stop Code combination qualifies as a Primary Care Appt.
  1. N DGPCA,DGCNT,DGLINE
  1. S DGPCA=0
  1. F DGCNT=1:1 S DGLINE=$P($T(CCODES+DGCNT),";;",2) Q:DGLINE="" I $P(DGLINE,";")=$G(DGSTCODE) D Q
  1. . I $P(DGLINE,";",2)[("^"_$G(DGCRCODE)_"^") S DGPCA=1
  1. Q DGPCA
  1. CCODES ; jam; DG*5.3*982 ;Stop and Credit Stop Codes that qualify as Primary Care appt. - FORMAT: ;;StopCode;^CreditStopCode1^CreditStopCode2^....^
  1. ;;160;^322^323^
  1. ;;210;^322^323^
  1. ;;310;^322^323^
  1. ;;313;^322^323^
  1. ;;322;^117^160^185^186^187^188^^
  1. ;;323;^117^160^185^186^187^188^^
  1. ;;348;^117^160^185^186^187^188^^
  1. ;;350;^117^160^185^186^187^188^^