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

ECXSCXN1.m

Go to the documentation of this file.
  1. ECXSCXN1 ;ALB/JAP Clinic Extract No Shows; 8/28/02 1:11pm ;1/25/19 10:50
  1. ;;3.0;DSS EXTRACTS;**71,105,127,132,136,144,166,170,174,184**;Dec 22, 1997;Build 124
  1. NOSHOW(ECXSD,ECXED) ;get noshows from file #44
  1. ; ECXSD = start date, ECXED = end date
  1. N ALEN,CLIN,JDATE,JJ,NODE,NOSHOW,PP,STAT,MDIV,ECXEDIS,CNT,ECXARR,ECXSDSC,ECXEDSC,ECXASIH ;136,170
  1. N ECXECL,ECXESC,ECXCLST ;144 Call to INTPAT^ECXSCX2 sets variables to null. Call to PAT1^ECXSCX2 will set camp lejeune status when available. Encounter values remain null as appt is a no-show
  1. N ECXSCST ;174 Call to PAT1^ECXSCX2 will set the service connected status
  1. N ECXNOCNT ;174 Clinic non-count flag
  1. S CLIN=0
  1. F S CLIN=$O(^TMP($J,"ECXCL",CLIN)) Q:'CLIN!($G(QFLG)) D ;136
  1. .Q:$P($G(^TMP($J,"ECXCL",CLIN)),U,3)'="C"
  1. .S (P1,P2,P3,P4)="" ;166 add P4
  1. .D FEEDER^ECXSCX1(CLIN,ECXSD,.P1,.P2,.P3,.TOSEND,.ECXDIV,.P4) ;166 add P4 parameter
  1. .Q:TOSEND=6
  1. .;find appts in date range
  1. .S ECXSDSC=ECXSD+.1,ECXEDSC=$P(ECXED,".") ;136 get dates back into correct fileman format
  1. .S (ALEN,NOSHOW)="" ;136
  1. .K ^TMP($J,"SDAMA301") ;136
  1. .S ECXARR(1)=ECXSDSC_";"_ECXEDSC,ECXARR(2)=CLIN,ECXARR(3)="NS;NSR",ECXARR("FLDS")="5;7;10;12;18" ;136
  1. .S CNT=$$SDAPI^SDAMA301(.ECXARR) ;136
  1. .Q:CNT=0 I CNT=-1 D ERR^ECXUTL1 S QFLG=1 Q ;136 Stop if no data (CNT=0) and send error message if scheduling system down (CNT=-1)
  1. .S JJ=0 F S JJ=$O(^TMP($J,"SDAMA301",CLIN,JJ)) Q:'+JJ S JDATE="" F S JDATE=$O(^TMP($J,"SDAMA301",CLIN,JJ,JDATE)) Q:'+JDATE D ;136
  1. ..S ECXDATE=JDATE,ECXTI=$$ECXTIME^ECXUTL(JDATE) ;136,166
  1. ..S ECXDFN=JJ ;136
  1. ..S ECXPATCAT=$$PATCAT^ECXUTL(ECXDFN) ;added in patch 127
  1. ..S NODE=$G(^TMP($J,"SDAMA301",CLIN,JJ,JDATE)),MDIV=$P($G(^SC(CLIN,0)),U,15) ;136
  1. ..Q:NODE="" ;136
  1. ..S ECXNOCNT=$P($G(^TMP($J,"ECXCL",CLIN)),U,5) ;174 Get non-count status
  1. ..S ECXSHAD=$$GETSHAD ;added in patch 127, finds shad status for appt
  1. ..S ECXOBI=$S($P(NODE,U,7)="Y":"O",1:"") ;136
  1. ..S NOSHOW="N" ;136 only no-show entries are returned from the SDAMA301 call
  1. ..D INTPAT^ECXSCX2 S ECXERR=0
  1. ..D PAT1^ECXSCX2(ECXDFN,ECXDATE,.ECXERR) Q:ECXERR
  1. ..I ECXLOGIC>2022 S ECXNMPI=ECXMPI ;184
  1. ..S ALEN=$$RJ^XLFSTR($P(NODE,U,5),3,0) ;136
  1. ..D PAT2^ECXSCX2(ECXDFN,ECXDATE)
  1. ..S ECXPVST=+$P(NODE,U,18),ECXATYP=+$P(NODE,U,10) ;136 Get POV & appt type
  1. ..S:+ALEN=0 ALEN=$P($G(^TMP($J,"ECXCL",CLIN)),U,2)
  1. ..S ECXCLIN=CLIN,ECXSTOP=P1
  1. ..S ECXEDIS=$$EDIS^ECXUTL1(ECXDFN,ECXDATE,"N",,ECXSTOP) ;136
  1. ..I ECXLOGIC<2019 S:ECXCPT1="" ECXCPT1="9919901" ;170 tjl - Retain value for prior years
  1. ..I ECXLOGIC>2018 S:ECXCPT1="" ECXCQM1="9919901" ;170 tjl - Set new variable value
  1. ..S ECXCBOC=$S(MDIV'="":$$CBOC^ECXSCX2(.MDIV),1:"")
  1. ..S (ECXDSSD,ECXENEL,ECXIR,ECXAO,ECXMIL,ECXPROV,ECXPROVP,ECXPROVN,ECXPRX12)="" ;184 - Added ECXPRX12
  1. ..F I=1:1:7 S (@("ECSP"_I),@("ECSPPC"_I),@("ECSPNPI"_I))="" ;144 2 new prov groups
  1. ..I TOSEND'=3 D
  1. ...S ECXKEY=P1_P2_ALEN_P3_NOSHOW_P4,ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) ;166
  1. ...S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE^ECXSCXN
  1. ..I TOSEND=3 D
  1. ...S ECXKEY=P1_"000"_ALEN_P3_NOSHOW_P4,ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) ;166
  1. ...S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE^ECXSCXN
  1. ..I TOSEND=3 D
  1. ...S ECXKEY=P2_"000"_ALEN_P3_NOSHOW_P4,ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) ;166
  1. ...S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE^ECXSCXN
  1. ..;create a record for noshow appended ekg. The code was removed for CTX-0604-70970 CLI Extract Problem EXPANDED to NoShows
  1. Q
  1. ;GETSHAD section added with patch 127
  1. GETSHAD() ;Function returns shad value
  1. N DIC,LOCARR,DA,DR,SHAD,ECXERR,ECXVIST
  1. S SHAD=""
  1. I '+$P($G(NODE),U,12) Q SHAD ;136 Quit if no outpatient encounter pointer
  1. S DIC=409.68,DA=$P(NODE,U,12),DR=.05,DIQ(0)="I",DIQ="LOCARR" ;136
  1. D EN^DIQ1
  1. I $G(LOCARR(409.68,DA,.05,"I")) D
  1. .S ECXERR=0
  1. .D VISIT^ECXSCX1(ECXDFN,LOCARR(409.68,DA,.05,"I"),.ECXVIST,.ECXERR)
  1. .I 'ECXERR S SHAD=ECXVIST("SHAD")
  1. Q SHAD