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

AMERBSD.m

Go to the documentation of this file. 
  1. AMERBSD ;GDIT/HS/BEE - AMER - BSD Appointment Scheduling/Clinic and HL set ; 07 Oct 2013  11:33 AM
  1.  ;;3.0;ER VISIT SYSTEM;**10**;MAR 03, 2009;Build 23
  1.  ;
  1. CKHLOC(VIEN,ECLIN) ;Handle possible hospital location changes
  1.  ;
  1.  ;If the patient changed to a new ER Clinic, update PCC with the new information.  They may
  1.  ;also need a new appointment created so they can be looked up from that location.
  1.  ;
  1.  ;Make call using: S ERR=$$CKHLOC^AMERBSD(VIEN,ECLIN)
  1.  ;
  1.  ;Input variables:
  1.  ;VIEN - Visit IEN
  1.  ;ECLIN - ER Clinic IEN (Pointer to ER OPTIONS)
  1.  ;
  1.  ;Output: error status and message
  1.  ; 0 or null - Success
  1.  ; 1^Error message  - Failure
  1.  ;
  1.  NEW BSDATA,%,NAPT,ERR,CLHL,NCLN,NHLOC,OHLOC,HLUPD,EXEC,X,Y
  1.  ;
  1.  ;Input validation
  1.  I '$G(VIEN) Q 1_U_"Missing VIEN"
  1.  I '$D(^AUPNVSIT(VIEN,0)) Q 1_U_"Visit not found"
  1.  I '$G(ECLIN) Q 1_U_"Missing ER Clinic"
  1.  I '$D(^AMER(3,ECLIN,0)) Q 1_U_"ER Clinic not found in ER OPTIONS"
  1.  I '$D(^VA(200,+$G(DUZ),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(DUZ)
  1.  ;
  1.  ;Get patient
  1.  S BSDATA("PAT")=$$GET1^DIQ(9000010,VIEN_",",.05,"I")
  1.  I '$D(^DPT(+$G(BSDATA("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDATA("PAT"))
  1.  ;
  1.  ;Retrieve original (current) hospital location
  1.  S OHLOC=$$GET1^DIQ(9000010,VIEN_",",.22,"I")
  1.  ;
  1.  ;Retrieve new clinic code and hospital location
  1.  S CLHL=$$GCLIN(ECLIN)
  1.  S NCLN=$P(CLHL,U)
  1.  S NHLOC=$P(CLHL,U,2)
  1.  ;
  1.  ;First update the PCC clinic and hospital location
  1.  S HLUPD(9000010,VIEN_",",.08)=$S(NCLN]"":NCLN,1:"@")
  1.  S HLUPD(9000010,VIEN_",",.22)=$S(NHLOC]"":NHLOC,1:"@")
  1.  D FILE^DIE("","HLUPD","ERROR")
  1.  ;
  1.  ;If hospital location has not changed - quit
  1.  I NHLOC=OHLOC Q 0
  1.  ;
  1.  ;Since hospital location has changed - MAY need to create a new appointment for that location
  1.  ;Call BSD routine if delivered. Otherwise use AMER version
  1.  S X="BSDAPIER" X ^%ZOSF("TEST") I $T S EXEC="S ERR=$$ERAPT^BSDAPIER(VIEN,NHLOC)" X EXEC Q ERR
  1.  S ERR=$$ERAPT(VIEN,NHLOC)
  1.  ;
  1.  Q ERR
  1.  ;
  1. ERAPT(VIEN,HLOC) ;EP - Handle ER (AMER/BEDD) Hospital Location Change
  1.  ;
  1.  ;Check for, and create if necessary an appointment for specified visit and location
  1.  ;
  1.  ;Input variables:
  1.  ;VIEN - Visit IEN
  1.  ;HLOC - Hospital Location (Pointer to file 44)
  1.  ;
  1.  ;Output: error status and message
  1.  ; 0 or null - Success
  1.  ; 1^Error message  - Failure
  1.  ;
  1.  NEW BSDATA,%,NAPT,ERR,AIEN,BSDVSTN
  1.  ;
  1.  ;Input validation
  1.  I '$G(VIEN) Q 1_U_"Missing VIEN"
  1.  I '$D(^AUPNVSIT(VIEN,0)) Q 1_U_"Visit not found"
  1.  I '$G(HLOC) Q 1_U_"Missing Hospital Location"
  1.  I '$D(^SC(HLOC,0)) Q 1_U_"Hospital Location not found"
  1.  I '$D(^VA(200,+$G(DUZ),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(DUZ)
  1.  ;
  1.  ;Get patient
  1.  S BSDATA("PAT")=$$GET1^DIQ(9000010,VIEN_",",.05,"I")
  1.  I '$D(^DPT(+$G(BSDATA("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDATA("PAT"))
  1.  ;
  1.  ;Get admit date/time
  1.  S BSDATA("ADT")=$E($$GET1^DIQ(9000010,VIEN_",",.01,"I"),1,12)
  1.  ;
  1.  ;Set other required fields
  1.  S BSDATA("APPT DATE")=BSDATA("ADT")
  1.  S BSDATA("CLINIC CODE")=$$GET1^DIQ(44,HLOC_",",8,"I")
  1.  S BSDATA("CLN")=HLOC
  1.  S BSDATA("HOS LOC")=HLOC
  1.  S BSDATA("LEN")=15
  1.  S BSDATA("SITE")=DUZ(2)
  1.  S BSDATA("SRV CAT")="I"
  1.  S BSDATA("TIME RANGE")=0
  1.  S BSDATA("TYP")=4
  1.  S BSDATA("USR")=DUZ
  1.  S BSDATA("VISIT DATE")=$$GET1^DIQ(9000010,VIEN_",",.01,"I")
  1.  S BSDATA("VISIT TYPE")="I"
  1.  ;
  1.  ;First look for existing appointment clinic/date/patient
  1.  S AIEN=$$SCIEN^BSDU2(BSDATA("PAT"),BSDATA("CLN"),BSDATA("ADT"))
  1.  ;
  1.  ;If existing found, update file 2 and quit
  1.  I AIEN S ERR=$$UPDT2(.BSDATA,VIEN,0) Q ERR
  1.  ;
  1.  ;New appointment needed - Create it
  1.  S ERR=$$MAKE(.BSDATA,VIEN) Q:ERR ERR
  1.  ;
  1.  ;Set variables used by checkin call
  1.  S BSDATA("CDT")=BSDATA("ADT")
  1.  S BSDATA("CC")=$G(BSDATA("CLINIC CODE"))
  1.  S BSDATA("PRV")=""
  1.  S BSDATA("VIEN")=VIEN
  1.  ;
  1.  ;Check in appt
  1.  S ERR=$$CHECKIN(.BSDATA) Q:ERR ERR
  1.  ;
  1.  Q 0
  1.  ;
  1. UPDT2(BSDR,VIEN,SKP21) ;Update file 2 appointment entry to point to existing matching appointment
  1.  ;
  1.  NEW ERR,DA,IENS,DPTUPD,OE,OEIEN
  1.  ;
  1.  ;Verify appointment entry exists in DPT
  1.  I '$D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)) Q "1^Could not locate DPT appointment"
  1.  ;
  1.  ;Locate outpatient encounter entry
  1.  S (OE,OEIEN)="" F  S OE=$O(^SCE("AVSIT",VIEN,OE)) Q:'OE  D  Q:OEIEN
  1.  . ;
  1.  . ;Check date
  1.  . I $$GET1^DIQ(409.68,OE_",",.01,"I")'=BSDR("ADT") Q
  1.  . ;
  1.  . ;Check location
  1.  . I $$GET1^DIQ(409.68,OE_",",.04,"I")'=BSDR("HOS LOC") Q
  1.  . ;
  1.  . ;Found match
  1.  . S OEIEN=OE
  1.  ;
  1.  ;If appointment for clinic exists but cannot locate SCE pointer - quit
  1.  I '$G(SKP21),'OEIEN Q "1^Could not locate SCE pointer"
  1.  ;
  1.  ;Update CLINIC and OUTPATIENT ENCOUNTER fields
  1.  S DA(1)=BSDR("PAT"),DA=BSDR("ADT"),IENS=$$IENS^DILF(.DA)
  1.  S DPTUPD(2.98,IENS,.01)=BSDR("CLN")
  1.  S DPTUPD(2.98,IENS,21)=$S(OEIEN]"":OEIEN,1:"@")
  1.  S ERR=0 D UPDATE^DIE("","DPTUPD","ERR")
  1.  I $G(ERR(1))]"" S ERR=ERR(1)
  1.  ;
  1.  Q ERR
  1.  ;
  1. MAKE(BSDR,VIEN) ;Existing Visit changing ER Hospital Location - Make a new appointment
  1.  ;
  1.  ;Adapted from BSDAPI
  1.  ;
  1.  ; Make call using: S ERR=$$MAKE(.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") = 3 for scheduled appts, 4 for walkins
  1.  ; BSDR("ADT") = appointment date and time
  1.  ; BSDR("LEN") = appointment length in minutes (5-120)
  1.  ; BSDR("USR") = user who made appt
  1.  ;
  1.  ;Output: error status and message
  1.  ;   = 0 or null:  everything okay
  1.  ;   = 1^message:  error and reason
  1.  ;
  1.  NEW BSDXERR,Y,ERR
  1.  ;
  1.  ;Check if appointment present for that time in file 2, if so update it
  1.  ;If not present, add appt to file 2 and appt dt/time to 9000010
  1.  I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)) S ERR=$$UPDT2(.BSDR,VIEN,1) I 1 Q:ERR ERR
  1.  E  D  I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")
  1.  . N BSDXFDA,BSDXIENS,BSDXMSG
  1.  . S BSDXIENS="?+2,"_BSDR("PAT")_","
  1.  . S BSDXIENS(2)=BSDR("ADT")
  1.  . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
  1.  . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
  1.  . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
  1.  . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
  1.  . S BSDXFDA(9000010,VIEN_",",.26)=BSDR("ADT")
  1.  . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
  1.  ;
  1.  ;Add new appt to file 44
  1.  I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
  1.  I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D  I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")
  1.  . NEW DIC,DA,X,DINUM,DLAYGO
  1.  . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
  1.  . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
  1.  . S Y=1 I '$D(@(DIC_X_")")) K DO,DD D FILE^DICN
  1.  ;
  1.  ;Add remaining fields to appt in 44
  1.  D
  1.  . NEW DIC,DA,X,Y,DLAYGO,DINUM
  1.  . S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
  1.  . S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")
  1.  . S DIC("DR")="1///"_BSDR("LEN")_";7////"_BSDR("USR")_";8////"_$$NOW^XLFDT
  1.  . S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
  1.  . K DO,DD D FILE^DICN
  1.  ;
  1.  ;Call event driver
  1.  D
  1.  . NEW DFN,SDT,SDCL,SDDA,SDMODE
  1.  . S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
  1.  . S SDDA=$$SCIEN^BSDU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
  1.  . D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
  1.  ;
  1.  Q 0
  1.  ;
  1. CHECKIN(BSDR) ;Add checkin info to appt
  1.  ;
  1.  ;Adapted from BSDAPI
  1.  ;
  1.  ; Make call by using:  S ERR=$$CHECKIN(.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("ADT") = appt date/time
  1.  ;  BSDR("CDT") = checkin date/time
  1.  ;  BSDR("USR") = checkin user
  1.  ;  BSDR("OPT") = option used to create visit (optional)
  1.  ;  BSDR("VIEN") = visit IEN (sent if new visit is NOT to be created)
  1.  ;
  1.  ;  BSDR("CC")  = clinic code for creating visit - optional
  1.  ;  BSDR("PRV") = visit provider - pointer to file 200
  1.  ;
  1.  ; Output value -
  1.  ;              = 0 means everything worked
  1.  ;              = 1^message means error with reason message
  1.  ;
  1.  NEW IEN,DIE,DA,DR,SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,Y
  1.  ;
  1.  ;Find appointment in file 44
  1.  S IEN=$$SCIEN^BSDU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
  1.  I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
  1.  ;
  1.  ;Track before status
  1.  S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
  1.  S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
  1.  D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
  1.  ;
  1.  ;Set checkin
  1.  S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
  1.  S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
  1.  S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
  1.  D ^DIE
  1.  ;
  1.  ;Set after status
  1.  S SDDA=$$SCIEN^BSDU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
  1.  S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
  1.  D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
  1.  ;
  1.  I $G(BSDR("VIEN")) S BSDVSTN=BSDR("VIEN")
  1.  ;
  1.  ; call event driver
  1.  D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
  1.  ;
  1.  Q 0
  1.  ;
  1. GCLIN(ECLIN) ;Return the clinic code and hospital location for the ER OPTION CIEN
  1.  ;
  1.  I '$G(ECLIN) Q ""
  1.  ;
  1.  NEW HLOC,ICPREF,CLIN
  1.  ;
  1.  S (CLIN,HLOC)=""
  1.  ;
  1.  ;Look for associated hospital location
  1.  S ICPREF=$O(^AMER(2.5,DUZ(2),8,"B",ECLIN,"")) I ICPREF]"" D
  1.  . NEW DA,IENS
  1.  . S DA(1)=DUZ(2),DA=ICPREF,IENS=$$IENS^DILF(.DA)
  1.  . S HLOC=$$GET1^DIQ(9009082.58,IENS,".02","I")
  1.  ;
  1.  ;If hospital location isn't set, pull from default
  1.  I HLOC="" D
  1.  . S HLOC=$G(^AMER(2.5,DUZ(2),"SD"))
  1.  . S CLIN=$$GET1^DIQ(9009083,ECLIN_",",5,"I")
  1.  . I CLIN]"" S CLIN=$O(^DIC(40.7,"C",CLIN,""))
  1.  ;
  1.  I HLOC="" D  Q ""
  1.  . W !,"SITE PARAMETERS have not been set up in the ERS PARAMETER option"
  1.  . W !,"No entry for EMERGENCY MEDICINE could be located"
  1.  ;
  1.  ;Get the clinic
  1.  S:CLIN="" CLIN=$$GET1^DIQ(44,HLOC_",",8,"I")
  1.  ;
  1.  Q CLIN_U_HLOC