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

BOPOBS.m

Go to the documentation of this file. 
  1. BOPOBS ;IHS/ILC/ALG/CIA/PLS - Admits, Check OP By Location;03-Apr-2007 13:35;SM
  1.  ;;1.0;AUTOMATED DISPENSING INTERFACE;**1,3**;Jul 26, 2005
  1.  ;
  1.  ;CHECKIN
  1.  ;
  1. CHECKIN ;EP
  1.  Q:'$G(DFN)  S BOPDFN=DFN
  1.  ;
  1.  ;BOPOLOC = Has 3 pieces as in "AEC^ER TREATMENT"
  1.  ;$P(BOPOLOC,U)   = name of outpatient location entered by user.
  1.  ;$P(BOPOLOC,U,2) = OUTPATIENT LOCATION name (from .01 field of
  1.  ;                   field 10 [multiple] of the BOP Site Parameters).
  1.  ;$P(BOPOLOC,U,3) = OP SEND LOCATION (field 1 of the OUTPATIENT
  1.  ;                   LOCATION multiple above)
  1.  ;
  1.  Q:'$P($G(^BOP(90355,1,2)),U)  ;is adt active
  1.  Q:'$P($G(^BOP(90355,1,2)),U,6)  ; is send outpatient adt active
  1.  ;
  1.  I '$D(BOPOLOC)#10 S BOPOLOC=""
  1.  ;
  1.  ;BOPPDIV=Pointer to file Site PArameters for Hospital Division
  1.  ;         field 3 = receiving facility
  1.  ;
  1.  S U="^",BOPPDIV=$$PRIM^VASITE()
  1.  I BOPPDIV S BOPPDIV=$O(^BOP(90355,1,3,"B",BOPPDIV,0))
  1.  E  S BOPPDIV=$O(^BOP(90355,1,3,0))
  1.  ;
  1.  D INIT^BOPCAP Q:$D(BOPQ)
  1.  D PID^BOPCP
  1.  I D'=5 S BOP(.02)="A01",BOP(.04)="ADT"
  1.  E  S BOP(.02)="A03",BOP(.04)="ADT"
  1.  ; set bop(.03)=bopadm, which is x from ihs code with check in time
  1.  S %DT="ST",X="N" D ^%DT S BOP(.03)=$G(BOPADM)
  1.  ;
  1.  ;$P(BOP10,u,2) = the outpatient 'ward'.  If there is a value in
  1.  ;the "Default Outpatient Location" field of the BOP Site Parameters
  1.  ;file, that is used.  Otherwise, the OP SEND LOCATION that belongs to
  1.  ;the OUTPATIENT LOCATION is used.  Finally, 'AEC' is the default.
  1.  ;Piece 11 is the Patient Type
  1.  ;
  1.  S BOPSALL="N"
  1.  I $P($G(BOPLD),U,5)=1 S BOPSALL="Y"
  1.  S BOP10=""
  1.  I BOP10="",$L($P(BOPOLOC,U,2)) S BOP10="O^"_$P(BOPOLOC,U,2)
  1.  I BOP10="" S BOP10="O^AEC"
  1.  ;
  1.  ;Call to create HL7 Message in BOP Queue file
  1.  K BOPQ S BOPDIV=BOPPDIV
  1.  D MSH^BOPCAP Q:$G(BOPQ)
  1.  ;
  1.  ;SET READY FLAG
  1.  S $P(^BOP(90355.1,BOPDA,0),U,10)=0
  1.  S ^BOP(90355.1,"AS",0,BOPDA)=""
  1.  N DA,DIK S DA=BOPDA,DIK="^BOP(90355.1," D IX1^DIK K DA,DIK
  1.  I +$G(^BOPDTG(1))=1 D
  1.  .S A=$G(^BOPDTG(1,+$H,DFN,0)) Q:'A  S B=$G(^BOPDTG(1,+$H,DFN,A)),$P(B,"^",3)=BOPDA
  1.  .S ^BOPDTG(1,+$H,DFN,A)=B
  1.  .Q
  1.  Q
  1. BYLOC ;This entry point is for use in outpatient environments.
  1.  D JOB^BOPOBS
  1.  ;Check against BOP Site Parameters.
  1.  ;If there is no table do not invoke Interface
  1.  ;Otherwise send patients to the Interface if the location contains
  1.  ;    a match to any character string in field 10 (multiple) and
  1.  ;    use the "Send Location" field as the nursing unit.
  1.  ;
  1.  N L,X,Y,Z,K
  1.  ;
  1.  ;Z=Default Location
  1.  ;BOPOLOC=.01 field of Patient Location file (44)
  1.  ;
  1.  N BOPLD S BOPLD=$G(^BOP(90355,1,"SITE"))
  1.  ; this code is maintained for backward compatability
  1.  ;
  1.  I '$G(BOPOLOC) G BYNEW
  1.  S K=$P($G(^SC(BOPOLOC,0)),U)
  1.  S X=0,L=0
  1.  F  S X=$O(^BOP(90355,1,"OPLOC",X)) Q:'X  S Y=^(X,0) D  Q:L
  1.  .Q:K'[$P(Y,U)
  1.  .S $P(K,U,2,3)=$P(Y,U,1,2),L=1
  1.  I L=1 S BOPOLOC=K G CHECKIN
  1.  ;
  1. BYNEW ; skip around point for BOPOLOC
  1.  ;
  1.  ;  new lookup code
  1.  ;
  1.  I +$G(BOPOLOC)<1 S:$P(BOPLD,U,5) BOPOLOC=$P(BOPLD,U,6) G BYSEND
  1.  I +$G(BOPOLOC)<1 Q
  1.  S A=$O(^BOP(90355,1,"OPLOC","AC",+BOPOLOC,"")) I 'A G:$P(BOPLD,U,5) BYSEND Q
  1.  S Y=$G(^BOP(90355,1,"OPLOC",A,0)) I $P(Y,U,3)'=+BOPOLOC G:$P(BOPLD,U,5) BYSEND Q
  1.  S A=$P($G(^SC(+BOPOLOC,0)),U,1),$P(BOPOLOC,U,2)=A,$P(BOPOLOC,U,3)=$P(Y,U,2)
  1.  I $P(BOPOLOC,U,3)="" S $P(BOPOLOC,U,3)=$P(BOPLD,U,4)
  1.  G CHECKIN
  1.  ;
  1. BYSEND ;if send all is marked and location is not in 90355 file
  1.  I +$G(BOPOLOC)<1 Q
  1.  S A=$P($G(^SC(+BOPOLOC,0)),U,1),$P(BOPOLOC,U,2)=A,$P(BOPOLOC,U,3)=$P(BOPLD,U,4)
  1.  G CHECKIN
  1.  Q
  1.  ; set up track file by date,dfn in order
  1. JOB ; EP
  1.  I +$G(^BOPDTG(1))'=1 Q
  1.  I +$G(DFN)<1 Q
  1.  S A=$G(^BOPDTG(1,+$H,+$G(DFN),0)),A=A+1,^BOPDTG(1,+$H,+$G(DFN),0)=A
  1.  S ^BOPDTG(1,+$H,+$G(DFN),A)=$G(BOPOLOC)_"^"_$H
  1.  Q
  1. SDAM ;EP -  entry from the SDAM main event
  1.  ; SDAMEVT = type of event
  1.  ;    1=make appointment (unscheduled)
  1.  ;    4=check in
  1.  ;    8=disposition an application
  1.  ;    9=disposition edit
  1.  ; SDCL = clinic location (pointer to ^SC   file 44
  1.  ; DFN patient internal number
  1.  N BOPLIEN,QT,D
  1.  S QT=0
  1.  I $G(SDAMEVT)="" S SDAMEVT=$S($G(SDAPTYP):4,$G(ASD)=2:4,1:1)
  1.  I $G(SDCL)="" S SDCL=$S($G(SDSC):SDSC,1:$P(SSC,U,1))
  1.  S BOPADM="" S BOPADM=$G(SDPR) I BOPADM=""&($G(X)'="") S BOPADM=X ; clinic appt time
  1.  I $G(X)'="" S BOPADM=X
  1.  I $$GET1^DIQ(90355,1,316.5,"I") D  Q:QT
  1.  .S D=SDAMEVT I D'=1&(D'=4)&(D'=5)&(D'=8)&(D'=9) K D S QT=1 Q
  1.  E  D  Q:QT
  1.  .S D=SDAMEVT I (D'=4)&(D'=5)&(D'=8)&(D'=9) K D S QT=1 Q
  1.  N I,BOPOLOC,BOPDFN,DA,X,Y,A,B,C,BOPPLD,DIC,DIK,VADM,VAPA,%DT
  1.  S BOPDFN=$G(DFN),BOPOLOC=$G(SDCL) N DFN S DFN=BOPDFN
  1.  I $G(DFN)=0!($G(DFN)="") D  Q:$G(DFN)=""
  1.  .I $G(SDFN)'="" S DFN=SDFN D  Q
  1.  ..I $D(^XTMP("BOPDISP",DUZ,SDFN)) K ^XTMP("BOPDISP",DUZ,SDFN) Q
  1.  .S DFN=$O(^XTMP("BOPDISP",DUZ,DFN)) Q:DFN=""  S BOPDFN=DFN K ^XTMP("BOPDISP",DUZ,DFN)
  1.  I BOPOLOC="" D
  1.  .S BOPREC="" S BOPREC=$O(^BOP(90355,0)) Q:BOPREC=""
  1.  .S BOPOLOC=$P(^BOP(90355,BOPREC,0),U,14)
  1.  Q:$G(BOPOLOC)=""
  1.  D BYLOC
  1.  K BOPOLOC,BOPDFN,DFN,DA,X,Y,A,B,C,BOPPLD,DIC,DIK
  1.  K VADM,BOP,BOP0,BOP1,BOP10,VAPA,BOPBAT,BOPDA,VAERR,BOPDIV
  1.  K BOPIT,BOPPDIV,BOPRAP,BOPVER,BOPWHO,BOPY
  1.  Q