ECXSCXN1 ;ALB/JAP Clinic Extract No Shows; 8/28/02 1:11pm ;1/25/19 10:50
;;3.0;DSS EXTRACTS;**71,105,127,132,136,144,166,170,174,184**;Dec 22, 1997;Build 124
NOSHOW(ECXSD,ECXED) ;get noshows from file #44
; ECXSD = start date, ECXED = end date
N ALEN,CLIN,JDATE,JJ,NODE,NOSHOW,PP,STAT,MDIV,ECXEDIS,CNT,ECXARR,ECXSDSC,ECXEDSC,ECXASIH ;136,170
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
N ECXSCST ;174 Call to PAT1^ECXSCX2 will set the service connected status
N ECXNOCNT ;174 Clinic non-count flag
S CLIN=0
F S CLIN=$O(^TMP($J,"ECXCL",CLIN)) Q:'CLIN!($G(QFLG)) D ;136
.Q:$P($G(^TMP($J,"ECXCL",CLIN)),U,3)'="C"
.S (P1,P2,P3,P4)="" ;166 add P4
.D FEEDER^ECXSCX1(CLIN,ECXSD,.P1,.P2,.P3,.TOSEND,.ECXDIV,.P4) ;166 add P4 parameter
.Q:TOSEND=6
.;find appts in date range
.S ECXSDSC=ECXSD+.1,ECXEDSC=$P(ECXED,".") ;136 get dates back into correct fileman format
.S (ALEN,NOSHOW)="" ;136
.K ^TMP($J,"SDAMA301") ;136
.S ECXARR(1)=ECXSDSC_";"_ECXEDSC,ECXARR(2)=CLIN,ECXARR(3)="NS;NSR",ECXARR("FLDS")="5;7;10;12;18" ;136
.S CNT=$$SDAPI^SDAMA301(.ECXARR) ;136
.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)
.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
..S ECXDATE=JDATE,ECXTI=$$ECXTIME^ECXUTL(JDATE) ;136,166
..S ECXDFN=JJ ;136
..S ECXPATCAT=$$PATCAT^ECXUTL(ECXDFN) ;added in patch 127
..S NODE=$G(^TMP($J,"SDAMA301",CLIN,JJ,JDATE)),MDIV=$P($G(^SC(CLIN,0)),U,15) ;136
..Q:NODE="" ;136
..S ECXNOCNT=$P($G(^TMP($J,"ECXCL",CLIN)),U,5) ;174 Get non-count status
..S ECXSHAD=$$GETSHAD ;added in patch 127, finds shad status for appt
..S ECXOBI=$S($P(NODE,U,7)="Y":"O",1:"") ;136
..S NOSHOW="N" ;136 only no-show entries are returned from the SDAMA301 call
..D INTPAT^ECXSCX2 S ECXERR=0
..D PAT1^ECXSCX2(ECXDFN,ECXDATE,.ECXERR) Q:ECXERR
..I ECXLOGIC>2022 S ECXNMPI=ECXMPI ;184
..S ALEN=$$RJ^XLFSTR($P(NODE,U,5),3,0) ;136
..D PAT2^ECXSCX2(ECXDFN,ECXDATE)
..S ECXPVST=+$P(NODE,U,18),ECXATYP=+$P(NODE,U,10) ;136 Get POV & appt type
..S:+ALEN=0 ALEN=$P($G(^TMP($J,"ECXCL",CLIN)),U,2)
..S ECXCLIN=CLIN,ECXSTOP=P1
..S ECXEDIS=$$EDIS^ECXUTL1(ECXDFN,ECXDATE,"N",,ECXSTOP) ;136
..I ECXLOGIC<2019 S:ECXCPT1="" ECXCPT1="9919901" ;170 tjl - Retain value for prior years
..I ECXLOGIC>2018 S:ECXCPT1="" ECXCQM1="9919901" ;170 tjl - Set new variable value
..S ECXCBOC=$S(MDIV'="":$$CBOC^ECXSCX2(.MDIV),1:"")
..S (ECXDSSD,ECXENEL,ECXIR,ECXAO,ECXMIL,ECXPROV,ECXPROVP,ECXPROVN,ECXPRX12)="" ;184 - Added ECXPRX12
..F I=1:1:7 S (@("ECSP"_I),@("ECSPPC"_I),@("ECSPNPI"_I))="" ;144 2 new prov groups
..I TOSEND'=3 D
...S ECXKEY=P1_P2_ALEN_P3_NOSHOW_P4,ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) ;166
...S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE^ECXSCXN
..I TOSEND=3 D
...S ECXKEY=P1_"000"_ALEN_P3_NOSHOW_P4,ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) ;166
...S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE^ECXSCXN
..I TOSEND=3 D
...S ECXKEY=P2_"000"_ALEN_P3_NOSHOW_P4,ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) ;166
...S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE^ECXSCXN
..;create a record for noshow appended ekg. The code was removed for CTX-0604-70970 CLI Extract Problem EXPANDED to NoShows
Q
;GETSHAD section added with patch 127
GETSHAD() ;Function returns shad value
N DIC,LOCARR,DA,DR,SHAD,ECXERR,ECXVIST
S SHAD=""
I '+$P($G(NODE),U,12) Q SHAD ;136 Quit if no outpatient encounter pointer
S DIC=409.68,DA=$P(NODE,U,12),DR=.05,DIQ(0)="I",DIQ="LOCARR" ;136
D EN^DIQ1
I $G(LOCARR(409.68,DA,.05,"I")) D
.S ECXERR=0
.D VISIT^ECXSCX1(ECXDFN,LOCARR(409.68,DA,.05,"I"),.ECXVIST,.ECXERR)
.I 'ECXERR S SHAD=ECXVIST("SHAD")
Q SHAD
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXSCXN1 4134 printed Apr 09, 2024@20:59:35 Page 2
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
NOSHOW(ECXSD,ECXED) ;get noshows from file #44
+1 ; ECXSD = start date, ECXED = end date
+2 ;136,170
NEW ALEN,CLIN,JDATE,JJ,NODE,NOSHOW,PP,STAT,MDIV,ECXEDIS,CNT,ECXARR,ECXSDSC,ECXEDSC,ECXASIH
+3 ;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
NEW ECXECL,ECXESC,ECXCLST
+4 ;174 Call to PAT1^ECXSCX2 will set the service connected status
NEW ECXSCST
+5 ;174 Clinic non-count flag
NEW ECXNOCNT
+6 SET CLIN=0
+7 ;136
FOR
SET CLIN=$ORDER(^TMP($JOB,"ECXCL",CLIN))
if 'CLIN!($GET(QFLG))
QUIT
Begin DoDot:1
+8 if $PIECE($GET(^TMP($JOB,"ECXCL",CLIN)),U,3)'="C"
QUIT
+9 ;166 add P4
SET (P1,P2,P3,P4)=""
+10 ;166 add P4 parameter
DO FEEDER^ECXSCX1(CLIN,ECXSD,.P1,.P2,.P3,.TOSEND,.ECXDIV,.P4)
+11 if TOSEND=6
QUIT
+12 ;find appts in date range
+13 ;136 get dates back into correct fileman format
SET ECXSDSC=ECXSD+.1
SET ECXEDSC=$PIECE(ECXED,".")
+14 ;136
SET (ALEN,NOSHOW)=""
+15 ;136
KILL ^TMP($JOB,"SDAMA301")
+16 ;136
SET ECXARR(1)=ECXSDSC_";"_ECXEDSC
SET ECXARR(2)=CLIN
SET ECXARR(3)="NS;NSR"
SET ECXARR("FLDS")="5;7;10;12;18"
+17 ;136
SET CNT=$$SDAPI^SDAMA301(.ECXARR)
+18 ;136 Stop if no data (CNT=0) and send error message if scheduling system down (CNT=-1)
if CNT=0
QUIT
IF CNT=-1
DO ERR^ECXUTL1
SET QFLG=1
QUIT
+19 ;136
SET JJ=0
FOR
SET JJ=$ORDER(^TMP($JOB,"SDAMA301",CLIN,JJ))
if '+JJ
QUIT
SET JDATE=""
FOR
SET JDATE=$ORDER(^TMP($JOB,"SDAMA301",CLIN,JJ,JDATE))
if '+JDATE
QUIT
Begin DoDot:2
+20 ;136,166
SET ECXDATE=JDATE
SET ECXTI=$$ECXTIME^ECXUTL(JDATE)
+21 ;136
SET ECXDFN=JJ
+22 ;added in patch 127
SET ECXPATCAT=$$PATCAT^ECXUTL(ECXDFN)
+23 ;136
SET NODE=$GET(^TMP($JOB,"SDAMA301",CLIN,JJ,JDATE))
SET MDIV=$PIECE($GET(^SC(CLIN,0)),U,15)
+24 ;136
if NODE=""
QUIT
+25 ;174 Get non-count status
SET ECXNOCNT=$PIECE($GET(^TMP($JOB,"ECXCL",CLIN)),U,5)
+26 ;added in patch 127, finds shad status for appt
SET ECXSHAD=$$GETSHAD
+27 ;136
SET ECXOBI=$SELECT($PIECE(NODE,U,7)="Y":"O",1:"")
+28 ;136 only no-show entries are returned from the SDAMA301 call
SET NOSHOW="N"
+29 DO INTPAT^ECXSCX2
SET ECXERR=0
+30 DO PAT1^ECXSCX2(ECXDFN,ECXDATE,.ECXERR)
if ECXERR
QUIT
+31 ;184
IF ECXLOGIC>2022
SET ECXNMPI=ECXMPI
+32 ;136
SET ALEN=$$RJ^XLFSTR($PIECE(NODE,U,5),3,0)
+33 DO PAT2^ECXSCX2(ECXDFN,ECXDATE)
+34 ;136 Get POV & appt type
SET ECXPVST=+$PIECE(NODE,U,18)
SET ECXATYP=+$PIECE(NODE,U,10)
+35 if +ALEN=0
SET ALEN=$PIECE($GET(^TMP($JOB,"ECXCL",CLIN)),U,2)
+36 SET ECXCLIN=CLIN
SET ECXSTOP=P1
+37 ;136
SET ECXEDIS=$$EDIS^ECXUTL1(ECXDFN,ECXDATE,"N",,ECXSTOP)
+38 ;170 tjl - Retain value for prior years
IF ECXLOGIC<2019
if ECXCPT1=""
SET ECXCPT1="9919901"
+39 ;170 tjl - Set new variable value
IF ECXLOGIC>2018
if ECXCPT1=""
SET ECXCQM1="9919901"
+40 SET ECXCBOC=$SELECT(MDIV'="":$$CBOC^ECXSCX2(.MDIV),1:"")
+41 ;184 - Added ECXPRX12
SET (ECXDSSD,ECXENEL,ECXIR,ECXAO,ECXMIL,ECXPROV,ECXPROVP,ECXPROVN,ECXPRX12)=""
+42 ;144 2 new prov groups
FOR I=1:1:7
SET (@("ECSP"_I),@("ECSPPC"_I),@("ECSPNPI"_I))=""
+43 IF TOSEND'=3
Begin DoDot:3
+44 ;166
SET ECXKEY=P1_P2_ALEN_P3_NOSHOW_P4
SET ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY)
+45 SET ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,)
if ECXENC'=""
DO FILE^ECXSCXN
End DoDot:3
+46 IF TOSEND=3
Begin DoDot:3
+47 ;166
SET ECXKEY=P1_"000"_ALEN_P3_NOSHOW_P4
SET ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY)
+48 SET ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,)
if ECXENC'=""
DO FILE^ECXSCXN
End DoDot:3
+49 IF TOSEND=3
Begin DoDot:3
+50 ;166
SET ECXKEY=P2_"000"_ALEN_P3_NOSHOW_P4
SET ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY)
+51 SET ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,)
if ECXENC'=""
DO FILE^ECXSCXN
End DoDot:3
+52 ;create a record for noshow appended ekg. The code was removed for CTX-0604-70970 CLI Extract Problem EXPANDED to NoShows
End DoDot:2
End DoDot:1
+53 QUIT
+54 ;GETSHAD section added with patch 127
GETSHAD() ;Function returns shad value
+1 NEW DIC,LOCARR,DA,DR,SHAD,ECXERR,ECXVIST
+2 SET SHAD=""
+3 ;136 Quit if no outpatient encounter pointer
IF '+$PIECE($GET(NODE),U,12)
QUIT SHAD
+4 ;136
SET DIC=409.68
SET DA=$PIECE(NODE,U,12)
SET DR=.05
SET DIQ(0)="I"
SET DIQ="LOCARR"
+5 DO EN^DIQ1
+6 IF $GET(LOCARR(409.68,DA,.05,"I"))
Begin DoDot:1
+7 SET ECXERR=0
+8 DO VISIT^ECXSCX1(ECXDFN,LOCARR(409.68,DA,.05,"I"),.ECXVIST,.ECXERR)
+9 IF 'ECXERR
SET SHAD=ECXVIST("SHAD")
End DoDot:1
+10 QUIT SHAD
