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

ECUTL1.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ASKCLASS(DFN,ECANS,ERR,ECTOPCE,ECPATST,ECHDA) ; Ask classification questions
  1. ; (Agent Orange, Ionizing Radiation, Environmental Contaminants/South
  1. ; West Asia Conditions, Service Connected, Military Sexual Trauma,
  1. ; Head/Neck Cancer, Combat Veteran, Project 112/SHAD)
  1. ;
  1. ; Input:
  1. ; DFN - IEN of Patient file (#2)
  1. ; ECTOPCE - Variable which indicates if DSS Unit is sending to PCE
  1. ; ECPATST - Inpatient/outpatient status
  1. ; ECHDA - IEN in file #721 if editing existing record [optional]
  1. ;
  1. ; Output:
  1. ; ECANS - array subscripted by classification abbreviation
  1. ; (i.e. ECANS("AO")) and passed by reference containing:
  1. ; field # of class from EC Patient file (#721)^answer
  1. ; ERR - Error indicator if user uparrows or times out (set to 1)
  1. ;
  1. ; Function value - 1 if successful, 0 otherwise
  1. ;
  1. N ANS,DIR,ECCL,ECCLFLD,SUCCESS,ECVST,ECVSTDT,ECPXB,PXBDATA,ECNT,ECOLD,ECPIECE,ECXX
  1. S (ECANS,ECCL)=""
  1. S ERR=0
  1. S SUCCESS=1
  1. S DFN=+$G(DFN)
  1. S ECTOPCE=$G(ECTOPCE)
  1. I ECTOPCE["~" S ECTOPCE=$P(ECTOPCE,"~",2)
  1. S ECPATST=$G(ECPATST)
  1. ;- Drop out if invalid condition found OR if DSS Unit not sending to
  1. ; PCE or patient is an inpatient
  1. I ('DFN)!(ECTOPCE="")!(ECPATST="")!(ECTOPCE="N")!(ECPATST="I") S SUCCESS=0 Q SUCCESS
  1. D NOW^%DTC S ECVSTDT=$S(+$G(ECDT):ECDT,1:%),ECVST="" ;modified to use event date;JAM/11/24/03
  1. ;- If editing an existing record, get visit data & display classification
  1. I $G(ECHDA) D
  1. .S ECVSTDT=$P($G(^ECH(ECHDA,0)),U,3)
  1. .S ECVST=$P($G(^ECH(ECHDA,0)),U,21)
  1. .F ECCL="AO","IR","EC","SC","MST","HNC","CV","SHAD" D
  1. ..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)
  1. ..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)
  1. ..S ECXX=$P($G(^ECH(ECHDA,"P")),U,ECPIECE),ECXX=$S(ECXX="Y":"YES",ECXX="N":"NO",1:"")
  1. ..I ECXX]"" S ECOLD(ECCL)=ECCLFLD_": "_ECXX
  1. .I $D(ECOLD) D
  1. ..W !,"*** Current encounter classification ***",!
  1. ..F ECCL="SC","CV","AO","IR","EC","MST","HNC","SHAD" D
  1. ...I $D(ECOLD(ECCL)) W !?4,ECOLD(ECCL)
  1. ;- Ask user classification question
  1. D CLASS^PXBAPI21("",DFN,ECVSTDT,1,ECVST) W !
  1. ;- Check error; exit if error condition
  1. I $D(PXBDATA("ERR")) D I ERR S SUCCESS=0 Q SUCCESS
  1. .F ECPXB=1:1:4 I $D(PXBDATA("ERR",ECPXB)) D
  1. ..I (PXBDATA("ERR",ECPXB)=1)!(PXBDATA("ERR",ECPXB)=4) S ERR=1
  1. ;- Otherwise, continue to setup ecans array, i.e., new classification data
  1. F ECCL="AO","IR","SC","EC","MST","HNC","CV","SHAD" D
  1. .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)
  1. .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)
  1. .S ANS=$P($G(PXBDATA(ECPXB)),U,2),ANS=$S(ANS=1:"Y",ANS=0:"N",1:"")
  1. .S ECANS(ECCL)=ECCLFLD_"^"_ANS
  1. ;- Delete old data if it exists
  1. I $G(ECHDA) D DELCLASS(ECHDA)
  1. Q SUCCESS
  1. ;
  1. ;
  1. EDCLASS(ECIEN,ECANS) ; Edit classifications fields in EC Patient
  1. ; file (#721)
  1. ;
  1. ; Input:
  1. ; ECIEN - EC Patient record (#721) IEN
  1. ; ECANS - Array of answers to classification questions asked
  1. ;
  1. ; Output:
  1. ; Classification fields 21,22,23,24,35,39,40,41 edited in file #721
  1. ;
  1. N DA,DIE,DR,ECCL
  1. S (DR,ECCL)=""
  1. ;
  1. ;- Drops out if invalid condition found
  1. D
  1. . I '$G(ECIEN)!('$D(ECANS)) Q
  1. . ;
  1. . ;- Lock main node
  1. . I '$$LOCK(ECIEN) Q
  1. . S DA=ECIEN
  1. . S DIE="^ECH("
  1. . ;
  1. . ;- Edit classification fields (AO, IR, EC, SC, MST, HNC, CV, SHAD)
  1. . F S ECCL=$O(ECANS(ECCL)) Q:ECCL="" S DR=DR_+$P($G(ECANS(ECCL)),"^")_"////"_$P($G(ECANS(ECCL)),"^",2)_";"
  1. . ;
  1. . ;- Remove last ";" from DR string before editing
  1. . S DR=$E(DR,1,($L(DR)-1))
  1. . D ^DIE
  1. ;
  1. ;- Unlock main node
  1. D UNLOCK(ECIEN)
  1. ;
  1. Q
  1. ;
  1. ;
  1. SETCLASS(ECANS) ; Set answers to classification questions in EC variables
  1. ; (used in EC data entry options when filing EC Patient record)
  1. ;
  1. ; Input:
  1. ; ECANS - array of answers to class questions asked containing:
  1. ; field number of class ques from file #721^answer
  1. ;
  1. ; Output:
  1. ; EC classification var - ECAO,ECIR,ECZEC,ECSC,ECMST,ECHNC,ECCV,
  1. ; ECSHAD
  1. ;
  1. N ECCL,ECCLFLD
  1. S (ECCL,ECAO,ECIR,ECZEC,ECSC,ECMST,ECHNC,ECCV,ECSHAD)=""
  1. ;
  1. ;- Drops out if invalid condition found
  1. D
  1. . ;
  1. . ;- If array containing class flds^answers is not created, exit
  1. . I '$D(ECANS) Q
  1. . F S ECCL=$O(ECANS(ECCL)) Q:ECCL="" D
  1. .. ;
  1. .. ;- Get field number of classification
  1. .. S ECCLFLD=+$P($G(ECANS(ECCL)),"^")
  1. .. ;
  1. .. ;- Agent Orange variable
  1. .. S:ECCLFLD=21 ECAO=$P(ECANS(ECCL),"^",2)
  1. .. ;
  1. .. ;- Ionizing Radiation variable
  1. .. S:ECCLFLD=22 ECIR=$P(ECANS(ECCL),"^",2)
  1. .. ;
  1. .. ;- Environmental Contaminants/South West Asia Conditions variable
  1. .. S:ECCLFLD=23 ECZEC=$P(ECANS(ECCL),"^",2)
  1. .. ;
  1. .. ;- Service Connected variable
  1. .. S:ECCLFLD=24 ECSC=$P(ECANS(ECCL),"^",2)
  1. .. ;
  1. .. ;- Military Sexual Trauma variable
  1. .. S:ECCLFLD=35 ECMST=$P(ECANS(ECCL),"^",2)
  1. .. ;
  1. .. ;- Head/Neck Cancer
  1. .. S:ECCLFLD=39 ECHNC=$P(ECANS(ECCL),"^",2)
  1. .. ;
  1. .. ;- Combat Veteran
  1. .. S:ECCLFLD=40 ECCV=$P(ECANS(ECCL),"^",2)
  1. .. ;
  1. .. ;- Project 112/SHAD (Shipboard Hazard and Defense)
  1. .. S:ECCLFLD=41 ECSHAD=$P(ECANS(ECCL),"^",2)
  1. Q
  1. ;
  1. ;
  1. DELCLASS(ECIEN) ; Delete classification fields in EC Patient file (#721)
  1. ;
  1. ; Input:
  1. ; ECIEN - EC Patient record (#721) IEN
  1. ;
  1. ; Output:
  1. ; Classification fields 21,22,23,24,35,39,40,41 deleted in file#721
  1. ;
  1. N DA,DIE,DR,ECCL
  1. S DR=""
  1. ;
  1. ;- Drops out if invalid condition found
  1. D
  1. . I '$G(ECIEN) Q
  1. . ;
  1. . ;- Lock main node
  1. . I '$$LOCK(ECIEN) Q
  1. . S DA=ECIEN
  1. . S DIE="^ECH("
  1. . ;
  1. . ;- Delete classification fields (AO, IR, EC, SC, MST, HNC, CV, SHAD)
  1. . F ECCL=21:1:24,35,39,40,41 S DR=DR_ECCL_"////@;"
  1. . ;
  1. . ;- Remove last ";" from DR string before editing
  1. . S DR=$E(DR,1,($L(DR)-1))
  1. . D ^DIE
  1. ;
  1. ;- Unlock main node
  1. D UNLOCK(ECIEN)
  1. ;
  1. Q
  1. ;
  1. ;
  1. LOCK(ECIEN) ; Lock EC Patient record
  1. ;
  1. ; Input:
  1. ; ECIEN - EC Patient record IEN
  1. ;
  1. ; Output:
  1. ; Function Value - 1 if record can be locked, 0 otherwise
  1. ;
  1. I $G(ECIEN) L +^ECH(ECIEN):5
  1. Q $T
  1. ;
  1. ;
  1. UNLOCK(ECIEN) ; Unlock EC Patient record
  1. ;
  1. ; Input:
  1. ; ECIEN - EC Patient record IEN
  1. ;
  1. ; Output:
  1. ; EC Patient record unlocked
  1. ;
  1. I $G(ECIEN) L -^ECH(ECIEN)
  1. Q
  1. RCNTVST(RESULT,ECARY) ;126 Changed parameter name from DFN to ECARY
  1. ;
  1. ; Input: RESULT - return array of appt/visits
  1. ; ECARY - DFN^LOCATION (optional if list should be filtered)
  1. ;
  1. ; Output: FM date/time^readable d/t and clinic name^readable d/t
  1. ; ^clinic name
  1. ;
  1. ;This call uses the Patient and Visit files to return a list of recent
  1. ;visits. It returns the most recent 40 visits using both files through
  1. ;midnight of the current day. It also filters out canceled,
  1. ;rescheduled or no-show appts.
  1. ;
  1. ;126 Updated code so that it filters visit by selected location.
  1. ;Only visits/appts with clinics in the location will be shown.
  1. ;
  1. ;API 1905
  1. ;Calls
  1. ; SELECTED^VSIT(DFN,SDT,EDT,HOSLOC,ENCTPE,NNCTPE,SRVCAT,NSRVCAT,LASTN)
  1. ; See API for detailed documentation
  1. ;
  1. ;API 3859
  1. ;Calls GETAPPT^SDAMA201(DFN,SDFIELDS,SDAPSTAT,SDT,EDT,SDCNT)
  1. ; See API for detailed documentation
  1. ;
  1. ;IA 10040 - This is a supported IA and is used to filter/screen
  1. ; non clinics visits from being included in API 1905
  1. ; not needed in 3859 as it contains a filter for clinics
  1. ;
  1. N ARR,CNT,DATE,NUM,PARAMS,P1,P1DT,P2,PDT,VDT,VIEN,X,X1,X2,SDRESULT,DFN,LOC ;122,126,145
  1. S DFN=$P(ECARY,U),LOC=$P(ECARY,U,2) ;126
  1. S DATE=$$DT^XLFDT_.24 ;145 Set latest date/time for search
  1. S VDT=3050101
  1. S X1=DT,X2=(-30) D C^%DTC S PDT=X ;145 get appts within last 30 days
  1. S RESULT(0)=0
  1. I '$G(DFN) Q
  1. K ^TMP("VSIT",$J)
  1. K ^TMP($J,"SDAMA201","GETAPPT")
  1. 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
  1. D GETAPPT^SDAMA201(DFN,"1;2","R;NT",PDT,DATE,.SDRESULT)
  1. S VIEN=0
  1. F S VIEN=$O(^TMP("VSIT",$J,VIEN)) Q:VIEN="" S NUM=0 D
  1. .F S NUM=$O(^TMP("VSIT",$J,VIEN,NUM)) Q:NUM="" D
  1. ..S PARAMS=$G(^TMP("VSIT",$J,VIEN,NUM))
  1. ..;make sure location is a clinic
  1. ..I $$GET1^DIQ(44,$P($P(PARAMS,U,2),";"),2,"I")'="C" Q
  1. ..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
  1. ..S P1DT=$P(PARAMS,U,1),P1=$$FMTE^XLFDT(P1DT,"9M"),P2=$P($P(PARAMS,U,2),";",2)
  1. ..I '$G(P1DT)!($G(P2)="") Q
  1. ..I $D(ARR(P1DT,P2))=1 Q
  1. ..;;cntrl array, filter visits from PT file
  1. ..S ARR(P1DT,P2)=P1DT_U_$$LJ^XLFSTR(P1,25)_$$LJ^XLFSTR(P2,30)_U_P1_U_P2_U
  1. S VIEN=0
  1. F S VIEN=$O(^TMP($J,"SDAMA201","GETAPPT",VIEN)) Q:VIEN="" D
  1. .I $D(^TMP($J,"SDAMA201","GETAPPT","ERROR")) Q
  1. .S P1DT=$G(^TMP($J,"SDAMA201","GETAPPT",VIEN,1))
  1. .S P1=$$FMTE^XLFDT(P1DT,"9M")
  1. .S P2=$P($G(^TMP($J,"SDAMA201","GETAPPT",VIEN,2)),U,2)
  1. .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
  1. .I '$G(P1DT)!($G(P2)="") Q
  1. .I $D(ARR(P1DT,P2))=1 Q
  1. .;;cntrl array, filter visits from PT file
  1. .S ARR(P1DT,P2)=P1DT_U_$$LJ^XLFSTR(P1,25)_$$LJ^XLFSTR(P2,30)_U_P1_U_P2_U
  1. S VIEN=9999999999,CNT=1
  1. F S VIEN=$O(ARR(VIEN),-1) Q:((VIEN="")!(CNT>40)) D ;145 upped limit from 20 to 40
  1. .S NUM=0 F S NUM=$O(ARR(VIEN,NUM)) Q:NUM="" D
  1. ..S RESULT(CNT)=ARR(VIEN,NUM),CNT=CNT+1
  1. I $D(ARR) S RESULT(0)=CNT
  1. K ^TMP("VSIT",$J)
  1. K ^TMP($J,"SDAMA201","GETAPPT")
  1. Q