BEDDUTIS ;VNGT/HS/BEE-BEDD Utility Routine 2 - Cache Calls ; 08 Nov 2011 12:00 PM
;;2.0;IHS EMERGENCY DEPT DASHBOARD;**1**;Apr 02, 2014
;
;This routine is included in BEDD XML 2.0 Patch 1 install and is not in the KIDS
;
Q
;
DC(DFN,OBJID,VIEN,DUZ,SITE,BEDD) ;Disch from BEDD/AMER
;
;Input:
; DFN
; OBJID - Pointer to BEDD.EDVISIT
; VIEN - Visit IEN
; DUZ - User's DUZ
; SITE - Site Value
;
NEW EDREF,AMERVSIT
;
S EDREF=##CLASS(BEDD.EDVISIT).%OpenId(OBJID)
S AMERVSIT=EDREF.AMERVSIT
;
;Pull Room Value
S ROOM=EDREF.Room
;
;Check for Reversed Discharge (will have AMERVSIT)
I AMERVSIT'="" D
. NEW %,%H,DCDT,DISP,ESTAT
. ;
. ;Discharge Date
. S %H=EDREF.DCDtH_","_EDREF.DCTmH
. D YX^%DTC S DCDT=X_%
. ;
. ;Disposition
. S DISP=$G(BEDD("Disp")) ;EDREF.DCDispH
. ;
. ;Save new Discharge Date/Time and Disp
. D DCUPDATE(AMERVSIT,DCDT,DISP)
. ;
. I EDREF.DCDocHSDt>0 D
.. S EDREF.DCDocHEDt=$P($H,",",1)
.. S EDREF.DCDocHETm=$P($H,",",2)
. ;
. ;Update Class Entry
. S EDREF.DCFlag=1
. S ESTAT=EDREF.%Save()
;
I EDREF.DCDocHSDt>0 D
. NEW ESTAT
. S EDREF.DCDocHEDt=$P($H,",",1)
. S EDREF.DCDocHETm=$P($H,",",2)
. S ESTAT=EDREF.%Save()
S EDREF=""
;
Q:AMERVSIT'=""
;
;Process Regular Disch
S U="^"
D DUZ^XUP(DUZ)
S:$G(DT)="" DT=$$DT^XLFDT
;
;Set up AMER ^TMP("AMER" Entries needed for save
;
NEW AMERDFN,AMERPCC,AMERLINE,FMDT,%,%H,AMERDR,AMERDA,STAT
NEW ERROR,PRCPV,PRCNT,PRMNRS,AMERDUR,AR,X
;
S AMERDFN=DFN,AMERPCC=VIEN,AMERLINE=""
;
;Reset AMER globals
K ^TMP("AMER",$J,1),^TMP("AMER",$J,2),^TMP("AMER",$J,3)
;
;Convert Admission file back to ^TMP entries
D UTL^AMER0(AMERDFN)
S ^TMP("AMER",$J,2,1)=AMERDFN
;
S EDREF=##CLASS(BEDD.EDVISIT).%OpenId(OBJID)
I (EDREF.DCDocHSDt>0) D
. S EDREF.DCDocHEDt=$P($H,",",1)
. S EDREF.DCDocHETm=$P($H,",",2)
;
;Pull Room Value
S ROOM=EDREF.Room
;
;Set Injury Information
S ^TMP("AMER",$J,2,2)=0
I EDREF.Injury="YES" D
. S ^TMP("AMER",$J,2,2)=1 ;QD2^AMER2
. S ^TMP("AMER",$J,2,31)=EDREF.PtInjury.InjLocat ;QD31^AMER2B
. S ^TMP("AMER",$J,2,32)=EDREF.PtInjury.InjDtTm
. S ^TMP("AMER",$J,2,33)=EDREF.PtInjury.InjCauseIEN ;QD33^AMER2B
. S ^TMP("AMER",$J,2,34)=EDREF.PtInjury.InjSet ;QD34^AMER2B
. S ^TMP("AMER",$J,2,35)=EDREF.PtInjury.SafetyEquip ;QD35^AMER2B
. I EDREF.PtInjury.WrkRel="YES" S ^TMP("AMER",$J,2,5)=1 ;QD5^AMER2
. E S ^TMP("AMER",$J,2,5)=0 ;QD5^AMER2
. S ^TMP("AMER",$J,2,41)=EDREF.PtInjury.MVCLoc ;QD41^AMER2
. S ^TMP("AMER",$J,2,42)=EDREF.PtInjury.AtFaultInsurance ;QD42^AMER
. S ^TMP("AMER",$J,2,43)=EDREF.PtInjury.AtFaultInsPolicy ;QD43^AMER
;
;ED Consults
S ^TMP("AMER",$J,2,6)=0 I $$EDCNT(OBJID)>0 S ^TMP("AMER",$J,2,6)=1
D CONSQRY ;QD6^AMER2
;
;Procedures
S PRCNT=$$PRCNT(OBJID)
I (PRCNT>0) D PROCQ(.PRCPV) ;QD10^AMER3
I (PRCNT<1) S %=$$OPT^AMER0("NONE","ER PROCEDURES"),^TMP("AMER",$J,2,10,%)=%_U_"NONE"
;
;Diagnosis
;
;BEDD v2.0;Do not save diagnosis - now gets saved from PCC
S ^TMP("AMER",$J,2,12)=$G(BEDD("FinAct")) ;QD14^AMER3 disposition
S ^TMP("AMER",$J,2,14)=$G(BEDD("Disp")) ;QD14^AMER3 disposition
S ^TMP("AMER",$J,2,15)=$G(BEDD("WhrTrn")) ;QD15^AMER3 Where Transferred
S ^TMP("AMER",$J,2,16)=$G(BEDD("DCInst")) ;QD16^AMER3
S ^TMP("AMER",$J,2,17)=$G(BEDD("DCPrv")) ;QD17^AMER3
S ^TMP("AMER",$J,2,18)=$G(BEDD("DCNrs")) ;QD18^AMER3
S %H=EDREF.DCDtH_","_EDREF.DCTmH D YX^%DTC S FMDT=X_%
S ^TMP("AMER",$J,2,19)=$G(BEDD("DCDtTm")) ;; QD19^AMER3
S ^TMP("AMER",$J,2,21)=$G(BEDD("AdmPrv")) ;; QD19^AMER3
S ^TMP("AMER",$J,2,20)=$$CLIN^BEDDUTIU(EDREF.TrgCln) ;;QD20^AMER3
;
S AMERDR(1)=$$DR1^AMERSAV("QA")
S AMERDR(1)=AMERDR(1)_";.03////"_$P($G(^AMERADM(AMERDFN,0)),U,3)
S AMERDR(2)=$$DR1^AMERSAV("QD")_";.19////"_$G(DUZ)_";10.1////1"
;
;Save Injury Information
D INJ^AMERSAV1
;
;Save ED Consult Information
D CONSULT^AMERSAV
;
;Save - Other info
D STUFF^AMERSAV(AMERDFN)
D DRM^AMERSAV
;
;Remove AMERADM entry
D KILLADM^AMERSAV
;
;Put entry in ER VISIT 9009080
S AMERDA=$$RUN^AMERSAV1
;
;Log Durations
;
S AR=$$GET1^DIQ(9009080,AMERDA_",",.01,"I")
;
;Triage Wait
S X=$$GET1^DIQ(9009080,AMERDA_",",12.2,"I")
S %=$$DT^AMERSAV1(X,AR,"M") S:%>0 AMERDUR(9009080,AMERDA_",",12.4)=%
;
;Provider Wait
S X=$$GET1^DIQ(9009080,AMERDA_",",12.1,"I")
S %=$$DT^AMERSAV1(X,AR,"M") S:%>0 AMERDUR(9009080,AMERDA_",",12.3)=%
;
;Duration
S X=$$GET1^DIQ(9009080,AMERDA_",",6.2,"I")
S %=$$DT^AMERSAV1(X,AR,"M") S:%>0 AMERDUR(9009080,AMERDA_",",12.5)=%
I $D(AMERDUR) D FILE^DIE("","AMERDUR","ERROR")
;
;Log V PROVIDER entries
S PRMNRS=EDREF.PrmNurse
D PRV^BEDDUTIU(VIEN,AMERDA,PRMNRS)
;
;Log V POV entries
D POV^BEDDUTIU(VIEN,AMERDA)
;
;Log Consult Providers in V PROVIDER
D PCCPRV
;
;Log Procedure Providers in V PROVIDER
D PRPOV^BEDDUTIU(VIEN,AMERDA,.PRCPV)
;
;Log Compiled Fields
D COMP
;
I EDREF.DCDocHSDt>0 D
. S EDREF.DCDocHEDt=$P($H,",",1),EDREF.DCDocHETm=$P($H,",",2)
S EDREF.AMERVSIT=AMERDA,EDREF.DCFlag=1
S STAT=EDREF.%Save()
S EDREF=""
;
I STAT>1 S RSTAT="Y"
I STAT=0 S RSTAT="N"
;
;Save V EMERGENCY VISIT RECORD entry
D VERENTRY($G(AMERDA),$G(VIEN))
;
;Clear Room
D RMRMV^BEDDUTW(OBJID)
Q STAT
;
DCUPDATE(AMERVSIT,DCDT,DISP) ;Discharge Reversed DC
;
NEW AMUPD,ERROR
;
Q:AMERVSIT=""
;
L +^AMERVSIT(AMERVSIT):30 I '$T Q
;
S AMUPD(9009080,AMERVSIT_",",6.1)=DISP
S AMUPD(9009080,AMERVSIT_",",6.2)=DCDT
;
I $D(AMUPD) D FILE^DIE("","AMUPD","ERROR")
;
L -^AMERVSIT(AMERVSIT)
Q
;
CONSQRY ;Perform Query to Gather ED Consults and store in ^TMP("AMER
;
NEW RS,STATUS
;
S RS=##CLASS(%ResultSet).%New()
S RS.ClassName="BEDD.EDConsults"
S RS.QueryName="consPrint"
S STATUS=RS.Execute(OBJID)
;
;If none quit
I STATUS'=1 G XCONS
;
NEW AMERNO
;
S AMERNO=1
While RS.Next() {
NEW SERV
S SERV=RS.Data("ConsultSrv")
If SERV'="" D
. NEW %,%H,DTM,CPRV
. S ^TMP("AMER",$J,2,7,AMERNO,.01)=RS.Data("ConsultSrv")
. S %H=RS.Data("DateSeen")_","_RS.Data("TimeSeen") S:%H="," %H=""
. D YX^%DTC S DTM=X_% S:DTM="0" DTM=""
. S ^TMP("AMER",$J,2,7,AMERNO,.02)=DTM
. S CPRV=RS.Data("ConsultN")
. S ^TMP("AMER",$J,2,7,AMERNO,.03)=CPRV
. S ^TMP("AMER",$J,2,7,AMERNO)=SERV_U_$$GET1^DIQ(9009082.9,SERV_",",".01","I")_U_DTM_U_CPRV_U_$$GET1^DIQ(200,CPRV_",",".01","I")
. S AMERNO=AMERNO+1
}
;
XCONS S RS=""
Q
;
PROCQ(PRCPV) ;Perform Query to Gather Procedures and store in ^TMP("AMER
;
NEW RS,STATUS,AMERPROC,PRV
;
S RS=##CLASS(%ResultSet).%New()
S RS.ClassName="BEDD.EDProc"
S RS.QueryName="procPrint"
S STATUS=RS.Execute(OBJID)
;
;Quit if no procedures
I STATUS'=1 G XPROCQ
;
While RS.Next() {
;
NEW BDT,BTM,EDT,ETM
S AMERPROC=RS.Data("EDProc")
S PRV=RS.Data("ProcStf")
S BDT=RS.Data("ProcDt")
S BTM=RS.Data("ProcSTm")
S EDT=RS.Data("ProcEDt")
S ETM=RS.Data("ProcETm")
I AMERPROC'="" S ^TMP("AMER",$J,2,10,AMERPROC)=AMERPROC_"^"_RS.Data("EDProcN")
;
;Track Procedure Provider Info
I PRV]"" S PRCPV(PRV)=BDT_U_BTM_U_EDT_U_ETM
}
XPROCQ S RS=""
Q
;
DIAGQ ;EP - Perform Query to Gather Diagnosis and store in ^TMP("AMER
;
;BEDD v2.0;No longer pulling Dx from BEDD class
Q
NEW RS,STATUS,AMERDIAG,CNT,CODE,PRM,PCODE,NAR,PNAR,PFND
K DIAG
;
S CNT=0,PCODE="",PNAR="",PFND=""
S RS=##CLASS(%ResultSet).%New()
S RS.ClassName="BEDD.EDDiagnosis"
S RS.QueryName="DXPrint"
S STATUS=RS.Execute(OBJID)
;
;Quit if no diagnosis
I STATUS'=1 S RS="" Q
;
While RS.Next() {
;
S CIEN=RS.Data("CodeIEN")
S PRM=RS.Data("PrimaryDiag")
S NAR=RS.Data("DiagNarrative")
S CODE=$$GET1^DIQ(80,CIEN_",",".01","I")
;
I ((PRM="YES")&(PFND="")) {
S ^TMP("AMER",$J,2,11,.1)=CIEN_U_NAR_" ["_CODE_"]"
S PFND=1
}
Else {
S CNT=CNT+1
S ^TMP("AMER",$J,2,11,CNT)=CIEN_U_NAR_" ["_CODE_"]"
}
}
;
XDIAGQ S RS=""
Q
;
PCCPRV ;Log Consult Provider(s) in V PROVIDER file
;
NEW RIEN,RIENI,VPROV
;
I $D(^AUPNVPRV("AD",VIEN)) D
. ;
. ;Get list of existing entries
. S RIEN="" F S RIEN=$O(^AUPNVPRV("AD",VIEN,RIEN)) Q:+RIEN=0 S VPROV($P(^AUPNVPRV(RIEN,0),"^",1))=""
;
Q:$G(AMERDA)=""
Q:'$D(^AMERVSIT(AMERDA,19))
;
S RIEN="" F S RIEN=$O(^AMERVSIT(AMERDA,19,"B",RIEN)) Q:RIEN="" D
. S RIENI="" F S RIENI=$O(^AMERVSIT(AMERDA,19,"B",RIEN,RIENI)) Q:RIENI="" D
.. ;
.. NEW RCP,RCDT,IENS,DA
.. ;
.. S DA(1)=AMERDA,DA=RIENI,IENS=$$IENS^DILF(.DA)
.. S RCP=$$GET1^DIQ(9009080.019,IENS,".03","I") Q:RCP="" ;Cons
.. S RCDT=$$GET1^DIQ(9009080.019,IENS,".02","I") ;Cons Dtm
.. ;
.. I '$D(VPROV(RCP)) D
... K DIC,DD,DO,DINUM,X,Y
... S DIC="^AUPNVPRV(" S DIC(0)="XML" S X=RCP
... S DIC("DR")=".02////"_DFN_";.03////"_VIEN_";.04////S;.05////C;1201////"_RCDT
... D FILE^DICN
... K DIC,DD,DO,DINUM
... S VPROV(RCP)=""
;
Q
;
COMP ;Process computed fields
;
NEW AMERDR,AMERDFN,ADMDTM,VSIT,DTM,X,DIC,DD,DO,DIE,DA,DR
;
S (AMERDR(2),AMERDR(12))=""
;
; REVOLVING DOOR
S AMERDFN=DFN
S ADMDTM=$$GET1^DIQ(9009080,AMERDA_",",".01","I")
;
S DTM=0,VSIT="" F S VSIT=$O(^AMERVSIT("AC",AMERDFN,VSIT)) Q:'VSIT D
. ;
. NEW X
. S X=$$GET1^DIQ(9009080,VSIT_",",".01","I")
. I X>DTM,X'>ADMDTM S DTM=X
;
I +DTM]"" D
. S DTM=$$DT^AMERSAV1(ADMDTM,DTM,"D")
. I DTM<366 S AMERDR(2)=AMERDR(2)_";8.2////"_DTM
;
;Injury transport lag
I $D(^AMERVSIT(AMERDA,3)) D
. NEW X
. S X=$$GET1^DIQ(9009080,VSIT_",","3.4","I")
. Q:'X
. S DTM=$$DT(ADMDTM,X,"M"),AMERDR(2)=AMERDR(2)_";8.1////"_DTM
;
;Doctor Wait
S X=$$GET1^DIQ(9009080,VSIT_",","12.1","I") I X D
. S DTM=$$DT(X,ADMDTM,"M"),AMERDR(12)=AMERDR(12)_";12.3////"_DTM
;
;Triage Nurse Wait
S X=$$GET1^DIQ(9009080,VSIT_",","12.2","I") I X D
. S DTM=$$DT^AMERSAV1(X,ADMDTM,"M"),AMERDR(12)=AMERDR(12)_";12.4////"_DTM
;
;Visit Duration
S X=$$GET1^DIQ(9009080,VSIT_",","6.2","I") I X D
. S DTM=$$DT^AMERSAV1(X,ADMDTM,"M"),AMERDR(12)=AMERDR(12)_";12.5////"_DTM
;
S DIE="^AMERVSIT(" S DA=AMERDA
S DR=$P(AMERDR(2),";",2,99)
D ^DIE
S DR=$P(AMERDR(12),";",2,99)
D ^DIE
Q
;
VERENTRY(AMERDFN,AMERPCC) ;Create V EMERGENCY VISIT RECORD entry
;
;BEDD*2.0*1;Updated to call new AMER update call
D VER^AMERVER($G(AMERDFN),$G(AMERPCC))
Q
;
Q:$G(AMERPCC)=""
Q:$D(^AUPNVER("AD",AMERPCC))
;
NEW IACT,URG,DCDT,MOT,MOA,ENTBY,DISP,DSP,DIC,DD,DO,DINUM,X,Y
;
;Urgency
S IACT=$$GET1^DIQ(9009080,AMERDA_",",".24","I"),URG=$S(IACT=1:"E",((IACT=2)!(IACT=3)):"U",1:"N")
;
;Departure Date/Time
S DCDT=$$GET1^DIQ(9009080,AMERDA_",","6.2","I")
;
;Method of Transport
S ENTBY="",MOA="",MOT=$$GET1^DIQ(9009080,AMERDA_",",".25","I") I MOT'="" D
. ;
. ;Means of Arrival
. S MOT=$$GET1^DIQ(9009083,MOT_",",".01","I")
. I MOT["WALK" S MOA="W"
. I MOT["AMBULANCE" S MOA="A"
. S:MOA="" MOA="O"
. ;
. ;Entered ER By
. I MOT["AMBULANCE" S ENTBY="A"
. I MOT["WHEEL" S ENTBY="W"
. I MOT["STRET" S ENTBY="S"
;
S DIS="",DISP=$$GET1^DIQ(9009080,AMERDA_",","6.1","I") I DISP'="" D
. S DISP=$$GET1^DIQ(9009083,DISP_",",".01","I")
. I DISP["HOME" S DIS="D"
. I DISP["TRANS" S DIS="T"
. I DISP["ADMIT" S DIS="A"
. I DISP["LEFT" S DIS="O"
. I DISP["REGIS" S DIS="O"
. I DISP["EXPIRED" S DIS="E"
. I DISP["DEA" S DIS="E"
;
;File entry
K DIC,DD,DO,DINUM,X
S DIC="^AUPNVER(" S DIC(0)="XML" S X="IHS-114 ER"
S DIC("DR")=".02////"_DFN_";.03////"_AMERPCC_";.04////"_URG_";.05////"_MOA_";.07////"_ENTBY_";.11////"_DIS_";.13////"_DCDT
D FILE^DICN
;
S $P(^AUPNVER(+Y,0),"^",12)=$E(DISP,1,20)
K DIC,DD,DO,DINUM,X
Q
;
DT(X,Y,T) ;EP - Calculate Time Difference
;
NEW %,A,B,C,E,%T,%H,%Y
;
I '$G(X)!('$G(Y)) Q ""
I $G(T)="" S T="M"
D H^%DTC S A=+%H,B=%T,X=Y
D H^%DTC S C=+%H,E=%T
I E>B S B=B+86400,A=A-1
S %=((A-C)*86400)+(B-E)
I T="M" S %=%\60
E S %=%\86400
Q %
;
PRCNT(OBJID,RET,PROC) ;Get count of procedures for visit
;
;Input:
; OBJID - Pointer to BEDD.EDVISIT entry
; RET (Optional) - Whether to return list (1/"")
;
;Output:
; total current procedure entries
; PROC Array (Optional) - List of procedure entries
;
NEW RS,STATUS,AMERPROC,CNT,XPROC
K PROC
;
S RET=$G(RET,"")
S CNT=0,PROC=0
S RS=##CLASS(%ResultSet).%New()
S RS.ClassName="BEDD.EDProc"
S RS.QueryName="procPrint"
S STATUS=RS.Execute(OBJID)
;
;Quit if no procedures
I STATUS'=1 S RS="" Q 0
;
While RS.Next() {
;
S AMERPROC=RS.Data("EDProc")
If (AMERPROC'="") {
S CNT=CNT+1
If (RET=1) {
S XPROC=$$GET1^DIQ(9009083,AMERPROC_",",".01","I") Q:XPROC=""
S PROC=PROC+1
S PROC(CNT)=XPROC
}
}
}
XPRCNT S RS=""
Q CNT
;
EDCNT(OBJID,RET,CONS) ;Get count of ED Consults for visit
;
;Input:
; OBJID - Pointer to BEDD.EDVISIT entry
; RET (Optional) - Whether to return list (1/"")
;
;Output:
; total current ED Consults entries
; CONS Array (Optional) - List of ED Consults
;
NEW RS,STATUS,AMERED,CNT,COTY,CDATE,CTIME,CNS
K CONS
;
S RET=$G(RET,"")
S CNT=0,CONS=0
S RS=##CLASS(%ResultSet).%New()
S RS.ClassName="BEDD.EDConsults"
S RS.QueryName="consPrint"
S STATUS=RS.Execute(OBJID)
;
;Quit if no procedures
I STATUS'=1 S RS="" Q 0
;
While RS.Next() {
;
S AMERED=RS.Data("ConsultSrv")
If (AMERED'="") {
S CNT=CNT+1
If (RET=1) {
S COTY=$$GET1^DIQ(9009082.9,AMERED_",",".01","I") Q:COTY=""
S CDATE=RS.Data("DateSeen")
S CTIME=RS.Data("TimeSeen")
S CDATE=$TR($$HTE^XLFDT(CDATE_","_CTIME,"5"),"@"," ")
S CNS=RS.Data("ConsultN")
;I CNS]"" S CNS=$$GET1^DIQ(200,CNS_",",".01","I")
S CONS=CONS+1
S CONS(CONS)=COTY_"^"_CDATE_"^"_CNS
}
}
}
XEDCNT S RS=""
Q CNT
;
DXCNT(OBJID,RET,DIAG,PRIME) ;Get count of diagnosis for visit
;
;Input:
; OBJID - Pointer to BEDD.EDVISIT entry
; RET (Optional) - Whether to return list (1/"")
; PRIME (Optional) - Whether to return the Prime Code IEN (1/"")
;
;Output:
; total current DIAG entries
; DIAG Array (Optional) - List of diagnosis entries
;
NEW BEDD,VIEN,AMERPOV,CNT,PCODE,PNARR,X,PIEN
;
;Make sure needed values are defined
S X="S:$G(U)="""" U=""""" X X
S X="S:$G(DT)="""" DT=$$DT^XLFDT" X X
;
S BEDD=##CLASS(BEDD.EDVISIT).%OpenId(OBJID)
;
;Get Visit IEN and date
S VIEN=BEDD.VIEN I VIEN="" Q 0
S (BEDD,PCODE,PNAR,PIEN)="",DIAG=0
;
;Get V POV information
D POV^AMERUTIL("",VIEN,.AMERPOV)
;
S CNT="" F S CNT=$O(AMERPOV(CNT)) Q:CNT="" D
. NEW CODE,PRM,NARR,ICDIEN
. S CODE=$P(AMERPOV(CNT),"^")
. S PRM=$P(AMERPOV(CNT),"^",2) S PRM=$S(PRM="P":"YES",1:"NO")
. S NARR=$P(AMERPOV(CNT),"^",3)
. S ICDIEN=$P(AMERPOV(CNT),"^",4)
. S DIAG=DIAG+1
. S DIAG(DIAG)=CODE_U_NARR_U_PRM
. I PRM="YES" S PCODE=CODE,PNAR=NARR,PIEN=ICDIEN
;
;Save Prime Code at top level
If $G(PRIME)=1 S DIAG=DIAG_"^"_PCODE_"^"_PNAR_"^"_PIEN
;
Q DIAG
BEDDUTIS ;VNGT/HS/BEE-BEDD Utility Routine 2 - Cache Calls ; 08 Nov 2011 12:00 PM
+1 ;;2.0;IHS EMERGENCY DEPT DASHBOARD;**1**;Apr 02, 2014
+2 ;
+3 ;This routine is included in BEDD XML 2.0 Patch 1 install and is not in the KIDS
+4 ;
+5 QUIT
+6 ;
DC(DFN,OBJID,VIEN,DUZ,SITE,BEDD) ;Disch from BEDD/AMER
+1 ;
+2 ;Input:
+3 ; DFN
+4 ; OBJID - Pointer to BEDD.EDVISIT
+5 ; VIEN - Visit IEN
+6 ; DUZ - User's DUZ
+7 ; SITE - Site Value
+8 ;
+9 NEW EDREF,AMERVSIT
+10 ;
+11 SET EDREF=##CLASS(BEDD.EDVISIT).%OpenId(OBJID)
+12 SET AMERVSIT=EDREF.AMERVSIT
+13 ;
+14 ;Pull Room Value
+15 SET ROOM=EDREF.Room
+16 ;
+17 ;Check for Reversed Discharge (will have AMERVSIT)
+18 IF AMERVSIT'=""
Begin DoDot:1
+19 NEW %,%H,DCDT,DISP,ESTAT
+20 ;
+21 ;Discharge Date
+22 SET %H=EDREF.DCDtH_","_EDREF.DCTmH
+23 DO YX^%DTC
SET DCDT=X_%
+24 ;
+25 ;Disposition
+26 ;EDREF.DCDispH
SET DISP=$GET(BEDD("Disp"))
+27 ;
+28 ;Save new Discharge Date/Time and Disp
+29 DO DCUPDATE(AMERVSIT,DCDT,DISP)
+30 ;
+31 IF EDREF.DCDocHSDt>0
Begin DoDot:2
+32 SET EDREF.DCDocHEDt=$PIECE($HOROLOG,",",1)
+33 SET EDREF.DCDocHETm=$PIECE($HOROLOG,",",2)
End DoDot:2
+34 ;
+35 ;Update Class Entry
+36 SET EDREF.DCFlag=1
+37 SET ESTAT=EDREF.%Save()
End DoDot:1
+38 ;
+39 IF EDREF.DCDocHSDt>0
Begin DoDot:1
+40 NEW ESTAT
+41 SET EDREF.DCDocHEDt=$PIECE($HOROLOG,",",1)
+42 SET EDREF.DCDocHETm=$PIECE($HOROLOG,",",2)
+43 SET ESTAT=EDREF.%Save()
End DoDot:1
+44 SET EDREF=""
+45 ;
+46 IF AMERVSIT'=""
QUIT
+47 ;
+48 ;Process Regular Disch
+49 SET U="^"
+50 DO DUZ^XUP(DUZ)
+51 IF $GET(DT)=""
SET DT=$$DT^XLFDT
+52 ;
+53 ;Set up AMER ^TMP("AMER" Entries needed for save
+54 ;
+55 NEW AMERDFN,AMERPCC,AMERLINE,FMDT,%,%H,AMERDR,AMERDA,STAT
+56 NEW ERROR,PRCPV,PRCNT,PRMNRS,AMERDUR,AR,X
+57 ;
+58 SET AMERDFN=DFN
SET AMERPCC=VIEN
SET AMERLINE=""
+59 ;
+60 ;Reset AMER globals
+61 KILL ^TMP("AMER",$JOB,1),^TMP("AMER",$JOB,2),^TMP("AMER",$JOB,3)
+62 ;
+63 ;Convert Admission file back to ^TMP entries
+64 DO UTL^AMER0(AMERDFN)
+65 SET ^TMP("AMER",$JOB,2,1)=AMERDFN
+66 ;
+67 SET EDREF=##CLASS(BEDD.EDVISIT).%OpenId(OBJID)
+68 IF (EDREF.DCDocHSDt>0)
Begin DoDot:1
+69 SET EDREF.DCDocHEDt=$PIECE($HOROLOG,",",1)
+70 SET EDREF.DCDocHETm=$PIECE($HOROLOG,",",2)
End DoDot:1
+71 ;
+72 ;Pull Room Value
+73 SET ROOM=EDREF.Room
+74 ;
+75 ;Set Injury Information
+76 SET ^TMP("AMER",$JOB,2,2)=0
+77 IF EDREF.Injury="YES"
Begin DoDot:1
+78 ;QD2^AMER2
SET ^TMP("AMER",$JOB,2,2)=1
+79 ;QD31^AMER2B
SET ^TMP("AMER",$JOB,2,31)=EDREF.PtInjury.InjLocat
+80 SET ^TMP("AMER",$JOB,2,32)=EDREF.PtInjury.InjDtTm
+81 ;QD33^AMER2B
SET ^TMP("AMER",$JOB,2,33)=EDREF.PtInjury.InjCauseIEN
+82 ;QD34^AMER2B
SET ^TMP("AMER",$JOB,2,34)=EDREF.PtInjury.InjSet
+83 ;QD35^AMER2B
SET ^TMP("AMER",$JOB,2,35)=EDREF.PtInjury.SafetyEquip
+84 ;QD5^AMER2
IF EDREF.PtInjury.WrkRel="YES"
SET ^TMP("AMER",$JOB,2,5)=1
+85 ;QD5^AMER2
IF '$TEST
SET ^TMP("AMER",$JOB,2,5)=0
+86 ;QD41^AMER2
SET ^TMP("AMER",$JOB,2,41)=EDREF.PtInjury.MVCLoc
+87 ;QD42^AMER
SET ^TMP("AMER",$JOB,2,42)=EDREF.PtInjury.AtFaultInsurance
+88 ;QD43^AMER
SET ^TMP("AMER",$JOB,2,43)=EDREF.PtInjury.AtFaultInsPolicy
End DoDot:1
+89 ;
+90 ;ED Consults
+91 SET ^TMP("AMER",$JOB,2,6)=0
IF $$EDCNT(OBJID)>0
SET ^TMP("AMER",$JOB,2,6)=1
+92 ;QD6^AMER2
DO CONSQRY
+93 ;
+94 ;Procedures
+95 SET PRCNT=$$PRCNT(OBJID)
+96 ;QD10^AMER3
IF (PRCNT>0)
DO PROCQ(.PRCPV)
+97 IF (PRCNT<1)
SET %=$$OPT^AMER0("NONE","ER PROCEDURES")
SET ^TMP("AMER",$JOB,2,10,%)=%_U_"NONE"
+98 ;
+99 ;Diagnosis
+100 ;
+101 ;BEDD v2.0;Do not save diagnosis - now gets saved from PCC
+102 ;QD14^AMER3 disposition
SET ^TMP("AMER",$JOB,2,12)=$GET(BEDD("FinAct"))
+103 ;QD14^AMER3 disposition
SET ^TMP("AMER",$JOB,2,14)=$GET(BEDD("Disp"))
+104 ;QD15^AMER3 Where Transferred
SET ^TMP("AMER",$JOB,2,15)=$GET(BEDD("WhrTrn"))
+105 ;QD16^AMER3
SET ^TMP("AMER",$JOB,2,16)=$GET(BEDD("DCInst"))
+106 ;QD17^AMER3
SET ^TMP("AMER",$JOB,2,17)=$GET(BEDD("DCPrv"))
+107 ;QD18^AMER3
SET ^TMP("AMER",$JOB,2,18)=$GET(BEDD("DCNrs"))
+108 SET %H=EDREF.DCDtH_","_EDREF.DCTmH
DO YX^%DTC
SET FMDT=X_%
+109 ;; QD19^AMER3
SET ^TMP("AMER",$JOB,2,19)=$GET(BEDD("DCDtTm"))
+110 ;; QD19^AMER3
SET ^TMP("AMER",$JOB,2,21)=$GET(BEDD("AdmPrv"))
+111 ;;QD20^AMER3
SET ^TMP("AMER",$JOB,2,20)=$$CLIN^BEDDUTIU(EDREF.TrgCln)
+112 ;
+113 SET AMERDR(1)=$$DR1^AMERSAV("QA")
+114 SET AMERDR(1)=AMERDR(1)_";.03////"_$PIECE($GET(^AMERADM(AMERDFN,0)),U,3)
+115 SET AMERDR(2)=$$DR1^AMERSAV("QD")_";.19////"_$GET(DUZ)_";10.1////1"
+116 ;
+117 ;Save Injury Information
+118 DO INJ^AMERSAV1
+119 ;
+120 ;Save ED Consult Information
+121 DO CONSULT^AMERSAV
+122 ;
+123 ;Save - Other info
+124 DO STUFF^AMERSAV(AMERDFN)
+125 DO DRM^AMERSAV
+126 ;
+127 ;Remove AMERADM entry
+128 DO KILLADM^AMERSAV
+129 ;
+130 ;Put entry in ER VISIT 9009080
+131 SET AMERDA=$$RUN^AMERSAV1
+132 ;
+133 ;Log Durations
+134 ;
+135 SET AR=$$GET1^DIQ(9009080,AMERDA_",",.01,"I")
+136 ;
+137 ;Triage Wait
+138 SET X=$$GET1^DIQ(9009080,AMERDA_",",12.2,"I")
+139 SET %=$$DT^AMERSAV1(X,AR,"M")
IF %>0
SET AMERDUR(9009080,AMERDA_",",12.4)=%
+140 ;
+141 ;Provider Wait
+142 SET X=$$GET1^DIQ(9009080,AMERDA_",",12.1,"I")
+143 SET %=$$DT^AMERSAV1(X,AR,"M")
IF %>0
SET AMERDUR(9009080,AMERDA_",",12.3)=%
+144 ;
+145 ;Duration
+146 SET X=$$GET1^DIQ(9009080,AMERDA_",",6.2,"I")
+147 SET %=$$DT^AMERSAV1(X,AR,"M")
IF %>0
SET AMERDUR(9009080,AMERDA_",",12.5)=%
+148 IF $DATA(AMERDUR)
DO FILE^DIE("","AMERDUR","ERROR")
+149 ;
+150 ;Log V PROVIDER entries
+151 SET PRMNRS=EDREF.PrmNurse
+152 DO PRV^BEDDUTIU(VIEN,AMERDA,PRMNRS)
+153 ;
+154 ;Log V POV entries
+155 DO POV^BEDDUTIU(VIEN,AMERDA)
+156 ;
+157 ;Log Consult Providers in V PROVIDER
+158 DO PCCPRV
+159 ;
+160 ;Log Procedure Providers in V PROVIDER
+161 DO PRPOV^BEDDUTIU(VIEN,AMERDA,.PRCPV)
+162 ;
+163 ;Log Compiled Fields
+164 DO COMP
+165 ;
+166 IF EDREF.DCDocHSDt>0
Begin DoDot:1
+167 SET EDREF.DCDocHEDt=$PIECE($HOROLOG,",",1)
SET EDREF.DCDocHETm=$PIECE($HOROLOG,",",2)
End DoDot:1
+168 SET EDREF.AMERVSIT=AMERDA
SET EDREF.DCFlag=1
+169 SET STAT=EDREF.%Save()
+170 SET EDREF=""
+171 ;
+172 IF STAT>1
SET RSTAT="Y"
+173 IF STAT=0
SET RSTAT="N"
+174 ;
+175 ;Save V EMERGENCY VISIT RECORD entry
+176 DO VERENTRY($GET(AMERDA),$GET(VIEN))
+177 ;
+178 ;Clear Room
+179 DO RMRMV^BEDDUTW(OBJID)
+180 QUIT STAT
+181 ;
DCUPDATE(AMERVSIT,DCDT,DISP) ;Discharge Reversed DC
+1 ;
+2 NEW AMUPD,ERROR
+3 ;
+4 IF AMERVSIT=""
QUIT
+5 ;
+6 LOCK +^AMERVSIT(AMERVSIT):30
IF '$TEST
QUIT
+7 ;
+8 SET AMUPD(9009080,AMERVSIT_",",6.1)=DISP
+9 SET AMUPD(9009080,AMERVSIT_",",6.2)=DCDT
+10 ;
+11 IF $DATA(AMUPD)
DO FILE^DIE("","AMUPD","ERROR")
+12 ;
+13 LOCK -^AMERVSIT(AMERVSIT)
+14 QUIT
+15 ;
CONSQRY ;Perform Query to Gather ED Consults and store in ^TMP("AMER
+1 ;
+2 NEW RS,STATUS
+3 ;
+4 SET RS=##CLASS(%ResultSet).%New()
+5 SET RS.ClassName="BEDD.EDConsults"
+6 SET RS.QueryName="consPrint"
+7 SET STATUS=RS.Execute(OBJID)
+8 ;
+9 ;If none quit
+10 IF STATUS'=1
GOTO XCONS
+11 ;
+12 NEW AMERNO
+13 ;
+14 SET AMERNO=1
+15
*** ERROR ***
+16 NEW SERV
+17 SET SERV=RS.Data("ConsultSrv")
+18 IF SERV'=""
Begin DoDot:1
+19 NEW %,%H,DTM,CPRV
+20 SET ^TMP("AMER",$JOB,2,7,AMERNO,.01)=RS.Data("ConsultSrv")
+21 SET %H=RS.Data("DateSeen")_","_RS.Data("TimeSeen")
IF %H=","
SET %H=""
+22 DO YX^%DTC
SET DTM=X_%
IF DTM="0"
SET DTM=""
+23 SET ^TMP("AMER",$JOB,2,7,AMERNO,.02)=DTM
+24 SET CPRV=RS.Data("ConsultN")
+25 SET ^TMP("AMER",$JOB,2,7,AMERNO,.03)=CPRV
+26 SET ^TMP("AMER",$JOB,2,7,AMERNO)=SERV_U_$$GET1^DIQ(9009082.9,SERV_",",".01","I")_U_DTM_U_CPRV_U_$$GET1^DIQ(200,CPRV_",",".01","I")
+27 SET AMERNO=AMERNO+1
End DoDot:1
+28
*** ERROR ***
+29 ;
XCONS SET RS=""
+1 QUIT
+2 ;
PROCQ(PRCPV) ;Perform Query to Gather Procedures and store in ^TMP("AMER
+1 ;
+2 NEW RS,STATUS,AMERPROC,PRV
+3 ;
+4 SET RS=##CLASS(%ResultSet).%New()
+5 SET RS.ClassName="BEDD.EDProc"
+6 SET RS.QueryName="procPrint"
+7 SET STATUS=RS.Execute(OBJID)
+8 ;
+9 ;Quit if no procedures
+10 IF STATUS'=1
GOTO XPROCQ
+11 ;
+12
*** ERROR ***
+13 ;
+14 NEW BDT,BTM,EDT,ETM
+15 SET AMERPROC=RS.Data("EDProc")
+16 SET PRV=RS.Data("ProcStf")
+17 SET BDT=RS.Data("ProcDt")
+18 SET BTM=RS.Data("ProcSTm")
+19 SET EDT=RS.Data("ProcEDt")
+20 SET ETM=RS.Data("ProcETm")
+21 IF AMERPROC'=""
SET ^TMP("AMER",$JOB,2,10,AMERPROC)=AMERPROC_"^"_RS.Data("EDProcN")
+22 ;
+23 ;Track Procedure Provider Info
+24 IF PRV]""
SET PRCPV(PRV)=BDT_U_BTM_U_EDT_U_ETM
+25
*** ERROR ***
XPROCQ SET RS=""
+1 QUIT
+2 ;
DIAGQ ;EP - Perform Query to Gather Diagnosis and store in ^TMP("AMER
+1 ;
+2 ;BEDD v2.0;No longer pulling Dx from BEDD class
+3 QUIT
+4 NEW RS,STATUS,AMERDIAG,CNT,CODE,PRM,PCODE,NAR,PNAR,PFND
+5 KILL DIAG
+6 ;
+7 SET CNT=0
SET PCODE=""
SET PNAR=""
SET PFND=""
+8 SET RS=##CLASS(%ResultSet).%New()
+9 SET RS.ClassName="BEDD.EDDiagnosis"
+10 SET RS.QueryName="DXPrint"
+11 SET STATUS=RS.Execute(OBJID)
+12 ;
+13 ;Quit if no diagnosis
+14 IF STATUS'=1
SET RS=""
QUIT
+15 ;
+16
*** ERROR ***
+17 ;
+18
*** ERROR ***
+19
*** ERROR ***
+20
*** ERROR ***
+21
*** ERROR ***
+22 ;
+23
*** ERROR ***
+24
*** ERROR ***
+25
*** ERROR ***
+26
*** ERROR ***
+27
*** ERROR ***
+28
*** ERROR ***
+29
*** ERROR ***
+30
*** ERROR ***
+31
*** ERROR ***
+32 ;
XDIAGQ SET RS=""
+1 QUIT
+2 ;
PCCPRV ;Log Consult Provider(s) in V PROVIDER file
+1 ;
+2 NEW RIEN,RIENI,VPROV
+3 ;
+4 IF $DATA(^AUPNVPRV("AD",VIEN))
Begin DoDot:1
+5 ;
+6 ;Get list of existing entries
+7 SET RIEN=""
FOR
SET RIEN=$ORDER(^AUPNVPRV("AD",VIEN,RIEN))
IF +RIEN=0
QUIT
SET VPROV($PIECE(^AUPNVPRV(RIEN,0),"^",1))=""
End DoDot:1
+8 ;
+9 IF $GET(AMERDA)=""
QUIT
+10 IF '$DATA(^AMERVSIT(AMERDA,19))
QUIT
+11 ;
+12 SET RIEN=""
FOR
SET RIEN=$ORDER(^AMERVSIT(AMERDA,19,"B",RIEN))
IF RIEN=""
QUIT
Begin DoDot:1
+13 SET RIENI=""
FOR
SET RIENI=$ORDER(^AMERVSIT(AMERDA,19,"B",RIEN,RIENI))
IF RIENI=""
QUIT
Begin DoDot:2
+14 ;
+15 NEW RCP,RCDT,IENS,DA
+16 ;
+17 SET DA(1)=AMERDA
SET DA=RIENI
SET IENS=$$IENS^DILF(.DA)
+18 ;Cons
SET RCP=$$GET1^DIQ(9009080.019,IENS,".03","I")
IF RCP=""
QUIT
+19 ;Cons Dtm
SET RCDT=$$GET1^DIQ(9009080.019,IENS,".02","I")
+20 ;
+21 IF '$DATA(VPROV(RCP))
Begin DoDot:3
+22 KILL DIC,DD,DO,DINUM,X,Y
+23 SET DIC="^AUPNVPRV("
SET DIC(0)="XML"
SET X=RCP
+24 SET DIC("DR")=".02////"_DFN_";.03////"_VIEN_";.04////S;.05////C;1201////"_RCDT
+25 DO FILE^DICN
+26 KILL DIC,DD,DO,DINUM
+27 SET VPROV(RCP)=""
End DoDot:3
End DoDot:2
End DoDot:1
+28 ;
+29 QUIT
+30 ;
COMP ;Process computed fields
+1 ;
+2 NEW AMERDR,AMERDFN,ADMDTM,VSIT,DTM,X,DIC,DD,DO,DIE,DA,DR
+3 ;
+4 SET (AMERDR(2),AMERDR(12))=""
+5 ;
+6 ; REVOLVING DOOR
+7 SET AMERDFN=DFN
+8 SET ADMDTM=$$GET1^DIQ(9009080,AMERDA_",",".01","I")
+9 ;
+10 SET DTM=0
SET VSIT=""
FOR
SET VSIT=$ORDER(^AMERVSIT("AC",AMERDFN,VSIT))
IF 'VSIT
QUIT
Begin DoDot:1
+11 ;
+12 NEW X
+13 SET X=$$GET1^DIQ(9009080,VSIT_",",".01","I")
+14 IF X>DTM
IF X'>ADMDTM
SET DTM=X
End DoDot:1
+15 ;
+16 IF +DTM]""
Begin DoDot:1
+17 SET DTM=$$DT^AMERSAV1(ADMDTM,DTM,"D")
+18 IF DTM<366
SET AMERDR(2)=AMERDR(2)_";8.2////"_DTM
End DoDot:1
+19 ;
+20 ;Injury transport lag
+21 IF $DATA(^AMERVSIT(AMERDA,3))
Begin DoDot:1
+22 NEW X
+23 SET X=$$GET1^DIQ(9009080,VSIT_",","3.4","I")
+24 IF 'X
QUIT
+25 SET DTM=$$DT(ADMDTM,X,"M")
SET AMERDR(2)=AMERDR(2)_";8.1////"_DTM
End DoDot:1
+26 ;
+27 ;Doctor Wait
+28 SET X=$$GET1^DIQ(9009080,VSIT_",","12.1","I")
IF X
Begin DoDot:1
+29 SET DTM=$$DT(X,ADMDTM,"M")
SET AMERDR(12)=AMERDR(12)_";12.3////"_DTM
End DoDot:1
+30 ;
+31 ;Triage Nurse Wait
+32 SET X=$$GET1^DIQ(9009080,VSIT_",","12.2","I")
IF X
Begin DoDot:1
+33 SET DTM=$$DT^AMERSAV1(X,ADMDTM,"M")
SET AMERDR(12)=AMERDR(12)_";12.4////"_DTM
End DoDot:1
+34 ;
+35 ;Visit Duration
+36 SET X=$$GET1^DIQ(9009080,VSIT_",","6.2","I")
IF X
Begin DoDot:1
+37 SET DTM=$$DT^AMERSAV1(X,ADMDTM,"M")
SET AMERDR(12)=AMERDR(12)_";12.5////"_DTM
End DoDot:1
+38 ;
+39 SET DIE="^AMERVSIT("
SET DA=AMERDA
+40 SET DR=$PIECE(AMERDR(2),";",2,99)
+41 DO ^DIE
+42 SET DR=$PIECE(AMERDR(12),";",2,99)
+43 DO ^DIE
+44 QUIT
+45 ;
VERENTRY(AMERDFN,AMERPCC) ;Create V EMERGENCY VISIT RECORD entry
+1 ;
+2 ;BEDD*2.0*1;Updated to call new AMER update call
+3 DO VER^AMERVER($GET(AMERDFN),$GET(AMERPCC))
+4 QUIT
+5 ;
+6 IF $GET(AMERPCC)=""
QUIT
+7 IF $DATA(^AUPNVER("AD",AMERPCC))
QUIT
+8 ;
+9 NEW IACT,URG,DCDT,MOT,MOA,ENTBY,DISP,DSP,DIC,DD,DO,DINUM,X,Y
+10 ;
+11 ;Urgency
+12 SET IACT=$$GET1^DIQ(9009080,AMERDA_",",".24","I")
SET URG=$SELECT(IACT=1:"E",((IACT=2)!(IACT=3)):"U",1:"N")
+13 ;
+14 ;Departure Date/Time
+15 SET DCDT=$$GET1^DIQ(9009080,AMERDA_",","6.2","I")
+16 ;
+17 ;Method of Transport
+18 SET ENTBY=""
SET MOA=""
SET MOT=$$GET1^DIQ(9009080,AMERDA_",",".25","I")
IF MOT'=""
Begin DoDot:1
+19 ;
+20 ;Means of Arrival
+21 SET MOT=$$GET1^DIQ(9009083,MOT_",",".01","I")
+22 IF MOT["WALK"
SET MOA="W"
+23 IF MOT["AMBULANCE"
SET MOA="A"
+24 IF MOA=""
SET MOA="O"
+25 ;
+26 ;Entered ER By
+27 IF MOT["AMBULANCE"
SET ENTBY="A"
+28 IF MOT["WHEEL"
SET ENTBY="W"
+29 IF MOT["STRET"
SET ENTBY="S"
End DoDot:1
+30 ;
+31 SET DIS=""
SET DISP=$$GET1^DIQ(9009080,AMERDA_",","6.1","I")
IF DISP'=""
Begin DoDot:1
+32 SET DISP=$$GET1^DIQ(9009083,DISP_",",".01","I")
+33 IF DISP["HOME"
SET DIS="D"
+34 IF DISP["TRANS"
SET DIS="T"
+35 IF DISP["ADMIT"
SET DIS="A"
+36 IF DISP["LEFT"
SET DIS="O"
+37 IF DISP["REGIS"
SET DIS="O"
+38 IF DISP["EXPIRED"
SET DIS="E"
+39 IF DISP["DEA"
SET DIS="E"
End DoDot:1
+40 ;
+41 ;File entry
+42 KILL DIC,DD,DO,DINUM,X
+43 SET DIC="^AUPNVER("
SET DIC(0)="XML"
SET X="IHS-114 ER"
+44 SET DIC("DR")=".02////"_DFN_";.03////"_AMERPCC_";.04////"_URG_";.05////"_MOA_";.07////"_ENTBY_";.11////"_DIS_";.13////"_DCDT
+45 DO FILE^DICN
+46 ;
+47 SET $PIECE(^AUPNVER(+Y,0),"^",12)=$EXTRACT(DISP,1,20)
+48 KILL DIC,DD,DO,DINUM,X
+49 QUIT
+50 ;
DT(X,Y,T) ;EP - Calculate Time Difference
+1 ;
+2 NEW %,A,B,C,E,%T,%H,%Y
+3 ;
+4 IF '$GET(X)!('$GET(Y))
QUIT ""
+5 IF $GET(T)=""
SET T="M"
+6 DO H^%DTC
SET A=+%H
SET B=%T
SET X=Y
+7 DO H^%DTC
SET C=+%H
SET E=%T
+8 IF E>B
SET B=B+86400
SET A=A-1
+9 SET %=((A-C)*86400)+(B-E)
+10 IF T="M"
SET %=%\60
+11 IF '$TEST
SET %=%\86400
+12 QUIT %
+13 ;
PRCNT(OBJID,RET,PROC) ;Get count of procedures for visit
+1 ;
+2 ;Input:
+3 ; OBJID - Pointer to BEDD.EDVISIT entry
+4 ; RET (Optional) - Whether to return list (1/"")
+5 ;
+6 ;Output:
+7 ; total current procedure entries
+8 ; PROC Array (Optional) - List of procedure entries
+9 ;
+10 NEW RS,STATUS,AMERPROC,CNT,XPROC
+11 KILL PROC
+12 ;
+13 SET RET=$GET(RET,"")
+14 SET CNT=0
SET PROC=0
+15 SET RS=##CLASS(%ResultSet).%New()
+16 SET RS.ClassName="BEDD.EDProc"
+17 SET RS.QueryName="procPrint"
+18 SET STATUS=RS.Execute(OBJID)
+19 ;
+20 ;Quit if no procedures
+21 IF STATUS'=1
SET RS=""
QUIT 0
+22 ;
+23
*** ERROR ***
+24 ;
+25 SET AMERPROC=RS.Data("EDProc")
+26
*** ERROR ***
+27
*** ERROR ***
+28
*** ERROR ***
+29
*** ERROR ***
+30
*** ERROR ***
+31
*** ERROR ***
+32
*** ERROR ***
+33
*** ERROR ***
+34
*** ERROR ***
XPRCNT SET RS=""
+1 QUIT CNT
+2 ;
EDCNT(OBJID,RET,CONS) ;Get count of ED Consults for visit
+1 ;
+2 ;Input:
+3 ; OBJID - Pointer to BEDD.EDVISIT entry
+4 ; RET (Optional) - Whether to return list (1/"")
+5 ;
+6 ;Output:
+7 ; total current ED Consults entries
+8 ; CONS Array (Optional) - List of ED Consults
+9 ;
+10 NEW RS,STATUS,AMERED,CNT,COTY,CDATE,CTIME,CNS
+11 KILL CONS
+12 ;
+13 SET RET=$GET(RET,"")
+14 SET CNT=0
SET CONS=0
+15 SET RS=##CLASS(%ResultSet).%New()
+16 SET RS.ClassName="BEDD.EDConsults"
+17 SET RS.QueryName="consPrint"
+18 SET STATUS=RS.Execute(OBJID)
+19 ;
+20 ;Quit if no procedures
+21 IF STATUS'=1
SET RS=""
QUIT 0
+22 ;
+23
*** ERROR ***
+24 ;
+25 SET AMERED=RS.Data("ConsultSrv")
+26
*** ERROR ***
+27
*** ERROR ***
+28
*** ERROR ***
+29
*** ERROR ***
+30
*** ERROR ***
+31
*** ERROR ***
+32
*** ERROR ***
+33
*** ERROR ***
+34 ;I CNS]"" S CNS=$$GET1^DIQ(200,CNS_",",".01","I")
