- 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 Feb 18, 2025@23:25:37 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