BEDDPCC ;GDIT/HS/BEE-BEDD Admit - Create a Visit ; 08 Nov 2011 12:00 PM
;;2.0;BEDD DASHBOARD;**2,3**;Jun 04, 2014;Build 12
;
;GDIT/HS/BEE 05/10/2018;CR#10213 - BEDD*2.0*3 - Allow different hospital locations
;
;Derived from AMERPCC
;
VISIT(AMERPAT,AMERTIME,BEDD) ; EP from NADM^BEDDADM when patient is admitted W/O PIMS interface CHEKIN^AMERBSDU
;
NEW AMERVSIT
;
;GDIT/HS/BEE 05/10/2018;CR#10213 - BEDD*2.0*3 - Allow different hospital locations
;S AMERVSIT=$$AMVISIT(AMERPAT,AMERTIME) I +AMERVSIT'>0 Q "-1^"_$P(AMERVSIT,U,2)
S AMERVSIT=$$AMVISIT(AMERPAT,AMERTIME,.BEDD) I +AMERVSIT'>0 Q "-1^"_$P(AMERVSIT,U,2)
;
Q AMERVSIT
;
;GDIT/HS/BEE 05/10/2018;CR#10213 - BEDD*2.0*3 - Allow different hospital locations
;AMVISIT(AMERPAT,AMERDATE) ;
AMVISIT(AMERPAT,AMERDATE,BEDD) ;
;
;NEW IN,AMERVSIT,OUT,X,AMERVDR,AMEROPT,AMERTEMP,BEDDADM
NEW IN,AMERVSIT,OUT,X,AMERVDR,AMEROPT,AMERTEMP,BEDDADM,CLIN,ICLIN,ICPREF
;
S (AMERVSIT,AMERVDR)=""
;
S IN("PAT")=AMERPAT
S IN("VISIT DATE")=AMERDATE
S IN("SITE")=$G(DUZ(2))
;
; To determine "visit type" for this visit, look in the "PCC MASTER CONTROL" file
; and get the "type of visit" that is set there
S IN("VISIT TYPE")=$P($G(^APCCCTRL(DUZ(2),0)),U,4)
S IN("USR")=DUZ
;
;GDIT/HS/BEE 05/10/2018;CR#10213 - BEDD*2.0*3 - Allow different hospital locations
;S IN("HOS LOC")=$G(^AMER(2.5,DUZ(2),"SD"))
S CLIN=$G(BEDD("tClinic")) I CLIN]"" D
. NEW DA,IENS
. S ICLIN=$O(^AMER(3,"B",CLIN,"")) Q:ICLIN=""
. S ICPREF=$O(^AMER(2.5,DUZ(2),8,"B",ICLIN,"")) Q:ICPREF=""
. S DA(1)=DUZ(2),DA=ICPREF,IENS=$$IENS^DILF(.DA)
. S IN("HOS LOC")=$$GET1^DIQ(9009082.58,IENS,".02","I")
S:$G(IN("HOS LOC"))="" IN("HOS LOC")=$G(^AMER(2.5,DUZ(2),"SD"))
;
S:IN("HOS LOC")'="" IN("APPT DATE")=AMERDATE ; Setting IN("APPT DATE") will create an appoinment for this time
S IN("SRV CAT")="A" ; ER VISITS are "ambulatory"
S IN("TIME RANGE")=3 ; Only find a visit for a time that is close to time or ER VISIT
S BEDDADM=1
D GETVISIT^APCDAPI4(.IN,.OUT)
;
;No visit returned
I $P(OUT(0),U,1)=0 Q "-1^"_$P(OUT(0),U,2)
Q:+AMERVSIT<0 AMERVSIT
;
;Multiple results returned
S AMERTEMP=0
I $P(OUT(0),U,1)>1 D
.F S AMERTEMP=$O(OUT(AMERTEMP)) Q:AMERTEMP="" D
..S AMERVSIT=AMERTEMP
;
;Only one result returned
I $P(OUT(0),U,1)=1 S AMERVSIT=$O(OUT(AMERTEMP))
;
;If "Option use to create" is blank (no PIMS interface) update it with a DIE call...
I AMERVSIT>0 D
.Q:$$GETVOPTN^AMERVSIT(AMERVSIT)'=""
.S AMEROPT=$$GETOPIEN^AMERVSIT("AMER IHS PCC LINK")
.S:+AMEROPT>0 AMERVDR=".24///"_+AMEROPT
.D:AMERVDR'="" VSITDIE^AMERVSIT(AMERVSIT,AMERVDR)
;
Q AMERVSIT
BEDDPCC ;GDIT/HS/BEE-BEDD Admit - Create a Visit ; 08 Nov 2011 12:00 PM
+1 ;;2.0;BEDD DASHBOARD;**2,3**;Jun 04, 2014;Build 12
+2 ;
+3 ;GDIT/HS/BEE 05/10/2018;CR#10213 - BEDD*2.0*3 - Allow different hospital locations
+4 ;
+5 ;Derived from AMERPCC
+6 ;
VISIT(AMERPAT,AMERTIME,BEDD) ; EP from NADM^BEDDADM when patient is admitted W/O PIMS interface CHEKIN^AMERBSDU
+1 ;
+2 NEW AMERVSIT
+3 ;
+4 ;GDIT/HS/BEE 05/10/2018;CR#10213 - BEDD*2.0*3 - Allow different hospital locations
+5 ;S AMERVSIT=$$AMVISIT(AMERPAT,AMERTIME) I +AMERVSIT'>0 Q "-1^"_$P(AMERVSIT,U,2)
+6 SET AMERVSIT=$$AMVISIT(AMERPAT,AMERTIME,.BEDD)
IF +AMERVSIT'>0
QUIT "-1^"_$PIECE(AMERVSIT,U,2)
+7 ;
+8 QUIT AMERVSIT
+9 ;
+10 ;GDIT/HS/BEE 05/10/2018;CR#10213 - BEDD*2.0*3 - Allow different hospital locations
+11 ;AMVISIT(AMERPAT,AMERDATE) ;
AMVISIT(AMERPAT,AMERDATE,BEDD) ;
+1 ;
+2 ;NEW IN,AMERVSIT,OUT,X,AMERVDR,AMEROPT,AMERTEMP,BEDDADM
+3 NEW IN,AMERVSIT,OUT,X,AMERVDR,AMEROPT,AMERTEMP,BEDDADM,CLIN,ICLIN,ICPREF
+4 ;
+5 SET (AMERVSIT,AMERVDR)=""
+6 ;
+7 SET IN("PAT")=AMERPAT
+8 SET IN("VISIT DATE")=AMERDATE
+9 SET IN("SITE")=$GET(DUZ(2))
+10 ;
+11 ; To determine "visit type" for this visit, look in the "PCC MASTER CONTROL" file
+12 ; and get the "type of visit" that is set there
+13 SET IN("VISIT TYPE")=$PIECE($GET(^APCCCTRL(DUZ(2),0)),U,4)
+14 SET IN("USR")=DUZ
+15 ;
+16 ;GDIT/HS/BEE 05/10/2018;CR#10213 - BEDD*2.0*3 - Allow different hospital locations
+17 ;S IN("HOS LOC")=$G(^AMER(2.5,DUZ(2),"SD"))
+18 SET CLIN=$GET(BEDD("tClinic"))
IF CLIN]""
Begin DoDot:1
+19 NEW DA,IENS
+20 SET ICLIN=$ORDER(^AMER(3,"B",CLIN,""))
IF ICLIN=""
QUIT
+21 SET ICPREF=$ORDER(^AMER(2.5,DUZ(2),8,"B",ICLIN,""))
IF ICPREF=""
QUIT
+22 SET DA(1)=DUZ(2)
SET DA=ICPREF
SET IENS=$$IENS^DILF(.DA)
+23 SET IN("HOS LOC")=$$GET1^DIQ(9009082.58,IENS,".02","I")
End DoDot:1
+24 IF $GET(IN("HOS LOC"))=""
SET IN("HOS LOC")=$GET(^AMER(2.5,DUZ(2),"SD"))
+25 ;
+26 ; Setting IN("APPT DATE") will create an appoinment for this time
IF IN("HOS LOC")'=""
SET IN("APPT DATE")=AMERDATE
+27 ; ER VISITS are "ambulatory"
SET IN("SRV CAT")="A"
+28 ; Only find a visit for a time that is close to time or ER VISIT
SET IN("TIME RANGE")=3
+29 SET BEDDADM=1
+30 DO GETVISIT^APCDAPI4(.IN,.OUT)
+31 ;
+32 ;No visit returned
+33 IF $PIECE(OUT(0),U,1)=0
QUIT "-1^"_$PIECE(OUT(0),U,2)
+34 IF +AMERVSIT<0
QUIT AMERVSIT
+35 ;
+36 ;Multiple results returned
+37 SET AMERTEMP=0
+38 IF $PIECE(OUT(0),U,1)>1
Begin DoDot:1
+39 FOR
SET AMERTEMP=$ORDER(OUT(AMERTEMP))
IF AMERTEMP=""
QUIT
Begin DoDot:2
+40 SET AMERVSIT=AMERTEMP
End DoDot:2
End DoDot:1
+41 ;
+42 ;Only one result returned
+43 IF $PIECE(OUT(0),U,1)=1
SET AMERVSIT=$ORDER(OUT(AMERTEMP))
+44 ;
+45 ;If "Option use to create" is blank (no PIMS interface) update it with a DIE call...
+46 IF AMERVSIT>0
Begin DoDot:1
+47 IF $$GETVOPTN^AMERVSIT(AMERVSIT)'=""
QUIT
+48 SET AMEROPT=$$GETOPIEN^AMERVSIT("AMER IHS PCC LINK")
+49 IF +AMEROPT>0
SET AMERVDR=".24///"_+AMEROPT
+50 IF AMERVDR'=""
DO VSITDIE^AMERVSIT(AMERVSIT,AMERVDR)
End DoDot:1
+51 ;
+52 QUIT AMERVSIT
