BEDDUTIU ;VNGT/HS/BEE-BEDD Utility Routine 3 ; 08 Nov 2011 12:00 PM
;;2.0;BEDD DASHBOARD;;Jun 04, 2014;Build 13
;
Q
;
LOG(DUZ,AMCAT,AMACT,AMCALL,AMDESC,AMERVDFN) ;EP - File entry into BUSA
;
NEW X
;Make sure initial variables are set
S X="S:$G(U)="""" U=""^""" X X
S X="S:$G(DT)="""" DT=$$DT^XLFDT" X X
;
;Define DUZ variable
I $G(DUZ)="" Q
D DUZ^XUP(DUZ)
;
;Log the entry
D LOG^AMERBUSA($G(AMCAT),$G(AMACT),$G(AMCALL),$G(AMDESC),.AMERVDFN)
;
Q
;
ICAU(ICAU) ;EP - Return List of Injury Causes
;
;Input:
; None
;
;Output:
; ICAU Array - List of Injury Causes
;
NEW CIEN,CTIEN,CNT
K ICAU
S CTIEN=$O(^AMER(2,"B","CAUSE OF INJURY","")) Q:CTIEN=""
S CNT=0,CIEN="" F S CIEN=$O(^AMER(3,"AC",CTIEN,CIEN)) Q:+CIEN=0 D
. S CNT=CNT+1
. S ICAU(CNT)=CIEN_"^"_$$GET1^DIQ(9009083,CIEN_",",".01","I")
Q
;
SCEN(SCEN) ;EP - Return List of Injury Setting
;
;Input:
; None
;
;Output:
; SCEN Array - List of Injury Settings
;
NEW SIEN,STIEN,CNT
K SCEN
S STIEN=$O(^AMER(2,"B","SCENE OF INJURY","")) Q:STIEN=""
S CNT=0,SIEN="" F S SIEN=$O(^AMER(3,"AC",STIEN,SIEN)) Q:+SIEN=0 D
. S CNT=CNT+1
. S SCEN(CNT)=SIEN_"^"_$$GET1^DIQ(9009083,SIEN_",",".01","I")
Q
;
SAFE(SAFE) ;EP - Return List of Safety Measures
;
;Input:
; None
;
;Output:
; SAFE Array - List of Safety Measures
;
NEW SIEN,STIEN,CNT
K SAFE
S STIEN=$O(^AMER(2,"B","SAFETY EQUIPMENT","")) Q:STIEN=""
S CNT=0,SIEN="" F S SIEN=$O(^AMER(3,"AC",STIEN,SIEN)) Q:+SIEN=0 D
. S CNT=CNT+1
. S SAFE(CNT)=SIEN_"^"_$$GET1^DIQ(9009083,SIEN_",",".01","I")
Q
;
CONS(CONS) ;EP - Return List of Consult Types
;
;Input:
; None
;
;Output:
; CONS Array - List of Consult Types
;
NEW CIEN,CTTYP,CNT
K CONS
S CNT=0,CTTYP="" F S CTTYP=$O(^AMER(2.9,"B",CTTYP)) Q:CTTYP="" D
. S CIEN="" F S CIEN=$O(^AMER(2.9,"B",CTTYP,CIEN)) Q:CIEN="" D
.. S CNT=CNT+1
.. S CONS(CNT)=CIEN_"^"_CTTYP
Q
;
PROC(PROC) ;EP - Return List of ER Procedures
;
;Input:
; None
;
;Output:
; PROC Array - List of ER Procedures
;
NEW PIEN,PCIEN,CNT,PRC
K PROC
S PCIEN=$O(^AMER(2,"B","ER PROCEDURES","")) Q:PCIEN=""
S PIEN="" F S PIEN=$O(^AMER(3,"AC",PCIEN,PIEN)) Q:+PIEN=0 D
. S PRC=$$GET1^DIQ(9009083,PIEN_",",".01","I") Q:PRC=""
. S PRC(PRC)=PIEN_"^"_PRC
;
S CNT=0,PRC="" F S PRC=$O(PRC(PRC)) Q:PRC="" D
. S CNT=CNT+1
. S PROC(CNT)=PRC(PRC)
Q
;
VTYP(VTYP) ;EP - Return List of ER Visit Types
;
;Input:
; None
;
;Output:
; VTYP Array - List of ER Visit Types
;
NEW VIEN,VTIEN,CNT,VTY
K VTYP
S VTIEN=$O(^AMER(2,"B","VISIT TYPE","")) Q:VTIEN=""
S VIEN="" F S VIEN=$O(^AMER(3,"AC",VTIEN,VIEN)) Q:+VIEN=0 D
. S VTY=$$GET1^DIQ(9009083,VIEN_",",".01","I") Q:VTY=""
. S VTY(VTY)=VIEN_"^"_VTY
;
S CNT=0,VTY="" F S VTY=$O(VTY(VTY)) Q:VTY="" D
. S CNT=CNT+1
. S VTYP(CNT)=VTY(VTY)
Q
;
TFRM(TFRM) ;EP - Return List of Transfer From Values
;
;Input:
; None
;
;Output:
; TFRM Array - List of Transfer From Values
;
NEW TIEN,CNT,TFR,TFIEN
K TFRM
S CNT=0,TFIEN="" F S TFIEN=$O(^AMER(2.1,"B",TFIEN)) Q:TFIEN="" D
. S TIEN="" F S TIEN=$O(^AMER(2.1,"B",TFIEN,TIEN)) Q:+TIEN=0 D
.. S CNT=CNT+1,TFRM(CNT)=TIEN_"^"_TFIEN
Q
;
;
MTRN(MTRN) ;EP - Return Mode of Transport List
;
;Input:
; None
;
;Output:
; MTRN Array - List of Mode of Transport Entries
;
NEW MIEN,MTIEN,CNT,MTR
K MTRN
S MTIEN=$O(^AMER(2,"B","TRANSFER DETAILS","")) Q:MTIEN=""
S MIEN="" F S MIEN=$O(^AMER(3,"AC",MTIEN,MIEN)) Q:+MIEN=0 D
. S MTR=$$GET1^DIQ(9009083,MIEN_",",".01","I") Q:MTR=""
. S MTR(MTR)=MIEN_"^"_MTR
;
S CNT=0,MTR="" F S MTR=$O(MTR(MTR)) Q:MTR="" D
. S CNT=CNT+1
. S MTRN(CNT)=MTR(MTR)
Q
;
ACMP(ACMP) ;EP - Return Ambulance Company Name List
;
;Input:
; None
;
;Output:
; ACMP Array - List of Ambulance Company Names
;
NEW AIEN,ACIEN,CNT,ACN
K ACMP
S ACIEN=$O(^AMER(2,"B","AMBULANCE COMPANY","")) Q:ACIEN=""
S AIEN="" F S AIEN=$O(^AMER(3,"AC",ACIEN,AIEN)) Q:+AIEN=0 D
. S ACN=$$GET1^DIQ(9009083,AIEN_",",".01","I") Q:ACN=""
. S ACN(ACN)=AIEN_"^"_ACN
;
S CNT=0,ACN="" F S ACN=$O(ACN(ACN)) Q:ACN="" D
. S CNT=CNT+1
. S ACMP(CNT)=ACN(ACN)
Q
;
DEVLST(DEVICE) ;EP - Return List of Devices
;
K DEVICE
;
D DEVICE^CIAVUTIO(.DEVICE,"",1,"500")
;
Q
;
ADMDTM(DFN) ;EP - Return Current Admission Date/Time
Q $$FMTE^BEDDUTIL($$GET1^DIQ(9009081,DFN_",",1,"I"))
;
ADMCMP(DFN) ;EP - Return Presenting Complaint
Q $$GET1^DIQ(9009081,DFN_",",8,"I")
;
ADMVTP(DFN) ;EP - Return Admission Visit Type
Q $$GET1^DIQ(9009081,DFN_",",3,"I")
;
ADMTRN(DFN) ;EP - Return Admission Transferred
Q $$GET1^DIQ(9009081,DFN_",",2.1,"I")
;
ADMFTRN(DFN) ;EP - Return Admission Transferred From
Q $$GET1^DIQ(9009081,DFN_",",2.2,"I")
;
ADMMOT(DFN) ;EP - Return Admission Mode of Transport
Q $$GET1^DIQ(9009081,DFN_",",2.3,"I")
;
ADMMAT(DFN) ;EP - Return Admission Medical Attendant Present
Q $$GET1^DIQ(9009081,DFN_",",2.4,"I")
;
ADMAMN(DFN) ;EP - Return Admission Ambulance Number
Q $$GET1^DIQ(9009081,DFN_",",12,"I")
;
ADMAMB(DFN) ;EP - Return Admission Ambulance Billing
Q $$GET1^DIQ(9009081,DFN_",",13,"I")
;
ADMAMC(DFN) ;EP - Return Admission Ambulance Company
Q $$GET1^DIQ(9009081,DFN_",",15,"I")
;
ADMCHK(DFN) ;EP - Determine if patient is already admitted
;
I $G(DFN)="" Q ""
I $D(^AMERADM("B",DFN)) Q 1
Q ""
;
CLIN(CLIN) ;EP - Return Clinic ^AMER(3) ien
;
;Convert clinic file 40.7 pointer to ^AMER(3) pointer
I CLIN="" Q ""
;
S CLIN=$$GET1^DIQ(40.7,CLIN_",",1,"I") Q:CLIN="" ""
;
S CLIN=$O(^AMER(3,"B",CLIN,""))
Q CLIN
;
PRV(VIEN,AMERDA,PRMNRS) ;EP - Log ER VISIT Provider entries in V PROVIDER
;
I $G(VIEN)="" Q
I $G(AMERDA)="" Q
;
S PRMNRS=$G(PRMNRS,"")
;
NEW VPROV,PIEN,PRV,PS,PDT
;
;Get a list of current providers for visit
I $D(^AUPNVPRV("AD",VIEN)) D
. ;
. ;Get list of existing entries
. S PIEN="" F S PIEN=$O(^AUPNVPRV("AD",VIEN,PIEN)) Q:+PIEN=0 S VPROV($P(^AUPNVPRV(PIEN,0),"^",1))=""
;
;Retrieve Patient
S DFN=$$GET1^DIQ(9009080,AMERDA_",",".02","I")
;
;Discharge Provider
S PRV=$$GET1^DIQ(9009080,AMERDA_",","6.3","I")
S PDT=$$GET1^DIQ(9009080,AMERDA_",","6.2","I")
S PS="P"
I PRV]"",'$D(VPROV(PRV)) D SPRV(DFN,VIEN,PRV,PDT,PS) S VPROV(PRV)=""
;
;Admitting Provider
S PRV=$$GET1^DIQ(9009080,AMERDA_",",".06","I")
S PDT=$$GET1^DIQ(9009080,AMERDA_",","12.1","I")
S PS="S"
I PRV]"",'$D(VPROV(PRV)) D SPRV(DFN,VIEN,PRV,PDT,PS) S VPROV(PRV)=""
;
;Triage Nurse
S PRV=$$GET1^DIQ(9009080,AMERDA_",",".07","I")
S PDT=$$GET1^DIQ(9009080,AMERDA_",","12.2","I")
S PS="S"
I PRV]"",'$D(VPROV(PRV)) D SPRV(DFN,VIEN,PRV,PDT,PS) S VPROV(PRV)=""
;
;Discharge Nurse
S PRV=$$GET1^DIQ(9009080,AMERDA_",","6.4","I")
S PDT=$$GET1^DIQ(9009080,AMERDA_",","6.2","I")
S PS="S"
I PRV]"",'$D(VPROV(PRV)) D SPRV(DFN,VIEN,PRV,PDT,PS) S VPROV(PRV)=""
;
;Primary Nurse
S PRV=PRMNRS
S PDT=$$GET1^DIQ(9009080,AMERDA_",","6.2","I")
S PS="S"
I PRV]"",'$D(VPROV(PRV)) D SPRV(DFN,VIEN,PRV,PDT,PS) S VPROV(PRV)=""
;
Q
;
PRPOV(VIEN,AMERDA,PRPOV) ;EP - Log ER Procedure providers entries in V PROVIDER
;
I $G(VIEN)="" Q
I $G(AMERDA)="" Q
;
NEW VPROV,PIEN,PRV,PS,PDT
;
;Get a list of current providers for visit
I $D(^AUPNVPRV("AD",VIEN)) D
. ;
. ;Get list of existing entries
. S PIEN="" F S PIEN=$O(^AUPNVPRV("AD",VIEN,PIEN)) Q:+PIEN=0 S VPROV($P(^AUPNVPRV(PIEN,0),"^",1))=""
;
;Retrieve Patient
S DFN=$$GET1^DIQ(9009080,AMERDA_",",".02","I")
;
S PRV="" F S PRV=$O(PRPOV(PRV)) Q:PRV="" D
. ;
. ;First Try Proc Beg Dt/Tm
. S PDT=$P(PRPOV(PRV),U)_","_$P(PRPOV(PRV),U,2)
. ;
. ;Then Try Proc End Dt/Tm
. I $TR(PDT,",")="" S PDT=$P(PRPOV(PRV),U,3)_","_$P(PRPOV(PRV),U,4)
. I $TR(PDT,",")]"" S PDT=$$HTFM^XLFDT(PDT)
. ;
. ;Then Try Admit Dt/Tm
. I $TR(PDT,",")="" S PDT=$$GET1^DIQ(9009080,AMERDA_",",".01","I")
. ;
. S PS="S"
. ;
. ;See if already logged
. I PRV]"",'$D(VPROV(PRV)) D SPRV(DFN,VIEN,PRV,PDT,PS) S VPROV(PRV)=""
Q
;
SPRV(DFN,VIEN,PRV,VDT,PS) ;EP - Log the Provider in V PROVIDER
;
NEW DIC,DD,DO,DINUM,X,Y
K DD,DO,DINUM
S DIC="^AUPNVPRV(" S DIC(0)="XML" S X=PRV
S DIC("DR")=".02////"_DFN_";.03////"_VIEN_";.04////"_PS_";1201////"_VDT
D FILE^DICN
K DD,DO,DINUM
;
Q
;
POV(VIEN,AMERDA) ;EP - Log ER VISIT Provider entries in V POV
;
I $G(VIEN)="" Q
I $G(AMERDA)="" Q
;
NEW VPOV,PIEN,POV,PS,DIEN
;
;Get a list of current providers for visit
I $D(^AUPNVPOV("AD",VIEN)) D
. ;
. ;Get list of existing entries
. S PIEN="" F S PIEN=$O(^AUPNVPOV("AD",VIEN,PIEN)) Q:+PIEN=0 S VPOV($P(^AUPNVPOV(PIEN,0),"^",1))=""
;
;Retrieve Patient
S DFN=$$GET1^DIQ(9009080,AMERDA_",",".02","I")
;
;Pull Prime DX Info
S POV=$$GET1^DIQ(9009080,AMERDA_",","5.2","I")
S PNAR=$$GET1^DIQ(9009080,AMERDA_",","5.3","I")
S:PNAR="" PNAR=$$GET1^DIQ(80,POV_",",".01","E")
S VDT=$$GET1^DIQ(9009080,AMERDA_",",".01","I")
I POV]"",'$D(VPOV(POV)) D SPOV(DFN,VIEN,POV,PNAR,VDT,"P") S VPOV(POV)=""
;
;Now loop through list and process remaining DX's
S DIEN=0 F S DIEN=$O(^AMERVSIT(AMERDA,5,DIEN)) Q:'DIEN D
. ;
. NEW DA,IENS,POV,PNAR
. S DA(1)=AMERDA,DA=DIEN,IENS=$$IENS^DILF(.DA)
. S POV=$$GET1^DIQ(9009080.05,IENS,".01","I") Q:POV=""
. Q:$D(VPOV(POV))
. S PNAR=$$GET1^DIQ(9009080.05,IENS,"1","I")
. D SPOV(DFN,VIEN,POV,PNAR,VDT,"S") S VPOV(POV)=""
;
Q
;
SPOV(DFN,VIEN,POV,PNAR,VDT,PS) ;EP - Log the Provider in V PROVIDER
;
NEW DIC,DD,DO,DINUM,X,Y,NIEN
;
;First Log Narrative Entry
S NIEN=$$NARR(PNAR)
;
K DD,DO,DINUM
S DIC="^AUPNVPOV(" S DIC(0)="XML" S X=POV
S DIC("DR")=".02////"_DFN_";.03////"_VIEN_";.04////"_NIEN_";.12////"_PS_";1201////"_VDT
;
D FILE^DICN
K DD,DO,DINUM
;
Q
;
NARR(NAR) ;EP - Get Provider Narrative IEN
;
;RETURN THE IEN OF A PROVIDER NARRATIVE ENTRY - IF NECESSARY CREAT THE ENTRY
;
I $G(NAR)="" Q ""
;
NEW DIC,DLAYGO,X,Y
S X=NAR
S (DIC,DLAYGO)=9999999.27,DIC(0)="LX"
D ^DIC I Y=-1 Q ""
Q +Y
;
DTCMP(DATE,ADJ) ;EP - Add or subtract days from supplied date
;
;Input:
; DATE (Optional) - Date to add or subtract from (if blank DT is used)
; ADJ - Number of days to add or subtract
;
NEW X1,X2,X,%H
;
S DATE=$G(DATE,"") S:DATE="" DATE=$$DT^XLFDT
S ADJ=+$G(ADJ)
S X1=DATE,X2=ADJ D C^%DTC
Q X
;
DTCHK(DATE,ADMDT,CHK,BGDT) ;EP - Date checking function
;
;Input:
; DATE - Date to be checked
; ADMDT (Optional) - The admit date to check against
; CHK - The type of checks to perform
; "F" - No future dates
; "A" - Must be after admit date
; "P" - Must be prior to admit date
; "B" - Check to make sure DATE is after BGDT
; BGDT (Optional) - The beginning date to check against
;
NEW CDT
;
S DATE=$G(DATE,"") I DATE="" Q "DATE"
S ADMDT=$G(ADMDT,"")
S BGDT=$G(BGDT,"")
S CHK=$G(CHK,"") I CHK="" Q "DATE"
;
S DATE=$$DATE^BEDDUTIU(DATE)
S ADMDT=$$DATE^BEDDUTIU(ADMDT)
S BGDT=$$DATE^BEDDUTIU(BGDT)
;
;Get current date time
S CDT=$$FNOW^BEDDUTIL()
;
;Future date check
I CHK["F",DATE>CDT Q "F"
;
;Admit date check
I CHK["A",ADMDT>0,ADMDT>DATE Q "A"
;
I CHK["P",ADMDT>0,DATE>ADMDT Q "P"
;
I CHK["B",BGDT>0,BGDT>DATE Q "B"
;
Q "DATE"
;
DATE(X) ;EP - Convert External Date to FileMan
;
NEW %DT,Y
;
S X=$TR(X," ","@")
S %DT="T" D ^%DT
S:Y=-1 Y=""
;
Q Y
;
ASAVE(DUZ,ADM) ;EP - Admit a Patient to the ER
;Not Implemented
Q 1
;;
;;Input:
;; DUZ - User DUZ
;; ADM Array - Array containing Admission Information
;;
;Set up complete DUZ
;D DUZ^XUP(DUZ)
;;
;NEW AMERVER,AMERSVER,DFN,DOB,AMERDFN,SAVE
;;
;S AMERVER=$$VERSION^XPDUTL("AMER")
;S AMERSVER=$$VERSION^XPDUTL("PIMS")
;;
;Reset Admission Scratch Global
;K ^TMP("AMER",$J)
;;
;DFN
;S (AMERDFN,DFN)=$G(ADM("DFN"))
;S ^TMP("AMER",$J,1,1)=$G(ADM("DFN"))
;;
;DOB
;S DOB=$$GET1^DIQ(2,DFN_",",.03,"I")
;;
;Admission Date/Time
;S ^TMP("AMER",$J,1,2)=$G(ADM("ADMDTTM"))
;;
;Presenting Complaint
;S ^TMP("AMER",$J,1,3)=$G(ADM("COMP"))
;;
;Visit Type
;I $G(ADM("VTYPE"))]"" D
;. NEW VTYPE
;. S VTYPE=$$GET1^DIQ(9009083,ADM("VTYPE")_",",.01,"I")
;. S ^TMP("AMER",$J,1,5)=ADM("VTYPE")_"^"_VTYPE
;;
;;Transfered
;I $G(ADM("TRAN"))]"" S ^TMP("AMER",$J,1,6)=ADM("TRAN")
;;
;;Transfer From
;I $G(ADM("TFROM"))]"" D
;. NEW TFROM
;. S TFROM=$$GET1^DIQ(9009082.1,ADM("TFROM")_",",.01,"I")
;. S ^TMP("AMER",$J,1,7)=ADM("TFROM")_"^"_TFROM
;;
;;Medical Attendant Present
;I $G(ADM("MATT"))]"" S ^TMP("AMER",$J,1,9)=ADM("MATT")
;;
;;Mode of Transport
;I $G(ADM("MTRAN"))]"" D
;. NEW MTRAN
;. S MTRAN=$$GET1^DIQ(9009083,ADM("MTRAN")_",",.01,"I")
;. S ^TMP("AMER",$J,1,10)=ADM("MTRAN")_"^"_MTRAN
;;
;;Ambulance Number
;S ^TMP("AMER",$J,1,11)=$G(ADM("ANUM"))
;;
;;Ambulance Billing
;S ^TMP("AMER",$J,1,12)=$G(ADM("ABILL"))
;;
;;Ambulance Company
;I $G(ADM("ACMP"))]"" D
;. NEW ACMP
;. S ACMP=$$GET1^DIQ(9009083,ADM("ACMP")_",",.01,"I")
;. S ^TMP("AMER",$J,1,14)=ADM("ACMP")_"^"_ACMP
;;
;;Complete Admission
;;S SAVE=$$ADMIT^AMERBEDD(DFN)
;;
Q 1
;
ERR ;EP - Capture the error
D ^%ZTER
Q
BEDDUTIU ;VNGT/HS/BEE-BEDD Utility Routine 3 ; 08 Nov 2011 12:00 PM
+1 ;;2.0;BEDD DASHBOARD;;Jun 04, 2014;Build 13
+2 ;
+3 QUIT
+4 ;
LOG(DUZ,AMCAT,AMACT,AMCALL,AMDESC,AMERVDFN) ;EP - File entry into BUSA
+1 ;
+2 NEW X
+3 ;Make sure initial variables are set
+4 SET X="S:$G(U)="""" U=""^"""
XECUTE X
+5 SET X="S:$G(DT)="""" DT=$$DT^XLFDT"
XECUTE X
+6 ;
+7 ;Define DUZ variable
+8 IF $GET(DUZ)=""
QUIT
+9 DO DUZ^XUP(DUZ)
+10 ;
+11 ;Log the entry
+12 DO LOG^AMERBUSA($GET(AMCAT),$GET(AMACT),$GET(AMCALL),$GET(AMDESC),.AMERVDFN)
+13 ;
+14 QUIT
+15 ;
ICAU(ICAU) ;EP - Return List of Injury Causes
+1 ;
+2 ;Input:
+3 ; None
+4 ;
+5 ;Output:
+6 ; ICAU Array - List of Injury Causes
+7 ;
+8 NEW CIEN,CTIEN,CNT
+9 KILL ICAU
+10 SET CTIEN=$ORDER(^AMER(2,"B","CAUSE OF INJURY",""))
IF CTIEN=""
QUIT
+11 SET CNT=0
SET CIEN=""
FOR
SET CIEN=$ORDER(^AMER(3,"AC",CTIEN,CIEN))
IF +CIEN=0
QUIT
Begin DoDot:1
+12 SET CNT=CNT+1
+13 SET ICAU(CNT)=CIEN_"^"_$$GET1^DIQ(9009083,CIEN_",",".01","I")
End DoDot:1
+14 QUIT
+15 ;
SCEN(SCEN) ;EP - Return List of Injury Setting
+1 ;
+2 ;Input:
+3 ; None
+4 ;
+5 ;Output:
+6 ; SCEN Array - List of Injury Settings
+7 ;
+8 NEW SIEN,STIEN,CNT
+9 KILL SCEN
+10 SET STIEN=$ORDER(^AMER(2,"B","SCENE OF INJURY",""))
IF STIEN=""
QUIT
+11 SET CNT=0
SET SIEN=""
FOR
SET SIEN=$ORDER(^AMER(3,"AC",STIEN,SIEN))
IF +SIEN=0
QUIT
Begin DoDot:1
+12 SET CNT=CNT+1
+13 SET SCEN(CNT)=SIEN_"^"_$$GET1^DIQ(9009083,SIEN_",",".01","I")
End DoDot:1
+14 QUIT
+15 ;
SAFE(SAFE) ;EP - Return List of Safety Measures
+1 ;
+2 ;Input:
+3 ; None
+4 ;
+5 ;Output:
+6 ; SAFE Array - List of Safety Measures
+7 ;
+8 NEW SIEN,STIEN,CNT
+9 KILL SAFE
+10 SET STIEN=$ORDER(^AMER(2,"B","SAFETY EQUIPMENT",""))
IF STIEN=""
QUIT
+11 SET CNT=0
SET SIEN=""
FOR
SET SIEN=$ORDER(^AMER(3,"AC",STIEN,SIEN))
IF +SIEN=0
QUIT
Begin DoDot:1
+12 SET CNT=CNT+1
+13 SET SAFE(CNT)=SIEN_"^"_$$GET1^DIQ(9009083,SIEN_",",".01","I")
End DoDot:1
+14 QUIT
+15 ;
CONS(CONS) ;EP - Return List of Consult Types
+1 ;
+2 ;Input:
+3 ; None
+4 ;
+5 ;Output:
+6 ; CONS Array - List of Consult Types
+7 ;
+8 NEW CIEN,CTTYP,CNT
+9 KILL CONS
+10 SET CNT=0
SET CTTYP=""
FOR
SET CTTYP=$ORDER(^AMER(2.9,"B",CTTYP))
IF CTTYP=""
QUIT
Begin DoDot:1
+11 SET CIEN=""
FOR
SET CIEN=$ORDER(^AMER(2.9,"B",CTTYP,CIEN))
IF CIEN=""
QUIT
Begin DoDot:2
+12 SET CNT=CNT+1
+13 SET CONS(CNT)=CIEN_"^"_CTTYP
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
PROC(PROC) ;EP - Return List of ER Procedures
+1 ;
+2 ;Input:
+3 ; None
+4 ;
+5 ;Output:
+6 ; PROC Array - List of ER Procedures
+7 ;
+8 NEW PIEN,PCIEN,CNT,PRC
+9 KILL PROC
+10 SET PCIEN=$ORDER(^AMER(2,"B","ER PROCEDURES",""))
IF PCIEN=""
QUIT
+11 SET PIEN=""
FOR
SET PIEN=$ORDER(^AMER(3,"AC",PCIEN,PIEN))
IF +PIEN=0
QUIT
Begin DoDot:1
+12 SET PRC=$$GET1^DIQ(9009083,PIEN_",",".01","I")
IF PRC=""
QUIT
+13 SET PRC(PRC)=PIEN_"^"_PRC
End DoDot:1
+14 ;
+15 SET CNT=0
SET PRC=""
FOR
SET PRC=$ORDER(PRC(PRC))
IF PRC=""
QUIT
Begin DoDot:1
+16 SET CNT=CNT+1
+17 SET PROC(CNT)=PRC(PRC)
End DoDot:1
+18 QUIT
+19 ;
VTYP(VTYP) ;EP - Return List of ER Visit Types
+1 ;
+2 ;Input:
+3 ; None
+4 ;
+5 ;Output:
+6 ; VTYP Array - List of ER Visit Types
+7 ;
+8 NEW VIEN,VTIEN,CNT,VTY
+9 KILL VTYP
+10 SET VTIEN=$ORDER(^AMER(2,"B","VISIT TYPE",""))
IF VTIEN=""
QUIT
+11 SET VIEN=""
FOR
SET VIEN=$ORDER(^AMER(3,"AC",VTIEN,VIEN))
IF +VIEN=0
QUIT
Begin DoDot:1
+12 SET VTY=$$GET1^DIQ(9009083,VIEN_",",".01","I")
IF VTY=""
QUIT
+13 SET VTY(VTY)=VIEN_"^"_VTY
End DoDot:1
+14 ;
+15 SET CNT=0
SET VTY=""
FOR
SET VTY=$ORDER(VTY(VTY))
IF VTY=""
QUIT
Begin DoDot:1
+16 SET CNT=CNT+1
+17 SET VTYP(CNT)=VTY(VTY)
End DoDot:1
+18 QUIT
+19 ;
TFRM(TFRM) ;EP - Return List of Transfer From Values
+1 ;
+2 ;Input:
+3 ; None
+4 ;
+5 ;Output:
+6 ; TFRM Array - List of Transfer From Values
+7 ;
+8 NEW TIEN,CNT,TFR,TFIEN
+9 KILL TFRM
+10 SET CNT=0
SET TFIEN=""
FOR
SET TFIEN=$ORDER(^AMER(2.1,"B",TFIEN))
IF TFIEN=""
QUIT
Begin DoDot:1
+11 SET TIEN=""
FOR
SET TIEN=$ORDER(^AMER(2.1,"B",TFIEN,TIEN))
IF +TIEN=0
QUIT
Begin DoDot:2
+12 SET CNT=CNT+1
SET TFRM(CNT)=TIEN_"^"_TFIEN
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
+15 ;
MTRN(MTRN) ;EP - Return Mode of Transport List
+1 ;
+2 ;Input:
+3 ; None
+4 ;
+5 ;Output:
+6 ; MTRN Array - List of Mode of Transport Entries
+7 ;
+8 NEW MIEN,MTIEN,CNT,MTR
+9 KILL MTRN
+10 SET MTIEN=$ORDER(^AMER(2,"B","TRANSFER DETAILS",""))
IF MTIEN=""
QUIT
+11 SET MIEN=""
FOR
SET MIEN=$ORDER(^AMER(3,"AC",MTIEN,MIEN))
IF +MIEN=0
QUIT
Begin DoDot:1
+12 SET MTR=$$GET1^DIQ(9009083,MIEN_",",".01","I")
IF MTR=""
QUIT
+13 SET MTR(MTR)=MIEN_"^"_MTR
End DoDot:1
+14 ;
+15 SET CNT=0
SET MTR=""
FOR
SET MTR=$ORDER(MTR(MTR))
IF MTR=""
QUIT
Begin DoDot:1
+16 SET CNT=CNT+1
+17 SET MTRN(CNT)=MTR(MTR)
End DoDot:1
+18 QUIT
+19 ;
ACMP(ACMP) ;EP - Return Ambulance Company Name List
+1 ;
+2 ;Input:
+3 ; None
+4 ;
+5 ;Output:
+6 ; ACMP Array - List of Ambulance Company Names
+7 ;
+8 NEW AIEN,ACIEN,CNT,ACN
+9 KILL ACMP
+10 SET ACIEN=$ORDER(^AMER(2,"B","AMBULANCE COMPANY",""))
IF ACIEN=""
QUIT
+11 SET AIEN=""
FOR
SET AIEN=$ORDER(^AMER(3,"AC",ACIEN,AIEN))
IF +AIEN=0
QUIT
Begin DoDot:1
+12 SET ACN=$$GET1^DIQ(9009083,AIEN_",",".01","I")
IF ACN=""
QUIT
+13 SET ACN(ACN)=AIEN_"^"_ACN
End DoDot:1
+14 ;
+15 SET CNT=0
SET ACN=""
FOR
SET ACN=$ORDER(ACN(ACN))
IF ACN=""
QUIT
Begin DoDot:1
+16 SET CNT=CNT+1
+17 SET ACMP(CNT)=ACN(ACN)
End DoDot:1
+18 QUIT
+19 ;
DEVLST(DEVICE) ;EP - Return List of Devices
+1 ;
+2 KILL DEVICE
+3 ;
+4 DO DEVICE^CIAVUTIO(.DEVICE,"",1,"500")
+5 ;
+6 QUIT
+7 ;
ADMDTM(DFN) ;EP - Return Current Admission Date/Time
+1 QUIT $$FMTE^BEDDUTIL($$GET1^DIQ(9009081,DFN_",",1,"I"))
+2 ;
ADMCMP(DFN) ;EP - Return Presenting Complaint
+1 QUIT $$GET1^DIQ(9009081,DFN_",",8,"I")
+2 ;
ADMVTP(DFN) ;EP - Return Admission Visit Type
+1 QUIT $$GET1^DIQ(9009081,DFN_",",3,"I")
+2 ;
ADMTRN(DFN) ;EP - Return Admission Transferred
+1 QUIT $$GET1^DIQ(9009081,DFN_",",2.1,"I")
+2 ;
ADMFTRN(DFN) ;EP - Return Admission Transferred From
+1 QUIT $$GET1^DIQ(9009081,DFN_",",2.2,"I")
+2 ;
ADMMOT(DFN) ;EP - Return Admission Mode of Transport
+1 QUIT $$GET1^DIQ(9009081,DFN_",",2.3,"I")
+2 ;
ADMMAT(DFN) ;EP - Return Admission Medical Attendant Present
+1 QUIT $$GET1^DIQ(9009081,DFN_",",2.4,"I")
+2 ;
ADMAMN(DFN) ;EP - Return Admission Ambulance Number
+1 QUIT $$GET1^DIQ(9009081,DFN_",",12,"I")
+2 ;
ADMAMB(DFN) ;EP - Return Admission Ambulance Billing
+1 QUIT $$GET1^DIQ(9009081,DFN_",",13,"I")
+2 ;
ADMAMC(DFN) ;EP - Return Admission Ambulance Company
+1 QUIT $$GET1^DIQ(9009081,DFN_",",15,"I")
+2 ;
ADMCHK(DFN) ;EP - Determine if patient is already admitted
+1 ;
+2 IF $GET(DFN)=""
QUIT ""
+3 IF $DATA(^AMERADM("B",DFN))
QUIT 1
+4 QUIT ""
+5 ;
CLIN(CLIN) ;EP - Return Clinic ^AMER(3) ien
+1 ;
+2 ;Convert clinic file 40.7 pointer to ^AMER(3) pointer
+3 IF CLIN=""
QUIT ""
+4 ;
+5 SET CLIN=$$GET1^DIQ(40.7,CLIN_",",1,"I")
IF CLIN=""
QUIT ""
+6 ;
+7 SET CLIN=$ORDER(^AMER(3,"B",CLIN,""))
+8 QUIT CLIN
+9 ;
PRV(VIEN,AMERDA,PRMNRS) ;EP - Log ER VISIT Provider entries in V PROVIDER
+1 ;
+2 IF $GET(VIEN)=""
QUIT
+3 IF $GET(AMERDA)=""
QUIT
+4 ;
+5 SET PRMNRS=$GET(PRMNRS,"")
+6 ;
+7 NEW VPROV,PIEN,PRV,PS,PDT
+8 ;
+9 ;Get a list of current providers for visit
+10 IF $DATA(^AUPNVPRV("AD",VIEN))
Begin DoDot:1
+11 ;
+12 ;Get list of existing entries
+13 SET PIEN=""
FOR
SET PIEN=$ORDER(^AUPNVPRV("AD",VIEN,PIEN))
IF +PIEN=0
QUIT
SET VPROV($PIECE(^AUPNVPRV(PIEN,0),"^",1))=""
End DoDot:1
+14 ;
+15 ;Retrieve Patient
+16 SET DFN=$$GET1^DIQ(9009080,AMERDA_",",".02","I")
+17 ;
+18 ;Discharge Provider
+19 SET PRV=$$GET1^DIQ(9009080,AMERDA_",","6.3","I")
+20 SET PDT=$$GET1^DIQ(9009080,AMERDA_",","6.2","I")
+21 SET PS="P"
+22 IF PRV]""
IF '$DATA(VPROV(PRV))
DO SPRV(DFN,VIEN,PRV,PDT,PS)
SET VPROV(PRV)=""
+23 ;
+24 ;Admitting Provider
+25 SET PRV=$$GET1^DIQ(9009080,AMERDA_",",".06","I")
+26 SET PDT=$$GET1^DIQ(9009080,AMERDA_",","12.1","I")
+27 SET PS="S"
+28 IF PRV]""
IF '$DATA(VPROV(PRV))
DO SPRV(DFN,VIEN,PRV,PDT,PS)
SET VPROV(PRV)=""
+29 ;
+30 ;Triage Nurse
+31 SET PRV=$$GET1^DIQ(9009080,AMERDA_",",".07","I")
+32 SET PDT=$$GET1^DIQ(9009080,AMERDA_",","12.2","I")
+33 SET PS="S"
+34 IF PRV]""
IF '$DATA(VPROV(PRV))
DO SPRV(DFN,VIEN,PRV,PDT,PS)
SET VPROV(PRV)=""
+35 ;
+36 ;Discharge Nurse
+37 SET PRV=$$GET1^DIQ(9009080,AMERDA_",","6.4","I")
+38 SET PDT=$$GET1^DIQ(9009080,AMERDA_",","6.2","I")
+39 SET PS="S"
+40 IF PRV]""
IF '$DATA(VPROV(PRV))
DO SPRV(DFN,VIEN,PRV,PDT,PS)
SET VPROV(PRV)=""
+41 ;
+42 ;Primary Nurse
+43 SET PRV=PRMNRS
+44 SET PDT=$$GET1^DIQ(9009080,AMERDA_",","6.2","I")
+45 SET PS="S"
+46 IF PRV]""
IF '$DATA(VPROV(PRV))
DO SPRV(DFN,VIEN,PRV,PDT,PS)
SET VPROV(PRV)=""
+47 ;
+48 QUIT
+49 ;
PRPOV(VIEN,AMERDA,PRPOV) ;EP - Log ER Procedure providers entries in V PROVIDER
+1 ;
+2 IF $GET(VIEN)=""
QUIT
+3 IF $GET(AMERDA)=""
QUIT
+4 ;
+5 NEW VPROV,PIEN,PRV,PS,PDT
+6 ;
+7 ;Get a list of current providers for visit
+8 IF $DATA(^AUPNVPRV("AD",VIEN))
Begin DoDot:1
+9 ;
+10 ;Get list of existing entries
+11 SET PIEN=""
FOR
SET PIEN=$ORDER(^AUPNVPRV("AD",VIEN,PIEN))
IF +PIEN=0
QUIT
SET VPROV($PIECE(^AUPNVPRV(PIEN,0),"^",1))=""
End DoDot:1
+12 ;
+13 ;Retrieve Patient
+14 SET DFN=$$GET1^DIQ(9009080,AMERDA_",",".02","I")
+15 ;
+16 SET PRV=""
FOR
SET PRV=$ORDER(PRPOV(PRV))
IF PRV=""
QUIT
Begin DoDot:1
+17 ;
+18 ;First Try Proc Beg Dt/Tm
+19 SET PDT=$PIECE(PRPOV(PRV),U)_","_$PIECE(PRPOV(PRV),U,2)
+20 ;
+21 ;Then Try Proc End Dt/Tm
+22 IF $TRANSLATE(PDT,",")=""
SET PDT=$PIECE(PRPOV(PRV),U,3)_","_$PIECE(PRPOV(PRV),U,4)
+23 IF $TRANSLATE(PDT,",")]""
SET PDT=$$HTFM^XLFDT(PDT)
+24 ;
+25 ;Then Try Admit Dt/Tm
+26 IF $TRANSLATE(PDT,",")=""
SET PDT=$$GET1^DIQ(9009080,AMERDA_",",".01","I")
+27 ;
+28 SET PS="S"
+29 ;
+30 ;See if already logged
+31 IF PRV]""
IF '$DATA(VPROV(PRV))
DO SPRV(DFN,VIEN,PRV,PDT,PS)
SET VPROV(PRV)=""
End DoDot:1
+32 QUIT
+33 ;
SPRV(DFN,VIEN,PRV,VDT,PS) ;EP - Log the Provider in V PROVIDER
+1 ;
+2 NEW DIC,DD,DO,DINUM,X,Y
+3 KILL DD,DO,DINUM
+4 SET DIC="^AUPNVPRV("
SET DIC(0)="XML"
SET X=PRV
+5 SET DIC("DR")=".02////"_DFN_";.03////"_VIEN_";.04////"_PS_";1201////"_VDT
+6 DO FILE^DICN
+7 KILL DD,DO,DINUM
+8 ;
+9 QUIT
+10 ;
POV(VIEN,AMERDA) ;EP - Log ER VISIT Provider entries in V POV
+1 ;
+2 IF $GET(VIEN)=""
QUIT
+3 IF $GET(AMERDA)=""
QUIT
+4 ;
+5 NEW VPOV,PIEN,POV,PS,DIEN
+6 ;
+7 ;Get a list of current providers for visit
+8 IF $DATA(^AUPNVPOV("AD",VIEN))
Begin DoDot:1
+9 ;
+10 ;Get list of existing entries
+11 SET PIEN=""
FOR
SET PIEN=$ORDER(^AUPNVPOV("AD",VIEN,PIEN))
IF +PIEN=0
QUIT
SET VPOV($PIECE(^AUPNVPOV(PIEN,0),"^",1))=""
End DoDot:1
+12 ;
+13 ;Retrieve Patient
+14 SET DFN=$$GET1^DIQ(9009080,AMERDA_",",".02","I")
+15 ;
+16 ;Pull Prime DX Info
+17 SET POV=$$GET1^DIQ(9009080,AMERDA_",","5.2","I")
+18 SET PNAR=$$GET1^DIQ(9009080,AMERDA_",","5.3","I")
+19 IF PNAR=""
SET PNAR=$$GET1^DIQ(80,POV_",",".01","E")
+20 SET VDT=$$GET1^DIQ(9009080,AMERDA_",",".01","I")
+21 IF POV]""
IF '$DATA(VPOV(POV))
DO SPOV(DFN,VIEN,POV,PNAR,VDT,"P")
SET VPOV(POV)=""
+22 ;
+23 ;Now loop through list and process remaining DX's
+24 SET DIEN=0
FOR
SET DIEN=$ORDER(^AMERVSIT(AMERDA,5,DIEN))
IF 'DIEN
QUIT
Begin DoDot:1
+25 ;
+26 NEW DA,IENS,POV,PNAR
+27 SET DA(1)=AMERDA
SET DA=DIEN
SET IENS=$$IENS^DILF(.DA)
+28 SET POV=$$GET1^DIQ(9009080.05,IENS,".01","I")
IF POV=""
QUIT
+29 IF $DATA(VPOV(POV))
QUIT
+30 SET PNAR=$$GET1^DIQ(9009080.05,IENS,"1","I")
+31 DO SPOV(DFN,VIEN,POV,PNAR,VDT,"S")
SET VPOV(POV)=""
End DoDot:1
+32 ;
+33 QUIT
+34 ;
SPOV(DFN,VIEN,POV,PNAR,VDT,PS) ;EP - Log the Provider in V PROVIDER
+1 ;
+2 NEW DIC,DD,DO,DINUM,X,Y,NIEN
+3 ;
+4 ;First Log Narrative Entry
+5 SET NIEN=$$NARR(PNAR)
+6 ;
+7 KILL DD,DO,DINUM
+8 SET DIC="^AUPNVPOV("
SET DIC(0)="XML"
SET X=POV
+9 SET DIC("DR")=".02////"_DFN_";.03////"_VIEN_";.04////"_NIEN_";.12////"_PS_";1201////"_VDT
+10 ;
+11 DO FILE^DICN
+12 KILL DD,DO,DINUM
+13 ;
+14 QUIT
+15 ;
NARR(NAR) ;EP - Get Provider Narrative IEN
+1 ;
+2 ;RETURN THE IEN OF A PROVIDER NARRATIVE ENTRY - IF NECESSARY CREAT THE ENTRY
+3 ;
+4 IF $GET(NAR)=""
QUIT ""
+5 ;
+6 NEW DIC,DLAYGO,X,Y
+7 SET X=NAR
+8 SET (DIC,DLAYGO)=9999999.27
SET DIC(0)="LX"
+9 DO ^DIC
IF Y=-1
QUIT ""
+10 QUIT +Y
+11 ;
DTCMP(DATE,ADJ) ;EP - Add or subtract days from supplied date
+1 ;
+2 ;Input:
+3 ; DATE (Optional) - Date to add or subtract from (if blank DT is used)
+4 ; ADJ - Number of days to add or subtract
+5 ;
+6 NEW X1,X2,X,%H
+7 ;
+8 SET DATE=$GET(DATE,"")
IF DATE=""
SET DATE=$$DT^XLFDT
+9 SET ADJ=+$GET(ADJ)
+10 SET X1=DATE
SET X2=ADJ
DO C^%DTC
+11 QUIT X
+12 ;
DTCHK(DATE,ADMDT,CHK,BGDT) ;EP - Date checking function
+1 ;
+2 ;Input:
+3 ; DATE - Date to be checked
+4 ; ADMDT (Optional) - The admit date to check against
+5 ; CHK - The type of checks to perform
+6 ; "F" - No future dates
+7 ; "A" - Must be after admit date
+8 ; "P" - Must be prior to admit date
+9 ; "B" - Check to make sure DATE is after BGDT
+10 ; BGDT (Optional) - The beginning date to check against
+11 ;
+12 NEW CDT
+13 ;
+14 SET DATE=$GET(DATE,"")
IF DATE=""
QUIT "DATE"
+15 SET ADMDT=$GET(ADMDT,"")
+16 SET BGDT=$GET(BGDT,"")
+17 SET CHK=$GET(CHK,"")
IF CHK=""
QUIT "DATE"
+18 ;
+19 SET DATE=$$DATE^BEDDUTIU(DATE)
+20 SET ADMDT=$$DATE^BEDDUTIU(ADMDT)
+21 SET BGDT=$$DATE^BEDDUTIU(BGDT)
+22 ;
+23 ;Get current date time
+24 SET CDT=$$FNOW^BEDDUTIL()
+25 ;
+26 ;Future date check
+27 IF CHK["F"
IF DATE>CDT
QUIT "F"
+28 ;
+29 ;Admit date check
+30 IF CHK["A"
IF ADMDT>0
IF ADMDT>DATE
QUIT "A"
+31 ;
+32 IF CHK["P"
IF ADMDT>0
IF DATE>ADMDT
QUIT "P"
+33 ;
+34 IF CHK["B"
IF BGDT>0
IF BGDT>DATE
QUIT "B"
+35 ;
+36 QUIT "DATE"
+37 ;
DATE(X) ;EP - Convert External Date to FileMan
+1 ;
+2 NEW %DT,Y
+3 ;
+4 SET X=$TRANSLATE(X," ","@")
+5 SET %DT="T"
DO ^%DT
+6 IF Y=-1
SET Y=""
+7 ;
+8 QUIT Y
+9 ;
ASAVE(DUZ,ADM) ;EP - Admit a Patient to the ER
+1 ;Not Implemented
+2 QUIT 1
+3 ;;
+4 ;;Input:
+5 ;; DUZ - User DUZ
+6 ;; ADM Array - Array containing Admission Information
+7 ;;
+8 ;Set up complete DUZ
+9 ;D DUZ^XUP(DUZ)
+10 ;;
+11 ;NEW AMERVER,AMERSVER,DFN,DOB,AMERDFN,SAVE
+12 ;;
+13 ;S AMERVER=$$VERSION^XPDUTL("AMER")
+14 ;S AMERSVER=$$VERSION^XPDUTL("PIMS")
+15 ;;
+16 ;Reset Admission Scratch Global
+17 ;K ^TMP("AMER",$J)
+18 ;;
+19 ;DFN
+20 ;S (AMERDFN,DFN)=$G(ADM("DFN"))
+21 ;S ^TMP("AMER",$J,1,1)=$G(ADM("DFN"))
+22 ;;
+23 ;DOB
+24 ;S DOB=$$GET1^DIQ(2,DFN_",",.03,"I")
+25 ;;
+26 ;Admission Date/Time
+27 ;S ^TMP("AMER",$J,1,2)=$G(ADM("ADMDTTM"))
+28 ;;
+29 ;Presenting Complaint
+30 ;S ^TMP("AMER",$J,1,3)=$G(ADM("COMP"))
+31 ;;
+32 ;Visit Type
+33 ;I $G(ADM("VTYPE"))]"" D
+34 ;. NEW VTYPE
+35 ;. S VTYPE=$$GET1^DIQ(9009083,ADM("VTYPE")_",",.01,"I")
+36 ;. S ^TMP("AMER",$J,1,5)=ADM("VTYPE")_"^"_VTYPE
+37 ;;
+38 ;;Transfered
+39 ;I $G(ADM("TRAN"))]"" S ^TMP("AMER",$J,1,6)=ADM("TRAN")
+40 ;;
+41 ;;Transfer From
+42 ;I $G(ADM("TFROM"))]"" D
+43 ;. NEW TFROM
+44 ;. S TFROM=$$GET1^DIQ(9009082.1,ADM("TFROM")_",",.01,"I")
+45 ;. S ^TMP("AMER",$J,1,7)=ADM("TFROM")_"^"_TFROM
+46 ;;
+47 ;;Medical Attendant Present
+48 ;I $G(ADM("MATT"))]"" S ^TMP("AMER",$J,1,9)=ADM("MATT")
+49 ;;
+50 ;;Mode of Transport
+51 ;I $G(ADM("MTRAN"))]"" D
+52 ;. NEW MTRAN
+53 ;. S MTRAN=$$GET1^DIQ(9009083,ADM("MTRAN")_",",.01,"I")
+54 ;. S ^TMP("AMER",$J,1,10)=ADM("MTRAN")_"^"_MTRAN
+55 ;;
+56 ;;Ambulance Number
+57 ;S ^TMP("AMER",$J,1,11)=$G(ADM("ANUM"))
+58 ;;
+59 ;;Ambulance Billing
+60 ;S ^TMP("AMER",$J,1,12)=$G(ADM("ABILL"))
+61 ;;
+62 ;;Ambulance Company
+63 ;I $G(ADM("ACMP"))]"" D
+64 ;. NEW ACMP
+65 ;. S ACMP=$$GET1^DIQ(9009083,ADM("ACMP")_",",.01,"I")
+66 ;. S ^TMP("AMER",$J,1,14)=ADM("ACMP")_"^"_ACMP
+67 ;;
+68 ;;Complete Admission
+69 ;;S SAVE=$$ADMIT^AMERBEDD(DFN)
+70 ;;
+71 QUIT 1
+72 ;
ERR ;EP - Capture the error
+1 DO ^%ZTER
+2 QUIT
