ECUTL1 ;ALB/ESD - Event Capture Classification Utilities ;11/5/18 12:35
;;2.0;EVENT CAPTURE;**10,13,17,42,54,76,107,122,126,130,145**;8 May 96;Build 6
;
ASKCLASS(DFN,ECANS,ERR,ECTOPCE,ECPATST,ECHDA) ; Ask classification questions
; (Agent Orange, Ionizing Radiation, Environmental Contaminants/South
; West Asia Conditions, Service Connected, Military Sexual Trauma,
; Head/Neck Cancer, Combat Veteran, Project 112/SHAD)
;
; Input:
; DFN - IEN of Patient file (#2)
; ECTOPCE - Variable which indicates if DSS Unit is sending to PCE
; ECPATST - Inpatient/outpatient status
; ECHDA - IEN in file #721 if editing existing record [optional]
;
; Output:
; ECANS - array subscripted by classification abbreviation
; (i.e. ECANS("AO")) and passed by reference containing:
; field # of class from EC Patient file (#721)^answer
; ERR - Error indicator if user uparrows or times out (set to 1)
;
; Function value - 1 if successful, 0 otherwise
;
N ANS,DIR,ECCL,ECCLFLD,SUCCESS,ECVST,ECVSTDT,ECPXB,PXBDATA,ECNT,ECOLD,ECPIECE,ECXX
S (ECANS,ECCL)=""
S ERR=0
S SUCCESS=1
S DFN=+$G(DFN)
S ECTOPCE=$G(ECTOPCE)
I ECTOPCE["~" S ECTOPCE=$P(ECTOPCE,"~",2)
S ECPATST=$G(ECPATST)
;- Drop out if invalid condition found OR if DSS Unit not sending to
; PCE or patient is an inpatient
I ('DFN)!(ECTOPCE="")!(ECPATST="")!(ECTOPCE="N")!(ECPATST="I") S SUCCESS=0 Q SUCCESS
D NOW^%DTC S ECVSTDT=$S(+$G(ECDT):ECDT,1:%),ECVST="" ;modified to use event date;JAM/11/24/03
;- If editing an existing record, get visit data & display classification
I $G(ECHDA) D
.S ECVSTDT=$P($G(^ECH(ECHDA,0)),U,3)
.S ECVST=$P($G(^ECH(ECHDA,0)),U,21)
.F ECCL="AO","IR","EC","SC","MST","HNC","CV","SHAD" D
..S ECPIECE=$S(ECCL="AO":3,ECCL="IR":4,ECCL="EC":5,ECCL="SC":6,ECCL="MST":9,ECCL="HNC":10,ECCL="CV":11,1:12)
..S ECCLFLD=$P("^^Agent Orange^Ionizing Radiation^South West Asia Conditions^Service Connected^^^Military Sexual Trauma^Head/Neck Cancer^Combat Veteran^Project 112/SHAD","^",ECPIECE)
..S ECXX=$P($G(^ECH(ECHDA,"P")),U,ECPIECE),ECXX=$S(ECXX="Y":"YES",ECXX="N":"NO",1:"")
..I ECXX]"" S ECOLD(ECCL)=ECCLFLD_": "_ECXX
.I $D(ECOLD) D
..W !,"*** Current encounter classification ***",!
..F ECCL="SC","CV","AO","IR","EC","MST","HNC","SHAD" D
...I $D(ECOLD(ECCL)) W !?4,ECOLD(ECCL)
;- Ask user classification question
D CLASS^PXBAPI21("",DFN,ECVSTDT,1,ECVST) W !
;- Check error; exit if error condition
I $D(PXBDATA("ERR")) D I ERR S SUCCESS=0 Q SUCCESS
.F ECPXB=1:1:4 I $D(PXBDATA("ERR",ECPXB)) D
..I (PXBDATA("ERR",ECPXB)=1)!(PXBDATA("ERR",ECPXB)=4) S ERR=1
;- Otherwise, continue to setup ecans array, i.e., new classification data
F ECCL="AO","IR","SC","EC","MST","HNC","CV","SHAD" D
.S ECCLFLD=$S(ECCL="AO":21,ECCL="IR":22,ECCL="EC":23,ECCL="SC":24,ECCL="MST":35,ECCL="HNC":39,ECCL="CV":40,1:41)
.S ECPXB=$S(ECCL="AO":1,ECCL="IR":2,ECCL="EC":4,ECCL="SC":3,ECCL="MST":5,ECCL="CV":7,ECCL="SHAD":8,1:6)
.S ANS=$P($G(PXBDATA(ECPXB)),U,2),ANS=$S(ANS=1:"Y",ANS=0:"N",1:"")
.S ECANS(ECCL)=ECCLFLD_"^"_ANS
;- Delete old data if it exists
I $G(ECHDA) D DELCLASS(ECHDA)
Q SUCCESS
;
;
EDCLASS(ECIEN,ECANS) ; Edit classifications fields in EC Patient
; file (#721)
;
; Input:
; ECIEN - EC Patient record (#721) IEN
; ECANS - Array of answers to classification questions asked
;
; Output:
; Classification fields 21,22,23,24,35,39,40,41 edited in file #721
;
N DA,DIE,DR,ECCL
S (DR,ECCL)=""
;
;- Drops out if invalid condition found
D
. I '$G(ECIEN)!('$D(ECANS)) Q
. ;
. ;- Lock main node
. I '$$LOCK(ECIEN) Q
. S DA=ECIEN
. S DIE="^ECH("
. ;
. ;- Edit classification fields (AO, IR, EC, SC, MST, HNC, CV, SHAD)
. F S ECCL=$O(ECANS(ECCL)) Q:ECCL="" S DR=DR_+$P($G(ECANS(ECCL)),"^")_"////"_$P($G(ECANS(ECCL)),"^",2)_";"
. ;
. ;- Remove last ";" from DR string before editing
. S DR=$E(DR,1,($L(DR)-1))
. D ^DIE
;
;- Unlock main node
D UNLOCK(ECIEN)
;
Q
;
;
SETCLASS(ECANS) ; Set answers to classification questions in EC variables
; (used in EC data entry options when filing EC Patient record)
;
; Input:
; ECANS - array of answers to class questions asked containing:
; field number of class ques from file #721^answer
;
; Output:
; EC classification var - ECAO,ECIR,ECZEC,ECSC,ECMST,ECHNC,ECCV,
; ECSHAD
;
N ECCL,ECCLFLD
S (ECCL,ECAO,ECIR,ECZEC,ECSC,ECMST,ECHNC,ECCV,ECSHAD)=""
;
;- Drops out if invalid condition found
D
. ;
. ;- If array containing class flds^answers is not created, exit
. I '$D(ECANS) Q
. F S ECCL=$O(ECANS(ECCL)) Q:ECCL="" D
.. ;
.. ;- Get field number of classification
.. S ECCLFLD=+$P($G(ECANS(ECCL)),"^")
.. ;
.. ;- Agent Orange variable
.. S:ECCLFLD=21 ECAO=$P(ECANS(ECCL),"^",2)
.. ;
.. ;- Ionizing Radiation variable
.. S:ECCLFLD=22 ECIR=$P(ECANS(ECCL),"^",2)
.. ;
.. ;- Environmental Contaminants/South West Asia Conditions variable
.. S:ECCLFLD=23 ECZEC=$P(ECANS(ECCL),"^",2)
.. ;
.. ;- Service Connected variable
.. S:ECCLFLD=24 ECSC=$P(ECANS(ECCL),"^",2)
.. ;
.. ;- Military Sexual Trauma variable
.. S:ECCLFLD=35 ECMST=$P(ECANS(ECCL),"^",2)
.. ;
.. ;- Head/Neck Cancer
.. S:ECCLFLD=39 ECHNC=$P(ECANS(ECCL),"^",2)
.. ;
.. ;- Combat Veteran
.. S:ECCLFLD=40 ECCV=$P(ECANS(ECCL),"^",2)
.. ;
.. ;- Project 112/SHAD (Shipboard Hazard and Defense)
.. S:ECCLFLD=41 ECSHAD=$P(ECANS(ECCL),"^",2)
Q
;
;
DELCLASS(ECIEN) ; Delete classification fields in EC Patient file (#721)
;
; Input:
; ECIEN - EC Patient record (#721) IEN
;
; Output:
; Classification fields 21,22,23,24,35,39,40,41 deleted in file#721
;
N DA,DIE,DR,ECCL
S DR=""
;
;- Drops out if invalid condition found
D
. I '$G(ECIEN) Q
. ;
. ;- Lock main node
. I '$$LOCK(ECIEN) Q
. S DA=ECIEN
. S DIE="^ECH("
. ;
. ;- Delete classification fields (AO, IR, EC, SC, MST, HNC, CV, SHAD)
. F ECCL=21:1:24,35,39,40,41 S DR=DR_ECCL_"////@;"
. ;
. ;- Remove last ";" from DR string before editing
. S DR=$E(DR,1,($L(DR)-1))
. D ^DIE
;
;- Unlock main node
D UNLOCK(ECIEN)
;
Q
;
;
LOCK(ECIEN) ; Lock EC Patient record
;
; Input:
; ECIEN - EC Patient record IEN
;
; Output:
; Function Value - 1 if record can be locked, 0 otherwise
;
I $G(ECIEN) L +^ECH(ECIEN):5
Q $T
;
;
UNLOCK(ECIEN) ; Unlock EC Patient record
;
; Input:
; ECIEN - EC Patient record IEN
;
; Output:
; EC Patient record unlocked
;
I $G(ECIEN) L -^ECH(ECIEN)
Q
RCNTVST(RESULT,ECARY) ;126 Changed parameter name from DFN to ECARY
;
; Input: RESULT - return array of appt/visits
; ECARY - DFN^LOCATION (optional if list should be filtered)
;
; Output: FM date/time^readable d/t and clinic name^readable d/t
; ^clinic name
;
;This call uses the Patient and Visit files to return a list of recent
;visits. It returns the most recent 40 visits using both files through
;midnight of the current day. It also filters out canceled,
;rescheduled or no-show appts.
;
;126 Updated code so that it filters visit by selected location.
;Only visits/appts with clinics in the location will be shown.
;
;API 1905
;Calls
; SELECTED^VSIT(DFN,SDT,EDT,HOSLOC,ENCTPE,NNCTPE,SRVCAT,NSRVCAT,LASTN)
; See API for detailed documentation
;
;API 3859
;Calls GETAPPT^SDAMA201(DFN,SDFIELDS,SDAPSTAT,SDT,EDT,SDCNT)
; See API for detailed documentation
;
;IA 10040 - This is a supported IA and is used to filter/screen
; non clinics visits from being included in API 1905
; not needed in 3859 as it contains a filter for clinics
;
N ARR,CNT,DATE,NUM,PARAMS,P1,P1DT,P2,PDT,VDT,VIEN,X,X1,X2,SDRESULT,DFN,LOC ;122,126,145
S DFN=$P(ECARY,U),LOC=$P(ECARY,U,2) ;126
S DATE=$$DT^XLFDT_.24 ;145 Set latest date/time for search
S VDT=3050101
S X1=DT,X2=(-30) D C^%DTC S PDT=X ;145 get appts within last 30 days
S RESULT(0)=0
I '$G(DFN) Q
K ^TMP("VSIT",$J)
K ^TMP($J,"SDAMA201","GETAPPT")
D SELECTED^VSIT(DFN,VDT,DATE,"","","","","HE",60) ;126,145 Changed call to filter out hospitalization and event (historical) categories, 145 added ending date range and increased records returned to 60
D GETAPPT^SDAMA201(DFN,"1;2","R;NT",PDT,DATE,.SDRESULT)
S VIEN=0
F S VIEN=$O(^TMP("VSIT",$J,VIEN)) Q:VIEN="" S NUM=0 D
.F S NUM=$O(^TMP("VSIT",$J,VIEN,NUM)) Q:NUM="" D
..S PARAMS=$G(^TMP("VSIT",$J,VIEN,NUM))
..;make sure location is a clinic
..I $$GET1^DIQ(44,$P($P(PARAMS,U,2),";"),2,"I")'="C" Q
..I $G(LOC) I LOC'=$$GET1^DIQ(44,$P($P(PARAMS,U,2),";"),"3.5:.07","I") Q ;126,130 If location sent, filter out any visits whose clinic isn't in the location
..S P1DT=$P(PARAMS,U,1),P1=$$FMTE^XLFDT(P1DT,"9M"),P2=$P($P(PARAMS,U,2),";",2)
..I '$G(P1DT)!($G(P2)="") Q
..I $D(ARR(P1DT,P2))=1 Q
..;;cntrl array, filter visits from PT file
..S ARR(P1DT,P2)=P1DT_U_$$LJ^XLFSTR(P1,25)_$$LJ^XLFSTR(P2,30)_U_P1_U_P2_U
S VIEN=0
F S VIEN=$O(^TMP($J,"SDAMA201","GETAPPT",VIEN)) Q:VIEN="" D
.I $D(^TMP($J,"SDAMA201","GETAPPT","ERROR")) Q
.S P1DT=$G(^TMP($J,"SDAMA201","GETAPPT",VIEN,1))
.S P1=$$FMTE^XLFDT(P1DT,"9M")
.S P2=$P($G(^TMP($J,"SDAMA201","GETAPPT",VIEN,2)),U,2)
.I $G(LOC) I LOC'=$$GET1^DIQ(44,$P($G(^TMP($J,"SDAMA201","GETAPPT",VIEN,2)),U),"3.5:.07","I") Q ;126,130 If location sent, filter out any appts whose clinic isn't in the location
.I '$G(P1DT)!($G(P2)="") Q
.I $D(ARR(P1DT,P2))=1 Q
.;;cntrl array, filter visits from PT file
.S ARR(P1DT,P2)=P1DT_U_$$LJ^XLFSTR(P1,25)_$$LJ^XLFSTR(P2,30)_U_P1_U_P2_U
S VIEN=9999999999,CNT=1
F S VIEN=$O(ARR(VIEN),-1) Q:((VIEN="")!(CNT>40)) D ;145 upped limit from 20 to 40
.S NUM=0 F S NUM=$O(ARR(VIEN,NUM)) Q:NUM="" D
..S RESULT(CNT)=ARR(VIEN,NUM),CNT=CNT+1
I $D(ARR) S RESULT(0)=CNT
K ^TMP("VSIT",$J)
K ^TMP($J,"SDAMA201","GETAPPT")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECUTL1 10157 printed Dec 13, 2024@01:59:13 Page 2
ECUTL1 ;ALB/ESD - Event Capture Classification Utilities ;11/5/18 12:35
+1 ;;2.0;EVENT CAPTURE;**10,13,17,42,54,76,107,122,126,130,145**;8 May 96;Build 6
+2 ;
ASKCLASS(DFN,ECANS,ERR,ECTOPCE,ECPATST,ECHDA) ; Ask classification questions
+1 ; (Agent Orange, Ionizing Radiation, Environmental Contaminants/South
+2 ; West Asia Conditions, Service Connected, Military Sexual Trauma,
+3 ; Head/Neck Cancer, Combat Veteran, Project 112/SHAD)
+4 ;
+5 ; Input:
+6 ; DFN - IEN of Patient file (#2)
+7 ; ECTOPCE - Variable which indicates if DSS Unit is sending to PCE
+8 ; ECPATST - Inpatient/outpatient status
+9 ; ECHDA - IEN in file #721 if editing existing record [optional]
+10 ;
+11 ; Output:
+12 ; ECANS - array subscripted by classification abbreviation
+13 ; (i.e. ECANS("AO")) and passed by reference containing:
+14 ; field # of class from EC Patient file (#721)^answer
+15 ; ERR - Error indicator if user uparrows or times out (set to 1)
+16 ;
+17 ; Function value - 1 if successful, 0 otherwise
+18 ;
+19 NEW ANS,DIR,ECCL,ECCLFLD,SUCCESS,ECVST,ECVSTDT,ECPXB,PXBDATA,ECNT,ECOLD,ECPIECE,ECXX
+20 SET (ECANS,ECCL)=""
+21 SET ERR=0
+22 SET SUCCESS=1
+23 SET DFN=+$GET(DFN)
+24 SET ECTOPCE=$GET(ECTOPCE)
+25 IF ECTOPCE["~"
SET ECTOPCE=$PIECE(ECTOPCE,"~",2)
+26 SET ECPATST=$GET(ECPATST)
+27 ;- Drop out if invalid condition found OR if DSS Unit not sending to
+28 ; PCE or patient is an inpatient
+29 IF ('DFN)!(ECTOPCE="")!(ECPATST="")!(ECTOPCE="N")!(ECPATST="I")
SET SUCCESS=0
QUIT SUCCESS
+30 ;modified to use event date;JAM/11/24/03
DO NOW^%DTC
SET ECVSTDT=$SELECT(+$GET(ECDT):ECDT,1:%)
SET ECVST=""
+31 ;- If editing an existing record, get visit data & display classification
+32 IF $GET(ECHDA)
Begin DoDot:1
+33 SET ECVSTDT=$PIECE($GET(^ECH(ECHDA,0)),U,3)
+34 SET ECVST=$PIECE($GET(^ECH(ECHDA,0)),U,21)
+35 FOR ECCL="AO","IR","EC","SC","MST","HNC","CV","SHAD"
Begin DoDot:2
+36 SET ECPIECE=$SELECT(ECCL="AO":3,ECCL="IR":4,ECCL="EC":5,ECCL="SC":6,ECCL="MST":9,ECCL="HNC":10,ECCL="CV":11,1:12)
+37 SET ECCLFLD=$PIECE("^^Agent Orange^Ionizing Radiation^South West Asia Conditions^Service Connected^^^Military Sexual Trauma^Head/Neck Cancer^Combat Veteran^Project 112/SHAD","^",ECPIECE)
+38 SET ECXX=$PIECE($GET(^ECH(ECHDA,"P")),U,ECPIECE)
SET ECXX=$SELECT(ECXX="Y":"YES",ECXX="N":"NO",1:"")
+39 IF ECXX]""
SET ECOLD(ECCL)=ECCLFLD_": "_ECXX
End DoDot:2
+40 IF $DATA(ECOLD)
Begin DoDot:2
+41 WRITE !,"*** Current encounter classification ***",!
+42 FOR ECCL="SC","CV","AO","IR","EC","MST","HNC","SHAD"
Begin DoDot:3
+43 IF $DATA(ECOLD(ECCL))
WRITE !?4,ECOLD(ECCL)
End DoDot:3
End DoDot:2
End DoDot:1
+44 ;- Ask user classification question
+45 DO CLASS^PXBAPI21("",DFN,ECVSTDT,1,ECVST)
WRITE !
+46 ;- Check error; exit if error condition
+47 IF $DATA(PXBDATA("ERR"))
Begin DoDot:1
+48 FOR ECPXB=1:1:4
IF $DATA(PXBDATA("ERR",ECPXB))
Begin DoDot:2
+49 IF (PXBDATA("ERR",ECPXB)=1)!(PXBDATA("ERR",ECPXB)=4)
SET ERR=1
End DoDot:2
End DoDot:1
IF ERR
SET SUCCESS=0
QUIT SUCCESS
+50 ;- Otherwise, continue to setup ecans array, i.e., new classification data
+51 FOR ECCL="AO","IR","SC","EC","MST","HNC","CV","SHAD"
Begin DoDot:1
+52 SET ECCLFLD=$SELECT(ECCL="AO":21,ECCL="IR":22,ECCL="EC":23,ECCL="SC":24,ECCL="MST":35,ECCL="HNC":39,ECCL="CV":40,1:41)
+53 SET ECPXB=$SELECT(ECCL="AO":1,ECCL="IR":2,ECCL="EC":4,ECCL="SC":3,ECCL="MST":5,ECCL="CV":7,ECCL="SHAD":8,1:6)
+54 SET ANS=$PIECE($GET(PXBDATA(ECPXB)),U,2)
SET ANS=$SELECT(ANS=1:"Y",ANS=0:"N",1:"")
+55 SET ECANS(ECCL)=ECCLFLD_"^"_ANS
End DoDot:1
+56 ;- Delete old data if it exists
+57 IF $GET(ECHDA)
DO DELCLASS(ECHDA)
+58 QUIT SUCCESS
+59 ;
+60 ;
EDCLASS(ECIEN,ECANS) ; Edit classifications fields in EC Patient
+1 ; file (#721)
+2 ;
+3 ; Input:
+4 ; ECIEN - EC Patient record (#721) IEN
+5 ; ECANS - Array of answers to classification questions asked
+6 ;
+7 ; Output:
+8 ; Classification fields 21,22,23,24,35,39,40,41 edited in file #721
+9 ;
+10 NEW DA,DIE,DR,ECCL
+11 SET (DR,ECCL)=""
+12 ;
+13 ;- Drops out if invalid condition found
+14 Begin DoDot:1
+15 IF '$GET(ECIEN)!('$DATA(ECANS))
QUIT
+16 ;
+17 ;- Lock main node
+18 IF '$$LOCK(ECIEN)
QUIT
+19 SET DA=ECIEN
+20 SET DIE="^ECH("
+21 ;
+22 ;- Edit classification fields (AO, IR, EC, SC, MST, HNC, CV, SHAD)
+23 FOR
SET ECCL=$ORDER(ECANS(ECCL))
if ECCL=""
QUIT
SET DR=DR_+$PIECE($GET(ECANS(ECCL)),"^")_"////"_$PIECE($GET(ECANS(ECCL)),"^",2)_";"
+24 ;
+25 ;- Remove last ";" from DR string before editing
+26 SET DR=$EXTRACT(DR,1,($LENGTH(DR)-1))
+27 DO ^DIE
End DoDot:1
+28 ;
+29 ;- Unlock main node
+30 DO UNLOCK(ECIEN)
+31 ;
+32 QUIT
+33 ;
+34 ;
SETCLASS(ECANS) ; Set answers to classification questions in EC variables
+1 ; (used in EC data entry options when filing EC Patient record)
+2 ;
+3 ; Input:
+4 ; ECANS - array of answers to class questions asked containing:
+5 ; field number of class ques from file #721^answer
+6 ;
+7 ; Output:
+8 ; EC classification var - ECAO,ECIR,ECZEC,ECSC,ECMST,ECHNC,ECCV,
+9 ; ECSHAD
+10 ;
+11 NEW ECCL,ECCLFLD
+12 SET (ECCL,ECAO,ECIR,ECZEC,ECSC,ECMST,ECHNC,ECCV,ECSHAD)=""
+13 ;
+14 ;- Drops out if invalid condition found
+15 Begin DoDot:1
+16 ;
+17 ;- If array containing class flds^answers is not created, exit
+18 IF '$DATA(ECANS)
QUIT
+19 FOR
SET ECCL=$ORDER(ECANS(ECCL))
if ECCL=""
QUIT
Begin DoDot:2
+20 ;
+21 ;- Get field number of classification
+22 SET ECCLFLD=+$PIECE($GET(ECANS(ECCL)),"^")
+23 ;
+24 ;- Agent Orange variable
+25 if ECCLFLD=21
SET ECAO=$PIECE(ECANS(ECCL),"^",2)
+26 ;
+27 ;- Ionizing Radiation variable
+28 if ECCLFLD=22
SET ECIR=$PIECE(ECANS(ECCL),"^",2)
+29 ;
+30 ;- Environmental Contaminants/South West Asia Conditions variable
+31 if ECCLFLD=23
SET ECZEC=$PIECE(ECANS(ECCL),"^",2)
+32 ;
+33 ;- Service Connected variable
+34 if ECCLFLD=24
SET ECSC=$PIECE(ECANS(ECCL),"^",2)
+35 ;
+36 ;- Military Sexual Trauma variable
+37 if ECCLFLD=35
SET ECMST=$PIECE(ECANS(ECCL),"^",2)
+38 ;
+39 ;- Head/Neck Cancer
+40 if ECCLFLD=39
SET ECHNC=$PIECE(ECANS(ECCL),"^",2)
+41 ;
+42 ;- Combat Veteran
+43 if ECCLFLD=40
SET ECCV=$PIECE(ECANS(ECCL),"^",2)
+44 ;
+45 ;- Project 112/SHAD (Shipboard Hazard and Defense)
+46 if ECCLFLD=41
SET ECSHAD=$PIECE(ECANS(ECCL),"^",2)
End DoDot:2
End DoDot:1
+47 QUIT
+48 ;
+49 ;
DELCLASS(ECIEN) ; Delete classification fields in EC Patient file (#721)
+1 ;
+2 ; Input:
+3 ; ECIEN - EC Patient record (#721) IEN
+4 ;
+5 ; Output:
+6 ; Classification fields 21,22,23,24,35,39,40,41 deleted in file#721
+7 ;
+8 NEW DA,DIE,DR,ECCL
+9 SET DR=""
+10 ;
+11 ;- Drops out if invalid condition found
+12 Begin DoDot:1
+13 IF '$GET(ECIEN)
QUIT
+14 ;
+15 ;- Lock main node
+16 IF '$$LOCK(ECIEN)
QUIT
+17 SET DA=ECIEN
+18 SET DIE="^ECH("
+19 ;
+20 ;- Delete classification fields (AO, IR, EC, SC, MST, HNC, CV, SHAD)
+21 FOR ECCL=21:1:24,35,39,40,41
SET DR=DR_ECCL_"////@;"
+22 ;
+23 ;- Remove last ";" from DR string before editing
+24 SET DR=$EXTRACT(DR,1,($LENGTH(DR)-1))
+25 DO ^DIE
End DoDot:1
+26 ;
+27 ;- Unlock main node
+28 DO UNLOCK(ECIEN)
+29 ;
+30 QUIT
+31 ;
+32 ;
LOCK(ECIEN) ; Lock EC Patient record
+1 ;
+2 ; Input:
+3 ; ECIEN - EC Patient record IEN
+4 ;
+5 ; Output:
+6 ; Function Value - 1 if record can be locked, 0 otherwise
+7 ;
+8 IF $GET(ECIEN)
LOCK +^ECH(ECIEN):5
+9 QUIT $TEST
+10 ;
+11 ;
UNLOCK(ECIEN) ; Unlock EC Patient record
+1 ;
+2 ; Input:
+3 ; ECIEN - EC Patient record IEN
+4 ;
+5 ; Output:
+6 ; EC Patient record unlocked
+7 ;
+8 IF $GET(ECIEN)
LOCK -^ECH(ECIEN)
+9 QUIT
RCNTVST(RESULT,ECARY) ;126 Changed parameter name from DFN to ECARY
+1 ;
+2 ; Input: RESULT - return array of appt/visits
+3 ; ECARY - DFN^LOCATION (optional if list should be filtered)
+4 ;
+5 ; Output: FM date/time^readable d/t and clinic name^readable d/t
+6 ; ^clinic name
+7 ;
+8 ;This call uses the Patient and Visit files to return a list of recent
+9 ;visits. It returns the most recent 40 visits using both files through
+10 ;midnight of the current day. It also filters out canceled,
+11 ;rescheduled or no-show appts.
+12 ;
+13 ;126 Updated code so that it filters visit by selected location.
+14 ;Only visits/appts with clinics in the location will be shown.
+15 ;
+16 ;API 1905
+17 ;Calls
+18 ; SELECTED^VSIT(DFN,SDT,EDT,HOSLOC,ENCTPE,NNCTPE,SRVCAT,NSRVCAT,LASTN)
+19 ; See API for detailed documentation
+20 ;
+21 ;API 3859
+22 ;Calls GETAPPT^SDAMA201(DFN,SDFIELDS,SDAPSTAT,SDT,EDT,SDCNT)
+23 ; See API for detailed documentation
+24 ;
+25 ;IA 10040 - This is a supported IA and is used to filter/screen
+26 ; non clinics visits from being included in API 1905
+27 ; not needed in 3859 as it contains a filter for clinics
+28 ;
+29 ;122,126,145
NEW ARR,CNT,DATE,NUM,PARAMS,P1,P1DT,P2,PDT,VDT,VIEN,X,X1,X2,SDRESULT,DFN,LOC
+30 ;126
SET DFN=$PIECE(ECARY,U)
SET LOC=$PIECE(ECARY,U,2)
+31 ;145 Set latest date/time for search
SET DATE=$$DT^XLFDT_.24
+32 SET VDT=3050101
+33 ;145 get appts within last 30 days
SET X1=DT
SET X2=(-30)
DO C^%DTC
SET PDT=X
+34 SET RESULT(0)=0
+35 IF '$GET(DFN)
QUIT
+36 KILL ^TMP("VSIT",$JOB)
+37 KILL ^TMP($JOB,"SDAMA201","GETAPPT")
+38 ;126,145 Changed call to filter out hospitalization and event (historical) categories, 145 added ending date range and increased records returned to 60
DO SELECTED^VSIT(DFN,VDT,DATE,"","","","","HE",60)
+39 DO GETAPPT^SDAMA201(DFN,"1;2","R;NT",PDT,DATE,.SDRESULT)
+40 SET VIEN=0
+41 FOR
SET VIEN=$ORDER(^TMP("VSIT",$JOB,VIEN))
if VIEN=""
QUIT
SET NUM=0
Begin DoDot:1
+42 FOR
SET NUM=$ORDER(^TMP("VSIT",$JOB,VIEN,NUM))
if NUM=""
QUIT
Begin DoDot:2
+43 SET PARAMS=$GET(^TMP("VSIT",$JOB,VIEN,NUM))
+44 ;make sure location is a clinic
+45 IF $$GET1^DIQ(44,$PIECE($PIECE(PARAMS,U,2),";"),2,"I")'="C"
QUIT
+46 ;126,130 If location sent, filter out any visits whose clinic isn't in the location
IF $GET(LOC)
IF LOC'=$$GET1^DIQ(44,$PIECE($PIECE(PARAMS,U,2),";"),"3.5:.07","I")
QUIT
+47 SET P1DT=$PIECE(PARAMS,U,1)
SET P1=$$FMTE^XLFDT(P1DT,"9M")
SET P2=$PIECE($PIECE(PARAMS,U,2),";",2)
+48 IF '$GET(P1DT)!($GET(P2)="")
QUIT
+49 IF $DATA(ARR(P1DT,P2))=1
QUIT
+50 ;;cntrl array, filter visits from PT file
+51 SET ARR(P1DT,P2)=P1DT_U_$$LJ^XLFSTR(P1,25)_$$LJ^XLFSTR(P2,30)_U_P1_U_P2_U
End DoDot:2
End DoDot:1
+52 SET VIEN=0
+53 FOR
SET VIEN=$ORDER(^TMP($JOB,"SDAMA201","GETAPPT",VIEN))
if VIEN=""
QUIT
Begin DoDot:1
+54 IF $DATA(^TMP($JOB,"SDAMA201","GETAPPT","ERROR"))
QUIT
+55 SET P1DT=$GET(^TMP($JOB,"SDAMA201","GETAPPT",VIEN,1))
+56 SET P1=$$FMTE^XLFDT(P1DT,"9M")
+57 SET P2=$PIECE($GET(^TMP($JOB,"SDAMA201","GETAPPT",VIEN,2)),U,2)
+58 ;126,130 If location sent, filter out any appts whose clinic isn't in the location
IF $GET(LOC)
IF LOC'=$$GET1^DIQ(44,$PIECE($GET(^TMP($JOB,"SDAMA201","GETAPPT",VIEN,2)),U),"3.5:.07","I")
QUIT
+59 IF '$GET(P1DT)!($GET(P2)="")
QUIT
+60 IF $DATA(ARR(P1DT,P2))=1
QUIT
+61 ;;cntrl array, filter visits from PT file
+62 SET ARR(P1DT,P2)=P1DT_U_$$LJ^XLFSTR(P1,25)_$$LJ^XLFSTR(P2,30)_U_P1_U_P2_U
End DoDot:1
+63 SET VIEN=9999999999
SET CNT=1
+64 ;145 upped limit from 20 to 40
FOR
SET VIEN=$ORDER(ARR(VIEN),-1)
if ((VIEN="")!(CNT>40))
QUIT
Begin DoDot:1
+65 SET NUM=0
FOR
SET NUM=$ORDER(ARR(VIEN,NUM))
if NUM=""
QUIT
Begin DoDot:2
+66 SET RESULT(CNT)=ARR(VIEN,NUM)
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+67 IF $DATA(ARR)
SET RESULT(0)=CNT
+68 KILL ^TMP("VSIT",$JOB)
+69 KILL ^TMP($JOB,"SDAMA201","GETAPPT")
+70 QUIT
