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

BEDDUTIS.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;This routine is included in BEDD XML 2.0 Patch 1 install and is not in the KIDS
  1.  ; 
  1.  Q
  1.  ;
  1. DC(DFN,OBJID,VIEN,DUZ,SITE,BEDD) ;Disch from BEDD/AMER
  1.  ;
  1.  ;Input:
  1.  ; DFN
  1.  ; OBJID - Pointer to BEDD.EDVISIT
  1.  ; VIEN - Visit IEN
  1.  ; DUZ - User's DUZ
  1.  ; SITE - Site Value
  1.  ;
  1.  NEW EDREF,AMERVSIT
  1.  ;
  1.  S EDREF=##CLASS(BEDD.EDVISIT).%OpenId(OBJID)
  1.  S AMERVSIT=EDREF.AMERVSIT
  1.  ;
  1.  ;Pull Room Value
  1.  S ROOM=EDREF.Room
  1.  ;
  1.  ;Check for Reversed Discharge (will have AMERVSIT)
  1.  I AMERVSIT'="" D
  1.  . NEW %,%H,DCDT,DISP,ESTAT
  1.  . ;
  1.  . ;Discharge Date
  1.  . S %H=EDREF.DCDtH_","_EDREF.DCTmH
  1.  . D YX^%DTC S DCDT=X_%
  1.  . ;
  1.  . ;Disposition
  1.  . S DISP=$G(BEDD("Disp")) ;EDREF.DCDispH
  1.  . ;
  1.  . ;Save new Discharge Date/Time and Disp
  1.  . D DCUPDATE(AMERVSIT,DCDT,DISP)
  1.  . ;
  1.  . I EDREF.DCDocHSDt>0 D
  1.  .. S EDREF.DCDocHEDt=$P($H,",",1)
  1.  .. S EDREF.DCDocHETm=$P($H,",",2)
  1.  . ;
  1.  . ;Update Class Entry
  1.  . S EDREF.DCFlag=1
  1.  . S ESTAT=EDREF.%Save()
  1.  ;
  1.  I EDREF.DCDocHSDt>0 D
  1.  . NEW ESTAT
  1.  . S EDREF.DCDocHEDt=$P($H,",",1)
  1.  . S EDREF.DCDocHETm=$P($H,",",2)
  1.  . S ESTAT=EDREF.%Save()
  1.  S EDREF=""
  1.  ;
  1.  Q:AMERVSIT'=""
  1.  ;
  1.  ;Process Regular Disch
  1.  S U="^"
  1.  D DUZ^XUP(DUZ)
  1.  S:$G(DT)="" DT=$$DT^XLFDT
  1.  ;
  1.  ;Set up AMER ^TMP("AMER" Entries needed for save
  1.  ;
  1.  NEW AMERDFN,AMERPCC,AMERLINE,FMDT,%,%H,AMERDR,AMERDA,STAT
  1.  NEW ERROR,PRCPV,PRCNT,PRMNRS,AMERDUR,AR,X
  1.  ;
  1.  S AMERDFN=DFN,AMERPCC=VIEN,AMERLINE=""
  1.  ;
  1.  ;Reset AMER globals
  1.  K ^TMP("AMER",$J,1),^TMP("AMER",$J,2),^TMP("AMER",$J,3)
  1.  ;
  1.  ;Convert Admission file back to ^TMP entries
  1.  D UTL^AMER0(AMERDFN)
  1.  S ^TMP("AMER",$J,2,1)=AMERDFN
  1.  ;
  1.  S EDREF=##CLASS(BEDD.EDVISIT).%OpenId(OBJID)
  1.  I (EDREF.DCDocHSDt>0) D
  1.  . S EDREF.DCDocHEDt=$P($H,",",1)
  1.  . S EDREF.DCDocHETm=$P($H,",",2)
  1.  ;
  1.  ;Pull Room Value
  1.  S ROOM=EDREF.Room
  1.  ;
  1.  ;Set Injury Information
  1.  S ^TMP("AMER",$J,2,2)=0
  1.  I EDREF.Injury="YES" D
  1.  . S ^TMP("AMER",$J,2,2)=1 ;QD2^AMER2
  1.  . S ^TMP("AMER",$J,2,31)=EDREF.PtInjury.InjLocat ;QD31^AMER2B
  1.  . S ^TMP("AMER",$J,2,32)=EDREF.PtInjury.InjDtTm
  1.  . S ^TMP("AMER",$J,2,33)=EDREF.PtInjury.InjCauseIEN ;QD33^AMER2B
  1.  . S ^TMP("AMER",$J,2,34)=EDREF.PtInjury.InjSet ;QD34^AMER2B
  1.  . S ^TMP("AMER",$J,2,35)=EDREF.PtInjury.SafetyEquip ;QD35^AMER2B
  1.  . I EDREF.PtInjury.WrkRel="YES" S ^TMP("AMER",$J,2,5)=1 ;QD5^AMER2
  1.  . E  S ^TMP("AMER",$J,2,5)=0 ;QD5^AMER2
  1.  . S ^TMP("AMER",$J,2,41)=EDREF.PtInjury.MVCLoc ;QD41^AMER2
  1.  . S ^TMP("AMER",$J,2,42)=EDREF.PtInjury.AtFaultInsurance ;QD42^AMER
  1.  . S ^TMP("AMER",$J,2,43)=EDREF.PtInjury.AtFaultInsPolicy ;QD43^AMER
  1.  ;
  1.  ;ED Consults
  1.  S ^TMP("AMER",$J,2,6)=0 I $$EDCNT(OBJID)>0 S ^TMP("AMER",$J,2,6)=1
  1.  D CONSQRY ;QD6^AMER2
  1.  ;
  1.  ;Procedures
  1.  S PRCNT=$$PRCNT(OBJID)
  1.  I (PRCNT>0) D PROCQ(.PRCPV) ;QD10^AMER3
  1.  I (PRCNT<1) S %=$$OPT^AMER0("NONE","ER PROCEDURES"),^TMP("AMER",$J,2,10,%)=%_U_"NONE"
  1.  ;
  1.  ;Diagnosis
  1.  ;
  1.  ;BEDD v2.0;Do not save diagnosis - now gets saved from PCC
  1.  S ^TMP("AMER",$J,2,12)=$G(BEDD("FinAct")) ;QD14^AMER3 disposition
  1.  S ^TMP("AMER",$J,2,14)=$G(BEDD("Disp")) ;QD14^AMER3 disposition
  1.  S ^TMP("AMER",$J,2,15)=$G(BEDD("WhrTrn")) ;QD15^AMER3 Where Transferred
  1.  S ^TMP("AMER",$J,2,16)=$G(BEDD("DCInst")) ;QD16^AMER3
  1.  S ^TMP("AMER",$J,2,17)=$G(BEDD("DCPrv")) ;QD17^AMER3
  1.  S ^TMP("AMER",$J,2,18)=$G(BEDD("DCNrs")) ;QD18^AMER3
  1.  S %H=EDREF.DCDtH_","_EDREF.DCTmH D YX^%DTC S FMDT=X_%
  1.  S ^TMP("AMER",$J,2,19)=$G(BEDD("DCDtTm")) ;; QD19^AMER3
  1.  S ^TMP("AMER",$J,2,21)=$G(BEDD("AdmPrv")) ;; QD19^AMER3
  1.  S ^TMP("AMER",$J,2,20)=$$CLIN^BEDDUTIU(EDREF.TrgCln) ;;QD20^AMER3
  1.  ;
  1.  S AMERDR(1)=$$DR1^AMERSAV("QA")
  1.  S AMERDR(1)=AMERDR(1)_";.03////"_$P($G(^AMERADM(AMERDFN,0)),U,3)
  1.  S AMERDR(2)=$$DR1^AMERSAV("QD")_";.19////"_$G(DUZ)_";10.1////1"
  1.  ;
  1.  ;Save Injury Information
  1.  D INJ^AMERSAV1
  1.  ;
  1.  ;Save ED Consult Information
  1.  D CONSULT^AMERSAV
  1.  ;
  1.  ;Save - Other info
  1.  D STUFF^AMERSAV(AMERDFN)
  1.  D DRM^AMERSAV
  1.  ;
  1.  ;Remove AMERADM entry
  1.  D KILLADM^AMERSAV
  1.  ;
  1.  ;Put entry in ER VISIT 9009080
  1.  S AMERDA=$$RUN^AMERSAV1
  1.  ;
  1.  ;Log Durations
  1.  ;
  1.  S AR=$$GET1^DIQ(9009080,AMERDA_",",.01,"I")
  1.  ;
  1.  ;Triage Wait
  1.  S X=$$GET1^DIQ(9009080,AMERDA_",",12.2,"I")
  1.  S %=$$DT^AMERSAV1(X,AR,"M") S:%>0 AMERDUR(9009080,AMERDA_",",12.4)=%
  1.  ;
  1.  ;Provider Wait
  1.  S X=$$GET1^DIQ(9009080,AMERDA_",",12.1,"I")
  1.  S %=$$DT^AMERSAV1(X,AR,"M") S:%>0 AMERDUR(9009080,AMERDA_",",12.3)=%
  1.  ;
  1.  ;Duration
  1.  S X=$$GET1^DIQ(9009080,AMERDA_",",6.2,"I")
  1.  S %=$$DT^AMERSAV1(X,AR,"M") S:%>0 AMERDUR(9009080,AMERDA_",",12.5)=%
  1.  I $D(AMERDUR) D FILE^DIE("","AMERDUR","ERROR")
  1.  ;
  1.  ;Log V PROVIDER entries
  1.  S PRMNRS=EDREF.PrmNurse
  1.  D PRV^BEDDUTIU(VIEN,AMERDA,PRMNRS)
  1.  ;
  1.  ;Log V POV entries
  1.  D POV^BEDDUTIU(VIEN,AMERDA)
  1.  ;
  1.  ;Log Consult Providers in V PROVIDER
  1.  D PCCPRV
  1.  ;
  1.  ;Log Procedure Providers in V PROVIDER
  1.  D PRPOV^BEDDUTIU(VIEN,AMERDA,.PRCPV)
  1.  ;
  1.  ;Log Compiled Fields
  1.  D COMP
  1.  ;
  1.  I EDREF.DCDocHSDt>0 D
  1.  . S EDREF.DCDocHEDt=$P($H,",",1),EDREF.DCDocHETm=$P($H,",",2)
  1.  S EDREF.AMERVSIT=AMERDA,EDREF.DCFlag=1
  1.  S STAT=EDREF.%Save()
  1.  S EDREF=""
  1.  ;
  1.  I STAT>1 S RSTAT="Y"
  1.  I STAT=0 S RSTAT="N"
  1.  ;
  1.  ;Save V EMERGENCY VISIT RECORD entry
  1.  D VERENTRY($G(AMERDA),$G(VIEN))
  1.  ;
  1.  ;Clear Room
  1.  D RMRMV^BEDDUTW(OBJID)
  1.  Q STAT
  1.  ;
  1. DCUPDATE(AMERVSIT,DCDT,DISP) ;Discharge Reversed DC
  1.  ;
  1.  NEW AMUPD,ERROR
  1.  ;
  1.  Q:AMERVSIT=""
  1.  ;
  1.  L +^AMERVSIT(AMERVSIT):30 I '$T Q
  1.  ;
  1.  S AMUPD(9009080,AMERVSIT_",",6.1)=DISP
  1.  S AMUPD(9009080,AMERVSIT_",",6.2)=DCDT
  1.  ;
  1.  I $D(AMUPD) D FILE^DIE("","AMUPD","ERROR")
  1.  ;
  1.  L -^AMERVSIT(AMERVSIT)
  1.  Q
  1.  ;
  1. CONSQRY ;Perform Query to Gather ED Consults and store in ^TMP("AMER
  1.  ;
  1.  NEW RS,STATUS
  1.  ;
  1.  S RS=##CLASS(%ResultSet).%New()
  1.  S RS.ClassName="BEDD.EDConsults"
  1.  S RS.QueryName="consPrint"
  1.  S STATUS=RS.Execute(OBJID)
  1.  ;
  1.  ;If none quit
  1.  I STATUS'=1 G XCONS
  1.  ;
  1.  NEW AMERNO
  1.  ;
  1.  S AMERNO=1
  1.  While RS.Next() {
  1.  NEW SERV
  1.  S SERV=RS.Data("ConsultSrv")
  1.  If SERV'="" D
  1.  . NEW %,%H,DTM,CPRV
  1.  . S ^TMP("AMER",$J,2,7,AMERNO,.01)=RS.Data("ConsultSrv")
  1.  . S %H=RS.Data("DateSeen")_","_RS.Data("TimeSeen") S:%H="," %H=""
  1.  . D YX^%DTC S DTM=X_% S:DTM="0" DTM=""
  1.  . S ^TMP("AMER",$J,2,7,AMERNO,.02)=DTM
  1.  . S CPRV=RS.Data("ConsultN")
  1.  . S ^TMP("AMER",$J,2,7,AMERNO,.03)=CPRV
  1.  . 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")
  1.  . S AMERNO=AMERNO+1
  1.  }
  1.  ;
  1. XCONS S RS=""
  1.  Q
  1.  ;
  1. PROCQ(PRCPV) ;Perform Query to Gather Procedures and store in ^TMP("AMER
  1.  ;
  1.  NEW RS,STATUS,AMERPROC,PRV
  1.  ;
  1.  S RS=##CLASS(%ResultSet).%New()
  1.  S RS.ClassName="BEDD.EDProc"
  1.  S RS.QueryName="procPrint"
  1.  S STATUS=RS.Execute(OBJID)
  1.  ;
  1.  ;Quit if no procedures
  1.  I STATUS'=1 G XPROCQ
  1.  ;
  1.  While RS.Next() {
  1.  ;
  1.  NEW BDT,BTM,EDT,ETM
  1.  S AMERPROC=RS.Data("EDProc")
  1.  S PRV=RS.Data("ProcStf")
  1.  S BDT=RS.Data("ProcDt")
  1.  S BTM=RS.Data("ProcSTm")
  1.  S EDT=RS.Data("ProcEDt")
  1.  S ETM=RS.Data("ProcETm")
  1.  I AMERPROC'="" S ^TMP("AMER",$J,2,10,AMERPROC)=AMERPROC_"^"_RS.Data("EDProcN")
  1.  ;
  1.  ;Track Procedure Provider Info
  1.  I PRV]"" S PRCPV(PRV)=BDT_U_BTM_U_EDT_U_ETM
  1.  }
  1. XPROCQ S RS=""
  1.  Q
  1.  ;
  1. DIAGQ ;EP - Perform Query to Gather Diagnosis and store in ^TMP("AMER
  1.  ;
  1.  ;BEDD v2.0;No longer pulling Dx from BEDD class
  1.  Q
  1.  NEW RS,STATUS,AMERDIAG,CNT,CODE,PRM,PCODE,NAR,PNAR,PFND
  1.  K DIAG
  1.  ;
  1.  S CNT=0,PCODE="",PNAR="",PFND=""
  1.  S RS=##CLASS(%ResultSet).%New()
  1.  S RS.ClassName="BEDD.EDDiagnosis"
  1.  S RS.QueryName="DXPrint"
  1.  S STATUS=RS.Execute(OBJID)
  1.  ;
  1.  ;Quit if no diagnosis
  1.  I STATUS'=1 S RS="" Q
  1.  ;
  1.  While RS.Next() {
  1. 	;
  1.  	S CIEN=RS.Data("CodeIEN")
  1.  	S PRM=RS.Data("PrimaryDiag")
  1.  	S NAR=RS.Data("DiagNarrative")
  1.  	S CODE=$$GET1^DIQ(80,CIEN_",",".01","I")
  1.  	;
  1.  	I ((PRM="YES")&(PFND="")) {
  1. 	 	S ^TMP("AMER",$J,2,11,.1)=CIEN_U_NAR_" ["_CODE_"]"
  1. 	 	S PFND=1
  1.  		}
  1.  	Else {
  1. 		S CNT=CNT+1
  1. 		S ^TMP("AMER",$J,2,11,CNT)=CIEN_U_NAR_" ["_CODE_"]"	
  1.  	}		
  1.  }
  1.  ;
  1. XDIAGQ S RS=""
  1.  Q
  1.  ;
  1. PCCPRV ;Log Consult Provider(s) in V PROVIDER file
  1.  ;
  1.  NEW RIEN,RIENI,VPROV
  1.  ;
  1.  I $D(^AUPNVPRV("AD",VIEN)) D
  1.  . ;
  1.  . ;Get list of existing entries
  1.  . S RIEN="" F  S RIEN=$O(^AUPNVPRV("AD",VIEN,RIEN)) Q:+RIEN=0  S VPROV($P(^AUPNVPRV(RIEN,0),"^",1))=""
  1.  ;
  1.  Q:$G(AMERDA)=""
  1.  Q:'$D(^AMERVSIT(AMERDA,19))
  1.  ;
  1.  S RIEN="" F  S RIEN=$O(^AMERVSIT(AMERDA,19,"B",RIEN)) Q:RIEN=""  D
  1.  . S RIENI="" F  S RIENI=$O(^AMERVSIT(AMERDA,19,"B",RIEN,RIENI)) Q:RIENI=""  D
  1.  .. ;
  1.  .. NEW RCP,RCDT,IENS,DA
  1.  .. ;
  1.  .. S DA(1)=AMERDA,DA=RIENI,IENS=$$IENS^DILF(.DA)
  1.  .. S RCP=$$GET1^DIQ(9009080.019,IENS,".03","I") Q:RCP=""  ;Cons
  1.  .. S RCDT=$$GET1^DIQ(9009080.019,IENS,".02","I") ;Cons Dtm
  1.  .. ;
  1.  .. I '$D(VPROV(RCP)) D
  1.  ... K DIC,DD,DO,DINUM,X,Y
  1.  ... S DIC="^AUPNVPRV(" S DIC(0)="XML" S X=RCP
  1.  ... S DIC("DR")=".02////"_DFN_";.03////"_VIEN_";.04////S;.05////C;1201////"_RCDT
  1.  ... D FILE^DICN
  1.  ... K DIC,DD,DO,DINUM
  1.  ... S VPROV(RCP)=""
  1.  ;
  1.  Q
  1.  ;
  1. COMP ;Process computed fields
  1.  ;
  1.  NEW AMERDR,AMERDFN,ADMDTM,VSIT,DTM,X,DIC,DD,DO,DIE,DA,DR
  1.  ;
  1.  S (AMERDR(2),AMERDR(12))=""
  1.  ;
  1.  ; REVOLVING DOOR
  1.  S AMERDFN=DFN
  1.  S ADMDTM=$$GET1^DIQ(9009080,AMERDA_",",".01","I")
  1.  ;
  1.  S DTM=0,VSIT="" F  S VSIT=$O(^AMERVSIT("AC",AMERDFN,VSIT)) Q:'VSIT  D
  1.  . ;
  1.  . NEW X
  1.  . S X=$$GET1^DIQ(9009080,VSIT_",",".01","I")
  1.  . I X>DTM,X'>ADMDTM S DTM=X
  1.  ;
  1.  I +DTM]"" D
  1.  . S DTM=$$DT^AMERSAV1(ADMDTM,DTM,"D")
  1.  . I DTM<366 S AMERDR(2)=AMERDR(2)_";8.2////"_DTM
  1.  ;
  1.  ;Injury transport lag
  1.  I $D(^AMERVSIT(AMERDA,3)) D
  1.  . NEW X
  1.  . S X=$$GET1^DIQ(9009080,VSIT_",","3.4","I")
  1.  . Q:'X
  1.  . S DTM=$$DT(ADMDTM,X,"M"),AMERDR(2)=AMERDR(2)_";8.1////"_DTM
  1.  ;
  1.  ;Doctor Wait
  1.  S X=$$GET1^DIQ(9009080,VSIT_",","12.1","I") I X D
  1.  . S DTM=$$DT(X,ADMDTM,"M"),AMERDR(12)=AMERDR(12)_";12.3////"_DTM
  1.  ;
  1.  ;Triage Nurse Wait
  1.  S X=$$GET1^DIQ(9009080,VSIT_",","12.2","I") I X D
  1.  . S DTM=$$DT^AMERSAV1(X,ADMDTM,"M"),AMERDR(12)=AMERDR(12)_";12.4////"_DTM
  1.  ;
  1.  ;Visit Duration
  1.  S X=$$GET1^DIQ(9009080,VSIT_",","6.2","I") I X D
  1.  . S DTM=$$DT^AMERSAV1(X,ADMDTM,"M"),AMERDR(12)=AMERDR(12)_";12.5////"_DTM
  1.  ;
  1.  S DIE="^AMERVSIT(" S DA=AMERDA
  1.  S DR=$P(AMERDR(2),";",2,99)
  1.  D ^DIE
  1.  S DR=$P(AMERDR(12),";",2,99)
  1.  D ^DIE
  1.  Q
  1.  ;
  1. VERENTRY(AMERDFN,AMERPCC) ;Create V EMERGENCY VISIT RECORD entry
  1.  ;
  1.  ;BEDD*2.0*1;Updated to call new AMER update call
  1.  D VER^AMERVER($G(AMERDFN),$G(AMERPCC))
  1.  Q
  1.  ;
  1.  Q:$G(AMERPCC)=""
  1.  Q:$D(^AUPNVER("AD",AMERPCC))
  1.  ;
  1.  NEW IACT,URG,DCDT,MOT,MOA,ENTBY,DISP,DSP,DIC,DD,DO,DINUM,X,Y
  1.  ;
  1.  ;Urgency
  1.  S IACT=$$GET1^DIQ(9009080,AMERDA_",",".24","I"),URG=$S(IACT=1:"E",((IACT=2)!(IACT=3)):"U",1:"N")
  1.  ;
  1.  ;Departure Date/Time
  1.  S DCDT=$$GET1^DIQ(9009080,AMERDA_",","6.2","I")
  1.  ;
  1.  ;Method of Transport
  1.  S ENTBY="",MOA="",MOT=$$GET1^DIQ(9009080,AMERDA_",",".25","I") I MOT'="" D
  1.  . ;
  1.  . ;Means of Arrival
  1.  . S MOT=$$GET1^DIQ(9009083,MOT_",",".01","I")
  1.  . I MOT["WALK" S MOA="W"
  1.  . I MOT["AMBULANCE" S MOA="A"
  1.  . S:MOA="" MOA="O"
  1.  . ;
  1.  . ;Entered ER By
  1.  . I MOT["AMBULANCE" S ENTBY="A"
  1.  . I MOT["WHEEL" S ENTBY="W"
  1.  . I MOT["STRET"  S ENTBY="S"
  1.  ;
  1.  S DIS="",DISP=$$GET1^DIQ(9009080,AMERDA_",","6.1","I") I DISP'="" D
  1.  . S DISP=$$GET1^DIQ(9009083,DISP_",",".01","I")
  1.  . I DISP["HOME" S DIS="D"
  1.  . I DISP["TRANS" S DIS="T"
  1.  . I DISP["ADMIT" S DIS="A"
  1.  . I DISP["LEFT" S DIS="O"
  1.  . I DISP["REGIS" S DIS="O"
  1.  . I DISP["EXPIRED" S DIS="E"
  1.  . I DISP["DEA" S DIS="E"
  1.  ;
  1.  ;File entry
  1.  K DIC,DD,DO,DINUM,X
  1.  S DIC="^AUPNVER(" S DIC(0)="XML" S X="IHS-114 ER"
  1.  S DIC("DR")=".02////"_DFN_";.03////"_AMERPCC_";.04////"_URG_";.05////"_MOA_";.07////"_ENTBY_";.11////"_DIS_";.13////"_DCDT
  1.  D FILE^DICN
  1.  ;
  1.  S $P(^AUPNVER(+Y,0),"^",12)=$E(DISP,1,20)
  1.  K DIC,DD,DO,DINUM,X
  1.  Q
  1.  ;
  1. DT(X,Y,T) ;EP - Calculate Time Difference
  1.  ;
  1.  NEW %,A,B,C,E,%T,%H,%Y
  1.  ;
  1.  I '$G(X)!('$G(Y)) Q ""
  1.  I $G(T)="" S T="M"
  1.  D H^%DTC S A=+%H,B=%T,X=Y
  1.  D H^%DTC S C=+%H,E=%T
  1.  I E>B S B=B+86400,A=A-1
  1.  S %=((A-C)*86400)+(B-E)
  1.  I T="M" S %=%\60
  1.  E  S %=%\86400
  1.  Q %
  1.  ;
  1. PRCNT(OBJID,RET,PROC) ;Get count of procedures for visit
  1.  ;
  1.  ;Input:
  1.  ; OBJID - Pointer to BEDD.EDVISIT entry
  1.  ; RET (Optional) - Whether to return list (1/"")
  1.  ;
  1.  ;Output:
  1.  ; total current procedure entries
  1.  ; PROC Array (Optional) - List of procedure entries
  1.  ;
  1.  NEW RS,STATUS,AMERPROC,CNT,XPROC
  1.  K PROC
  1.  ;
  1.  S RET=$G(RET,"")
  1.  S CNT=0,PROC=0
  1.  S RS=##CLASS(%ResultSet).%New()
  1.  S RS.ClassName="BEDD.EDProc"
  1.  S RS.QueryName="procPrint"
  1.  S STATUS=RS.Execute(OBJID)
  1.  ;
  1.  ;Quit if no procedures
  1.  I STATUS'=1 S RS="" Q 0
  1.  ;
  1.  While RS.Next() {
  1.  ;
  1.  S AMERPROC=RS.Data("EDProc")
  1.  	If (AMERPROC'="") {
  1. 		S CNT=CNT+1
  1. 	 	If (RET=1) {
  1. 		 	S XPROC=$$GET1^DIQ(9009083,AMERPROC_",",".01","I") Q:XPROC=""
  1. 	 		S PROC=PROC+1
  1. 	 		S PROC(CNT)=XPROC
  1. 		}
  1. 	 }
  1.  }
  1. XPRCNT S RS=""
  1.  Q CNT
  1.  ;
  1. EDCNT(OBJID,RET,CONS) ;Get count of ED Consults for visit
  1.  ;
  1.  ;Input:
  1.  ; OBJID - Pointer to BEDD.EDVISIT entry
  1.  ; RET (Optional) - Whether to return list (1/"")
  1.  ;
  1.  ;Output:
  1.  ; total current ED Consults entries
  1.  ; CONS Array (Optional) - List of ED Consults
  1.  ;
  1.  NEW RS,STATUS,AMERED,CNT,COTY,CDATE,CTIME,CNS
  1.  K CONS
  1.  ;
  1.  S RET=$G(RET,"")
  1.  S CNT=0,CONS=0
  1.  S RS=##CLASS(%ResultSet).%New()
  1.  S RS.ClassName="BEDD.EDConsults"
  1.  S RS.QueryName="consPrint"
  1.  S STATUS=RS.Execute(OBJID)
  1.  ;
  1.  ;Quit if no procedures
  1.  I STATUS'=1 S RS="" Q 0
  1.  ;
  1.  While RS.Next() {
  1.  ;
  1.  S AMERED=RS.Data("ConsultSrv")
  1.  	If (AMERED'="") {
  1. 	 	S CNT=CNT+1
  1. 	 	If (RET=1) {
  1. 		 	S COTY=$$GET1^DIQ(9009082.9,AMERED_",",".01","I") Q:COTY=""
  1. 		 	S CDATE=RS.Data("DateSeen")
  1. 		 	S CTIME=RS.Data("TimeSeen")
  1. 		 	S CDATE=$TR($$HTE^XLFDT(CDATE_","_CTIME,"5"),"@"," ")
  1. 		 	S CNS=RS.Data("ConsultN")
  1. 		 	;I CNS]"" S CNS=$$GET1^DIQ(200,CNS_",",".01","I")
  1. 		 	S CONS=CONS+1
  1. 		 	S CONS(CONS)=COTY_"^"_CDATE_"^"_CNS 
  1. 	 	}
  1.  	}	
  1.  }
  1. XEDCNT S RS=""
  1.  Q CNT
  1.  ;
  1. DXCNT(OBJID,RET,DIAG,PRIME) ;Get count of diagnosis for visit
  1.  ;
  1.  ;Input:
  1.  ; OBJID - Pointer to BEDD.EDVISIT entry
  1.  ; RET (Optional) - Whether to return list (1/"")
  1.  ; PRIME (Optional) - Whether to return the Prime Code IEN (1/"")
  1.  ;
  1.  ;Output:
  1.  ; total current DIAG entries
  1.  ; DIAG Array (Optional) - List of diagnosis entries
  1.  ;
  1.  NEW BEDD,VIEN,AMERPOV,CNT,PCODE,PNARR,X,PIEN
  1.  ;
  1.  ;Make sure needed values are defined
  1.  S X="S:$G(U)="""" U=""""" X X
  1.  S X="S:$G(DT)="""" DT=$$DT^XLFDT" X X
  1.  ;
  1.  S BEDD=##CLASS(BEDD.EDVISIT).%OpenId(OBJID)
  1.  ;
  1.  ;Get Visit IEN and date
  1.  S VIEN=BEDD.VIEN I VIEN="" Q 0
  1.  S (BEDD,PCODE,PNAR,PIEN)="",DIAG=0
  1.  ;
  1.  ;Get V POV information
  1.  D POV^AMERUTIL("",VIEN,.AMERPOV)
  1.  ;
  1.  S CNT="" F  S CNT=$O(AMERPOV(CNT)) Q:CNT=""  D
  1.  . NEW CODE,PRM,NARR,ICDIEN
  1.  . S CODE=$P(AMERPOV(CNT),"^")
  1.  . S PRM=$P(AMERPOV(CNT),"^",2) S PRM=$S(PRM="P":"YES",1:"NO")
  1.  . S NARR=$P(AMERPOV(CNT),"^",3)
  1.  . S ICDIEN=$P(AMERPOV(CNT),"^",4)
  1.  . S DIAG=DIAG+1
  1.  . S DIAG(DIAG)=CODE_U_NARR_U_PRM
  1.  . I PRM="YES" S PCODE=CODE,PNAR=NARR,PIEN=ICDIEN
  1.  ;
  1.  ;Save Prime Code at top level
  1.  If $G(PRIME)=1 S DIAG=DIAG_"^"_PCODE_"^"_PNAR_"^"_PIEN
  1.  ;
  1.  Q DIAG