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

AMERBSDU.m

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