AMERBSDU ; IHS/OIT/SCR - PRIMARY ROUTINE FOR INTERFACE WITH PIMS OUTSIDE OF AMER NAMESPACE
;;3.0;ER VISIT SYSTEM;**1,2,5**;MAR 03, 2009;Build 14
;
APPNTMNT(AMERDFN,AMERTALK,AMERTIME,AMERARR) ; EP FROM AMER1 and ERCHECKIN
; called by AMER1 to display scheduled appoitments for all clinics from day of admission forward
; called by ERCHEKIN to populate array of scheduled appointments for further refinement
;
; AMERTALK=1 means display results to current device
; AMERTALK=0 means be silent
; AMERTIME = DATE/TIME OF ER ADMISSION
; AMERARR = "AMERARR(" -->PASSED BY REFERENCE - DATA IS RETURNED IN ARRAY AMERARR(
; array(2-9999)=date^clinic name^other info
; AMERARR="" NO ARRAY IS POPULATED
;
NEW AMERLN,AMERDT,AMERCNT,X,I,AMERNODE,AMERSP
S AMERSP=$S(AMERTALK:" ",1:U) ;data item separator
S AMERCNT=1,AMERDT=$P(AMERTIME,".",1) ;start with day of appointment
F S AMERDT=$O(^DPT(AMERDFN,"S",AMERDT)) Q:'AMERDT D
.S AMERNODE=$G(^DPT(AMERDFN,"S",AMERDT,0)) Q:'AMERNODE
.Q:$P(AMERNODE,U,2)["C" ;skip if canceled
.I $P(AMERNODE,U,2)["N",$P(AMERNODE,U,2)'="NT" Q ;skip if no-show
.; if lab, x-ray or ekg appts set, display first
.F I=3,4,5 S X=$P(AMERNODE,U,I) Q:X["" D
..S AMERCNT=AMERCNT+1
..S AMERLN(AMERCNT)=$$FMTE^XLFDT(X)_AMERSP_$P("LAB^X-RAY^EKG",U,I-2)
.; then display this appt
.S AMERCNT=$G(AMERCNT)+1
.S X=$$FMTE^XLFDT(AMERDT)_AMERSP_$$GET1^DIQ(44,+AMERNODE,.01)
.S AMERLN(AMERCNT)=$$PAD(X,43)_AMERSP_$E($$OI^BSDU2(AMERDFN,+AMERNODE,AMERDT),1,34)
.S AMERLN(AMERCNT,0)=+AMERNODE
I AMERCNT>1 D
.S AMERLN(1,"F")="!!?20",AMERLN(1)="**** APPOINTMENTS FROM TODAY FORWARD ****"
.F I=1:1:AMERCNT S AMERLN(AMERCNT,"F")="!"
E S AMERLN(1)="No Pending Appointments",AMERLN(1,"F")="!"
I $G(AMERTALK) D EN^DDIOL(.AMERLN) ;print to current device
;return data in array
I $D(AMERARR) D
.NEW %X,%Y
.S %X="AMERLN(",%Y=AMERARR
.D %XY^%RCR
Q
;
GETAPPS(AMERDFN,AMERTIME,AMERARR) ;
;This sub-routine GETS any ER appointmentS for this patient on the day of the ER VISIT
;If an appointment exists (that has not been canceled)
;
;RETURNS AMERARR - AN ARRAY OF ER APPOINTMENTS FOR THIS DFN ON THE DATE OF AMERTIME
; PASSED BY VALUE AND POPULATED UPON RETURN
;
;array(2-9999)=date^clinic name^other info^isCheckedIn
;
;INPUT: AMERDFN - THE PATIENT WHO'S APPOINTMENTS ARE BEING LOOKED UP
; AMERTIME : THE DATE/TIME OF THE ER VISIT
;
;
N AMERCNT,AMERSDTM,AMERSDCL,AMERLOC,AMERQUIT,AMERCNT2,AMERSCIE
S AMERCNT=0,AMERQUIT=0
D APPNTMNT^AMERBSDU(AMERDFN,0,AMERTIME,.AMERARR)
I $G(AMERARR(2))'="" D ;THERE ARE SCHEDULED VISITS FOR THIS PATIENT - NOW FIND OUT IF ONE OF THEM IS FOR TODAY AT THIS CLINIC
.S AMERCNT=1,AMERCNT2=0
.F S AMERCNT=$O(AMERARR(AMERCNT)) Q:AMERCNT="" D
..S AMERSDCL=$G(AMERARR(AMERCNT,0)) ;SCHEDULED CLINIC
..S AMERLOC=$G(^AMER(2.5,+$G(DUZ(2)),"SD")) ;THIS IS A POINTER TO THE HOSPITAL LOCATION FILE THAT IDENTIFIES THE ERS CLINIC
..Q:AMERLOC=""
..I AMERLOC=AMERSDCL D ;IF THE SCHEDULED CLINIC IS THE CLINIC THAT IS RUNNING THIS PACKAGE
...S AMERSDTM=$P(AMERARR(AMERCNT),U,1) ;SCHEDULED TIME
...S %DT="T",X=AMERSDTM D ^%DT S AMERSDTM=Y K %DT ;SCHEDULED TIME IN FM FORMAT
...S AMERSCIE=$$SCIEN^BSDU2(AMERDFN,AMERSDCL,AMERSDTM) ;get schedule ien
...;S $P(AMERRARR(AMERCNT),U,4)=$$CI^BSDU2(AMERDFN,AMERSDCL,AMERSDTM,AMERSCIE) ;find out if patient is checked in
...S $P(AMERARR(AMERCNT),U,4)=$$CI^BSDU2(AMERDFN,AMERSDCL,AMERSDTM,AMERSCIE) ;find out if patient is checked in
...I $P(AMERSDTM,".",1)=$P(AMERTIME,".",1) D ;IF THE APPOINTMENT IS FOR SOME TIME of the day of admission...
....S AMERCNT2=AMERCNT2+1
....D EN^DDIOL("***THIS PATIENT HAS AN APPOINTMENT IN THIS CLINIC TODAY***","","!?4")
....D EN^DDIOL($P(AMERARR(AMERCNT),U,2)_" FOR : "_$P(AMERARR(AMERCNT),U,1),"","!?10")
....Q
...I $P(AMERSDTM,".",1)'=$P(AMERTIME,".",1) S AMERRARR(AMERCNT)="" ;IF THE APPOINTMENT IS NOT FOR TODAY, REMOVE FROM ARRAY
...Q
..I AMERLOC'=AMERSDCL S AMERARR(AMERCNT)=""
..Q
.Q
Q
ERCHCKIN(AMERDFN,AMERTIME) ; EP FROM AMER0 after admission information has been collected
; INPUT: AMERDFN - PATIENT IEN OF PATIENT BEING CHECKED INTO SCHEDULING
; AMERTIME - TIME OF ADMISSION COLLECTED FROM ERS INTERFACE
;
; RETURNS: AMERPCC - THE IEN OF THE PCC VISIT FILE THAT WAS CREATED FOR THIS APPOINTMENT
N AMERARR,AMERNUM,AMERPCC,AMERANS,DIR,Y,AMERSDTM,AMERDONE,X
S AMERPCC=0,AMERDONE=0
S AMERARR="AMERARR("
D GETAPPS(AMERDFN,AMERTIME,.AMERARR) ; THIS RETURNS AN ARRAY OF APPOINMENTS for this date
;AMERARR(2-9999)=date^clinic name^other info^isCheckedIn
S AMERNUM=0,AMERNUM=$O(AMERARR(0))
;ASK A USER TO SELECT ONE OF THE TIMES IN THE ARRAY
F Q:AMERNUM=""!(AMERPCC'=0) D
.S AMERNUM=$O(AMERARR(AMERNUM))
.Q:AMERNUM=""
.I $G(AMERARR(AMERNUM))'="" D
..D EN^DDIOL("PATIENT IS SCHEDULED FOR: "_$P(AMERARR(AMERNUM),U,1),"","!!")
..I $P(AMERARR(AMERNUM),U,2)'="" D EN^DDIOL("OTHER INFO: : "_$P(AMERARR(AMERNUM),U,3),"","!")
..;IHS/OIT/SCR 05/21/09 don't ask to check in unless ER Visit day is same as scheduled day
..S X=$P($P(AMERARR(AMERNUM),U,1),"@",1)
..D ^%DT
..Q:Y'=$P(AMERTIME,".",1)
..S DIR("A")="Check-in to this scheduled visit"
..S DIR(0)="Y",DIR("B")="NO"
..D ^DIR
..S AMERANS=Y
..I AMERANS=1 D
...S %DT="T",X=$P(AMERARR(AMERNUM),U,1) D ^%DT S AMERSDTM=Y K %DT ;PUT SCHEDULED TIME IN FM FORMAT
...S AMERPCC=$$SCHEDULD^AMERPCC(AMERDFN,AMERTIME,AMERSDTM)
...I +AMERPCC>0 D
....D EN^DDIOL("CREATED PCC VISIT "_AMERPCC_" FOR ER APPOINTMENT : "_$P(AMERARR(AMERNUM),U,1),"","!!")
....D EN^AMERCLP(AMERDFN)
....D RTNGSLP^AMERVSIT(AMERDFN,AMERTIME)
....Q
...I +AMERPCC<0 D
....;D EN^DDIOL("THERE WAS A PROBLEM WITH THE ER - PIMS INTERFACE","","!") ;IHS/OIT/SCR 060109 removed patch 1
....;D EN^DDIOL($P(AMERPCC,U,2),"","!")
....;D EN^DDIOL("NO PCC VISIT CREATED","","!")
....H 2
....Q
..I AMERANS'=1 D
...D EN^DDIOL("BY-PASSING THIS APPOINTMENT: "_$P(AMERARR(AMERNUM),U,1),"","!!")
..Q
.Q
I AMERPCC=0 D ;NO ER APPOINTMENT WAS SELECTED FOR CHECK-IN
.S AMERPCC=$$VISIT^AMERPCC(AMERDFN,AMERTIME) ;CREATES AND CHECKS-IN A WALK-IN VISIT FOR THIS TIM
.I $P(AMERPCC,U,1)>0 D
..D EN^AMERCLP(AMERDFN)
..D RTNGSLP^AMERVSIT(AMERDFN,AMERTIME)
..Q
.I $P(AMERPCC,U,1)<0 D
..;D EN^DDIOL("THERE WAS A PROBLEM WITH THE ER - PIMS INTERFACE","","!")
..D EN^DDIOL($P(AMERPCC,U,2),"","!")
..;D EN^DDIOL("NO PCC VISIT CREATED","","!")
..H 2
..Q
.Q
Q +AMERPCC
PAD(D,L) ;localcopy of BSDU2^PAD
; -- D=data L=length
Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
CANCEL(AMERDFN,AMERTIME) ;EP FROM
;IHS/OIT/SCR 10/27/08 CANCEL PIMS SCHEDULED ER VISIT WHEN THE VISIT IS DELETED
; Make call using: S ERR=$$CANCEL^BSDAPI(.ARRAY)
;
; Input Array -
; BSDR("PAT") = ien of patient in file 2
; BSDR("CLN") = ien of clinic in file 44
; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
; BSDR("ADT") = appointment date and time
; BSDR("CDT") = cancel date and time
; BSDR("USR") = user who canceled appt
; BSDR("CR") = cancel reason - pointer to file 409.2
; BSDR("NOT") = cancel remarks - optional notes to 160 characters
;
;Output: error status and message
; = 0 or null: everything okay
N AMERBSDR,AMERINDX,%
S AMERBSDR("PAT")=AMERDFN
S AMERCLN=$G(^AMER(2.5,DUZ(2),"SD"))
S AMERBSDR("CLN")=AMERCLN
S AMERBSDR("TYP")="C"
S AMERBSDR("ADT")=AMERTIME
D NOW^%DTC
S AMERBSDR("CDT")=%
S AMERBSDR("USR")=DUZ
S DIC="^SD(409.2,",DIC(0)="XZ",X="OTHER"
D ^DIC
S AMERBSDR("CR")=+Y
S AMERBSDR("NOT")="PATIENT REGISTERED IN ERROR THROUGH ERS"
S AMERERR=$$CANCEL^BSDAPI(.AMERBSDR)
D:AMERERR EN^DDIOL("UNABLE TO CANCEL THE SCHEDULED PIMS APPOINTMENT!","","!")
Q
AMERBSDU ; IHS/OIT/SCR - PRIMARY ROUTINE FOR INTERFACE WITH PIMS OUTSIDE OF AMER NAMESPACE
+1 ;;3.0;ER VISIT SYSTEM;**1,2,5**;MAR 03, 2009;Build 14
+2 ;
APPNTMNT(AMERDFN,AMERTALK,AMERTIME,AMERARR) ; EP FROM AMER1 and ERCHECKIN
+1 ; called by AMER1 to display scheduled appoitments for all clinics from day of admission forward
+2 ; called by ERCHEKIN to populate array of scheduled appointments for further refinement
+3 ;
+4 ; AMERTALK=1 means display results to current device
+5 ; AMERTALK=0 means be silent
+6 ; AMERTIME = DATE/TIME OF ER ADMISSION
+7 ; AMERARR = "AMERARR(" -->PASSED BY REFERENCE - DATA IS RETURNED IN ARRAY AMERARR(
+8 ; array(2-9999)=date^clinic name^other info
+9 ; AMERARR="" NO ARRAY IS POPULATED
+10 ;
+11 NEW AMERLN,AMERDT,AMERCNT,X,I,AMERNODE,AMERSP
+12 ;data item separator
SET AMERSP=$SELECT(AMERTALK:" ",1:U)
+13 ;start with day of appointment
SET AMERCNT=1
SET AMERDT=$PIECE(AMERTIME,".",1)
+14 FOR
SET AMERDT=$ORDER(^DPT(AMERDFN,"S",AMERDT))
IF 'AMERDT
QUIT
Begin DoDot:1
+15 SET AMERNODE=$GET(^DPT(AMERDFN,"S",AMERDT,0))
IF 'AMERNODE
QUIT
+16 ;skip if canceled
IF $PIECE(AMERNODE,U,2)["C"
QUIT
+17 ;skip if no-show
IF $PIECE(AMERNODE,U,2)["N"
IF $PIECE(AMERNODE,U,2)'="NT"
QUIT
+18 ; if lab, x-ray or ekg appts set, display first
+19 FOR I=3,4,5
SET X=$PIECE(AMERNODE,U,I)
IF X[""
QUIT
Begin DoDot:2
+20 SET AMERCNT=AMERCNT+1
+21 SET AMERLN(AMERCNT)=$$FMTE^XLFDT(X)_AMERSP_$PIECE("LAB^X-RAY^EKG",U,I-2)
End DoDot:2
+22 ; then display this appt
+23 SET AMERCNT=$GET(AMERCNT)+1
+24 SET X=$$FMTE^XLFDT(AMERDT)_AMERSP_$$GET1^DIQ(44,+AMERNODE,.01)
+25 SET AMERLN(AMERCNT)=$$PAD(X,43)_AMERSP_$EXTRACT($$OI^BSDU2(AMERDFN,+AMERNODE,AMERDT),1,34)
+26 SET AMERLN(AMERCNT,0)=+AMERNODE
End DoDot:1
+27 IF AMERCNT>1
Begin DoDot:1
+28 SET AMERLN(1,"F")="!!?20"
SET AMERLN(1)="**** APPOINTMENTS FROM TODAY FORWARD ****"
+29 FOR I=1:1:AMERCNT
SET AMERLN(AMERCNT,"F")="!"
End DoDot:1
+30 IF '$TEST
SET AMERLN(1)="No Pending Appointments"
SET AMERLN(1,"F")="!"
+31 ;print to current device
IF $GET(AMERTALK)
DO EN^DDIOL(.AMERLN)
+32 ;return data in array
+33 IF $DATA(AMERARR)
Begin DoDot:1
+34 NEW %X,%Y
+35 SET %X="AMERLN("
SET %Y=AMERARR
+36 DO %XY^%RCR
End DoDot:1
+37 QUIT
+38 ;
GETAPPS(AMERDFN,AMERTIME,AMERARR) ;
+1 ;This sub-routine GETS any ER appointmentS for this patient on the day of the ER VISIT
+2 ;If an appointment exists (that has not been canceled)
+3 ;
+4 ;RETURNS AMERARR - AN ARRAY OF ER APPOINTMENTS FOR THIS DFN ON THE DATE OF AMERTIME
+5 ; PASSED BY VALUE AND POPULATED UPON RETURN
+6 ;
+7 ;array(2-9999)=date^clinic name^other info^isCheckedIn
+8 ;
+9 ;INPUT: AMERDFN - THE PATIENT WHO'S APPOINTMENTS ARE BEING LOOKED UP
+10 ; AMERTIME : THE DATE/TIME OF THE ER VISIT
+11 ;
+12 ;
+13 NEW AMERCNT,AMERSDTM,AMERSDCL,AMERLOC,AMERQUIT,AMERCNT2,AMERSCIE
+14 SET AMERCNT=0
SET AMERQUIT=0
+15 DO APPNTMNT^AMERBSDU(AMERDFN,0,AMERTIME,.AMERARR)
+16 ;THERE ARE SCHEDULED VISITS FOR THIS PATIENT - NOW FIND OUT IF ONE OF THEM IS FOR TODAY AT THIS CLINIC
IF $GET(AMERARR(2))'=""
Begin DoDot:1
+17 SET AMERCNT=1
SET AMERCNT2=0
+18 FOR
SET AMERCNT=$ORDER(AMERARR(AMERCNT))
IF AMERCNT=""
QUIT
Begin DoDot:2
+19 ;SCHEDULED CLINIC
SET AMERSDCL=$GET(AMERARR(AMERCNT,0))
+20 ;THIS IS A POINTER TO THE HOSPITAL LOCATION FILE THAT IDENTIFIES THE ERS CLINIC
SET AMERLOC=$GET(^AMER(2.5,+$GET(DUZ(2)),"SD"))
+21 IF AMERLOC=""
QUIT
+22 ;IF THE SCHEDULED CLINIC IS THE CLINIC THAT IS RUNNING THIS PACKAGE
IF AMERLOC=AMERSDCL
Begin DoDot:3
+23 ;SCHEDULED TIME
SET AMERSDTM=$PIECE(AMERARR(AMERCNT),U,1)
+24 ;SCHEDULED TIME IN FM FORMAT
SET %DT="T"
SET X=AMERSDTM
DO ^%DT
SET AMERSDTM=Y
KILL %DT
+25 ;get schedule ien
SET AMERSCIE=$$SCIEN^BSDU2(AMERDFN,AMERSDCL,AMERSDTM)
+26 ;S $P(AMERRARR(AMERCNT),U,4)=$$CI^BSDU2(AMERDFN,AMERSDCL,AMERSDTM,AMERSCIE) ;find out if patient is checked in
+27 ;find out if patient is checked in
SET $PIECE(AMERARR(AMERCNT),U,4)=$$CI^BSDU2(AMERDFN,AMERSDCL,AMERSDTM,AMERSCIE)
+28 ;IF THE APPOINTMENT IS FOR SOME TIME of the day of admission...
IF $PIECE(AMERSDTM,".",1)=$PIECE(AMERTIME,".",1)
Begin DoDot:4
+29 SET AMERCNT2=AMERCNT2+1
+30 DO EN^DDIOL("***THIS PATIENT HAS AN APPOINTMENT IN THIS CLINIC TODAY***","","!?4")
+31 DO EN^DDIOL($PIECE(AMERARR(AMERCNT),U,2)_" FOR : "_$PIECE(AMERARR(AMERCNT),U,1),"","!?10")
+32 QUIT
End DoDot:4
+33 ;IF THE APPOINTMENT IS NOT FOR TODAY, REMOVE FROM ARRAY
IF $PIECE(AMERSDTM,".",1)'=$PIECE(AMERTIME,".",1)
SET AMERRARR(AMERCNT)=""
+34 QUIT
End DoDot:3
+35 IF AMERLOC'=AMERSDCL
SET AMERARR(AMERCNT)=""
+36 QUIT
End DoDot:2
+37 QUIT
End DoDot:1
+38 QUIT
ERCHCKIN(AMERDFN,AMERTIME) ; EP FROM AMER0 after admission information has been collected
+1 ; INPUT: AMERDFN - PATIENT IEN OF PATIENT BEING CHECKED INTO SCHEDULING
+2 ; AMERTIME - TIME OF ADMISSION COLLECTED FROM ERS INTERFACE
+3 ;
+4 ; RETURNS: AMERPCC - THE IEN OF THE PCC VISIT FILE THAT WAS CREATED FOR THIS APPOINTMENT
+5 NEW AMERARR,AMERNUM,AMERPCC,AMERANS,DIR,Y,AMERSDTM,AMERDONE,X
+6 SET AMERPCC=0
SET AMERDONE=0
+7 SET AMERARR="AMERARR("
+8 ; THIS RETURNS AN ARRAY OF APPOINMENTS for this date
DO GETAPPS(AMERDFN,AMERTIME,.AMERARR)
+9 ;AMERARR(2-9999)=date^clinic name^other info^isCheckedIn
+10 SET AMERNUM=0
SET AMERNUM=$ORDER(AMERARR(0))
+11 ;ASK A USER TO SELECT ONE OF THE TIMES IN THE ARRAY
+12 FOR
IF AMERNUM=""!(AMERPCC'=0)
QUIT
Begin DoDot:1
+13 SET AMERNUM=$ORDER(AMERARR(AMERNUM))
+14 IF AMERNUM=""
QUIT
+15 IF $GET(AMERARR(AMERNUM))'=""
Begin DoDot:2
+16 DO EN^DDIOL("PATIENT IS SCHEDULED FOR: "_$PIECE(AMERARR(AMERNUM),U,1),"","!!")
+17 IF $PIECE(AMERARR(AMERNUM),U,2)'=""
DO EN^DDIOL("OTHER INFO: : "_$PIECE(AMERARR(AMERNUM),U,3),"","!")
+18 ;IHS/OIT/SCR 05/21/09 don't ask to check in unless ER Visit day is same as scheduled day
+19 SET X=$PIECE($PIECE(AMERARR(AMERNUM),U,1),"@",1)
+20 DO ^%DT
+21 IF Y'=$PIECE(AMERTIME,".",1)
QUIT
+22 SET DIR("A")="Check-in to this scheduled visit"
+23 SET DIR(0)="Y"
SET DIR("B")="NO"
+24 DO ^DIR
+25 SET AMERANS=Y
+26 IF AMERANS=1
Begin DoDot:3
+27 ;PUT SCHEDULED TIME IN FM FORMAT
SET %DT="T"
SET X=$PIECE(AMERARR(AMERNUM),U,1)
DO ^%DT
SET AMERSDTM=Y
KILL %DT
+28 SET AMERPCC=$$SCHEDULD^AMERPCC(AMERDFN,AMERTIME,AMERSDTM)
+29 IF +AMERPCC>0
Begin DoDot:4
+30 DO EN^DDIOL("CREATED PCC VISIT "_AMERPCC_" FOR ER APPOINTMENT : "_$PIECE(AMERARR(AMERNUM),U,1),"","!!")
+31 DO EN^AMERCLP(AMERDFN)
+32 DO RTNGSLP^AMERVSIT(AMERDFN,AMERTIME)
+33 QUIT
End DoDot:4
+34 IF +AMERPCC<0
Begin DoDot:4
+35 ;D EN^DDIOL("THERE WAS A PROBLEM WITH THE ER - PIMS INTERFACE","","!") ;IHS/OIT/SCR 060109 removed patch 1
+36 ;D EN^DDIOL($P(AMERPCC,U,2),"","!")
+37 ;D EN^DDIOL("NO PCC VISIT CREATED","","!")
+38 HANG 2
+39 QUIT
End DoDot:4
End DoDot:3
+40 IF AMERANS'=1
Begin DoDot:3
+41 DO EN^DDIOL("BY-PASSING THIS APPOINTMENT: "_$PIECE(AMERARR(AMERNUM),U,1),"","!!")
End DoDot:3
+42 QUIT
End DoDot:2
+43 QUIT
End DoDot:1
+44 ;NO ER APPOINTMENT WAS SELECTED FOR CHECK-IN
IF AMERPCC=0
Begin DoDot:1
+45 ;CREATES AND CHECKS-IN A WALK-IN VISIT FOR THIS TIM
SET AMERPCC=$$VISIT^AMERPCC(AMERDFN,AMERTIME)
+46 IF $PIECE(AMERPCC,U,1)>0
Begin DoDot:2
+47 DO EN^AMERCLP(AMERDFN)
+48 DO RTNGSLP^AMERVSIT(AMERDFN,AMERTIME)
+49 QUIT
End DoDot:2
+50 IF $PIECE(AMERPCC,U,1)<0
Begin DoDot:2
+51 ;D EN^DDIOL("THERE WAS A PROBLEM WITH THE ER - PIMS INTERFACE","","!")
+52 DO EN^DDIOL($PIECE(AMERPCC,U,2),"","!")
+53 ;D EN^DDIOL("NO PCC VISIT CREATED","","!")
+54 HANG 2
+55 QUIT
End DoDot:2
+56 QUIT
End DoDot:1
+57 QUIT +AMERPCC
PAD(D,L) ;localcopy of BSDU2^PAD
+1 ; -- D=data L=length
+2 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)
CANCEL(AMERDFN,AMERTIME) ;EP FROM
+1 ;IHS/OIT/SCR 10/27/08 CANCEL PIMS SCHEDULED ER VISIT WHEN THE VISIT IS DELETED
+2 ; Make call using: S ERR=$$CANCEL^BSDAPI(.ARRAY)
+3 ;
+4 ; Input Array -
+5 ; BSDR("PAT") = ien of patient in file 2
+6 ; BSDR("CLN") = ien of clinic in file 44
+7 ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
+8 ; BSDR("ADT") = appointment date and time
+9 ; BSDR("CDT") = cancel date and time
+10 ; BSDR("USR") = user who canceled appt
+11 ; BSDR("CR") = cancel reason - pointer to file 409.2
+12 ; BSDR("NOT") = cancel remarks - optional notes to 160 characters
+13 ;
+14 ;Output: error status and message
+15 ; = 0 or null: everything okay
+16 NEW AMERBSDR,AMERINDX,%
+17 SET AMERBSDR("PAT")=AMERDFN
+18 SET AMERCLN=$GET(^AMER(2.5,DUZ(2),"SD"))
+19 SET AMERBSDR("CLN")=AMERCLN
+20 SET AMERBSDR("TYP")="C"
+21 SET AMERBSDR("ADT")=AMERTIME
+22 DO NOW^%DTC
+23 SET AMERBSDR("CDT")=%
+24 SET AMERBSDR("USR")=DUZ
+25 SET DIC="^SD(409.2,"
SET DIC(0)="XZ"
SET X="OTHER"
+26 DO ^DIC
+27 SET AMERBSDR("CR")=+Y
+28 SET AMERBSDR("NOT")="PATIENT REGISTERED IN ERROR THROUGH ERS"
+29 SET AMERERR=$$CANCEL^BSDAPI(.AMERBSDR)
+30 IF AMERERR
DO EN^DDIOL("UNABLE TO CANCEL THE SCHEDULED PIMS APPOINTMENT!","","!")
+31 QUIT
