| [623] | 1 | ECXSCXN1 ;ALB/JAP Clinic Extract No Shows; 8/28/02 1:11pm ; 10/26/04 10:35am
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**71**;Dec 22, 1997
|
|---|
| 3 | NOSHOW(ECXSD,ECXED) ;get noshows from file #44
|
|---|
| 4 | ; ECXSD = start date, ECXED = end date
|
|---|
| 5 | N ALEN,CLIN,JDATE,JJ,NODE,NOSHOW,PP,STAT,MDIV
|
|---|
| 6 | S CLIN=0
|
|---|
| 7 | F S CLIN=$O(^TMP($J,"ECXCL",CLIN)) Q:'CLIN D
|
|---|
| 8 | .Q:$P($G(^TMP($J,"ECXCL",CLIN)),U,3)'="C"
|
|---|
| 9 | .S (P1,P2,P3)=""
|
|---|
| 10 | .D FEEDER^ECXSCX1(CLIN,ECXSD,.P1,.P2,.P3,.TOSEND,.ECXDIV)
|
|---|
| 11 | .Q:TOSEND=6
|
|---|
| 12 | .;find appts in date range
|
|---|
| 13 | .S JDATE=ECXSD,(ALEN,NOSHOW)=""
|
|---|
| 14 | .F S JDATE=$O(^SC(CLIN,"S",JDATE)) Q:'JDATE Q:JDATE>ECXED D
|
|---|
| 15 | ..S ECXDATE=JDATE,JJ=0,ECXTI=$P($$FMTE^XLFDT(JDATE,1),"@",2)
|
|---|
| 16 | ..S ECXTI=$E(($TR(ECXTI,":","")_"000000"),1,6)
|
|---|
| 17 | ..S:ECXTI="000000" ECXTI="000300"
|
|---|
| 18 | ..;get noshows only - no data in check-in/check-out node
|
|---|
| 19 | ..F S JJ=$O(^SC(CLIN,"S",JDATE,JJ)) Q:'JJ D
|
|---|
| 20 | ...S K=0
|
|---|
| 21 | ...F S K=$O(^SC(CLIN,"S",JDATE,JJ,K)) Q:'K D
|
|---|
| 22 | ....S PP=$G(^SC(CLIN,"S",JDATE,JJ,K,0)),ECXDFN=$P(PP,U) Q:ECXDFN=""
|
|---|
| 23 | ....S NODE=$G(^DPT(ECXDFN,"S",JDATE,0)),MDIV=$P($G(^SC(CLIN,0)),U,15)
|
|---|
| 24 | ....Q:(NODE="")!($P(NODE,U)'=CLIN)
|
|---|
| 25 | ....S ECXOBI=$G(^SC(CLIN,"S",JDATE,JJ,K,"OB")),STAT=$P(NODE,U,2)
|
|---|
| 26 | ....S NOSHOW=$S(STAT="N":"N",STAT="NA":"N",1:"")
|
|---|
| 27 | ....Q:NOSHOW="" D INTPAT^ECXSCX2 S ECXERR=0
|
|---|
| 28 | ....D PAT1^ECXSCX2(ECXDFN,ECXDATE,.ECXERR) Q:ECXERR
|
|---|
| 29 | ....S ALEN=$P(PP,U,2),ALEN=$$RJ^XLFSTR(ALEN,3,0)
|
|---|
| 30 | ....D PAT2^ECXSCX2(ECXDFN,ECXDATE)
|
|---|
| 31 | ....S ECXPVST=$P(NODE,U,7),ECXATYP=$P(NODE,U,16) ;Get POV & appt type
|
|---|
| 32 | ....S:+ALEN=0 ALEN=$P($G(^TMP($J,"ECXCL",CLIN)),U,2)
|
|---|
| 33 | ....S ECXCLIN=CLIN,ECXSTOP=P1 S:ECXICD9P="" ECXICD9P="799.9"
|
|---|
| 34 | ....S:ECXCPT1="" ECXCPT1="9919901"
|
|---|
| 35 | ....S ECXCBOC=$S(MDIV'="":$$CBOC^ECXSCX2(.MDIV),1:"")
|
|---|
| 36 | ....S (ECXDSSD,ECXENEL,ECXIR,ECXAO,ECXMIL,ECXPROV,ECXPROVP,ECXPROVN)=""
|
|---|
| 37 | ....I TOSEND'=3 D
|
|---|
| 38 | .....S ECXKEY=P1_P2_ALEN_P3_NOSHOW,ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY)
|
|---|
| 39 | .....S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE^ECXSCXN
|
|---|
| 40 | ....I TOSEND=3 D
|
|---|
| 41 | .....S ECXKEY=P1_"000"_ALEN_P3_NOSHOW,ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY)
|
|---|
| 42 | .....S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE^ECXSCXN
|
|---|
| 43 | ....I TOSEND=3 D
|
|---|
| 44 | .....S ECXKEY=P2_"000"_ALEN_P3_NOSHOW,ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY)
|
|---|
| 45 | .....S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE^ECXSCXN
|
|---|
| 46 | ....;create a record for noshow appended ekg. The code was removed for CTX-0604-70970 CLI Extract Problem EXPANDED to NoShows
|
|---|
| 47 | Q
|
|---|
