BSDAPI3 ; IHS/ITSC/LJF - ATTACH ANCILLARY ITEM TO APPT/VISIT;
;;5.3;PIMS;**1002,1009**;APR 26, 2002
;IHS/ITSC/LJF 12/23/2004 PATCH 1002 rewrote routine to call new BSDAPI4
;cmi/anch/maw 06/10/2008 PATCH 1009 added set of variable "SHOW VISITS" so that user can select visit if there, maybe in future release.
;
EN(DFN,BSDCLD,BSDREAS,BSDITEM) ;PEP;
; CALLED BY ANICLLARY PACKAGES (LAB, RAD, PHR)
; Used in INTERACTIVE MODE to select an appt to attach ordered items
; If appt is already checked in, returns visit IEN
; If not, proceeds to check patient in and create visit
; If patient has more than one appt, list is displayed
; There will always be a final choice of adding an walkin appt/visit
; to the ancillary service
;
; Called by using this approach:
; S VISIT=$$EN^BSDAPI3(patient ien,default clinic,default reason,item)
;
; INPUT VARIABLES:
; DFN - Patient IEN
; BSDCLD - Clinic Default IEN for ancillary walkin visits
; BSDREAS - Default reason for appt ("lab draw", "radiology walk-in", etc.)
; BSDITEM - Item name ("test(s)", "exam", "prescription", "order")
; Phrasing up to calling routine
;
; OUTPUT VARIABLES:
; Returns string - first piece is Visit IEN or zero if error occurred
; second piece set if error and is error message
;
I '$G(DFN)!'$G(BSDCLD) Q 0_U_"Bad Input Parameters"
I $$GET1^DIQ(9009017.2,BSDCLD,.09)'="YES" Q 0_U_"Default Clinic NOT set up to create visits"
;
;Get list of appts and their visits if any
W !!,"Attaching "_BSDITEM_" to an Appointment and PCC Visit . . ."
NEW BSDDT,BSDEND,APPT,BSDCNT,BSDARR,BSDCLDN,BSDVST
S BSDCLDN=$$GET1^DIQ(44,BSDCLD,.01) ;set name for default clinic
S BSDDT=$$FMADD^XLFDT(DT,-1)_".24" ;start just before today
S BSDEND=DT+.24 ;only look at today
F S BSDDT=$O(^DPT(DFN,"S",BSDDT)) Q:'BSDDT Q:BSDDT>BSDEND D
. S APPT=$G(^DPT(DFN,"S",BSDDT,0)) Q:APPT=""
. S BSDCNT=$G(BSDCNT)+1
. S BSDARR(BSDCNT)=BSDDT_U_$P(APPT,U)_U_$$STATUS(DFN,BSDDT)
;
;
; if no appts found, tell user walk-in appt to their service is being added
I '$G(BSDCNT) D Q $G(BSDVST)
. W !!,"No Appts Today for Patient; Adding Walk-in Appt to "_BSDCLDN
. S BSDVST=$$CHECKIN(BSDCLD,$$NOW^XLFDT,BSDREAS) ;add ancillary WALK-in and return visit ien
;
CHOOSE ; Otherwise, display list of appts so user can select one
NEW COUNT,APPT,Y W !
S COUNT=0 F S COUNT=$O(BSDARR(COUNT)) Q:'COUNT D
. S APPT=BSDARR(COUNT)
. W !,$J(COUNT,3),?5,$$FMTE^XLFDT(+APPT)
. W ?20,$E($$GET1^DIQ(44,$P(APPT,U,2),.01),1,25),?50,$P(APPT,U,3)
;
S COUNT=$O(BSDARR(99),-1) ;get highest count
W !,$J(COUNT+1,3),?5,"Add walk-in appointment to "_BSDCLDN
S Y=$$READ^BDGF("N^1:"_(COUNT+1),"Select One from List")
I Y<1 W !!,"You MUST select one from the list!" D CHOOSE Q
;
; if last choice selected, add walk-in for default clinic
I Y=COUNT+1 W !!,"Adding Walk-in Appt and Visit to "_BSDCLDN Q $$CHECKIN(BSDCLD,$$NOW^XLFDT,BSDREAS)
;
; Take appt selected, and check if already has visit attached
S APPT=BSDARR(+Y)
S BSDVST=$$GETVST^BSDU2(DFN,+APPT)
I BSDVST W !!,"PCC Visit found for checked in appointment." Q BSDVST ;visit already made
;
; Otherwise perform check-in for appt
W !!,"Checking in patient to appointment in "_$$GET1^DIQ(44,$P(APPT,U,2),.01)
Q $$CHECKIN($P(APPT,U,2),$P(APPT,U))
;
;
; subroutines
STATUS(D0,D1) ; return appt's current status
; Call to SDAMU requries D0 and D1 set, returns X
NEW X D CURRENT^SDAMU
Q X
;
CHECKIN(CLN,APPT,OI) ; checkin appt OR create walkin for default clinic
NEW BSDAR,BSDVST
S BSDAR("HOS LOC")=CLN ;clinic ien passed in
S BSDAR("APPT DATE")=APPT ;appt time passed in
S BSDAR("OI")=$G(OI) ;appt reason if passed in
;
S BSDAR("PAT")=DFN
S BSDAR("VISIT DATE")=$$NOW^XLFDT
S BSDAR("LEN")=$$GET1^DIQ(44,CLN,1912)
S BSDAR("USR")=DUZ
S BSDAR("FORCE ADD")=1
S BSDAR("OPT")="SD IHS ANCILLARY"
S BSDAR("SITE")=$$GET1^DIQ(44,CLINIC,3,"I")
S BSDAR("SRV CAT")="A"
S BSDAR("VISIT TYPE")=$$GET1^DIQ(9001001.2,CLN,.11,"I")
;S BSDAR("SHOW VISITS")=1 ;cmi/maw 6/10/2008 pass variable to show visits, maybe in future release
D GETVISIT^BSDAPI4(.BSDAR,.BSDVST)
;
I BSDVST(0)=0 Q BSDVST(0)
;I $G(BSDR("VIEN")) Q BSDR("VIEN") ;cmi/maw 6/10/2008 quit on visit variable if there, maybe in future release
Q $O(BSDVST(0))
BSDAPI3 ; IHS/ITSC/LJF - ATTACH ANCILLARY ITEM TO APPT/VISIT;
+1 ;;5.3;PIMS;**1002,1009**;APR 26, 2002
+2 ;IHS/ITSC/LJF 12/23/2004 PATCH 1002 rewrote routine to call new BSDAPI4
+3 ;cmi/anch/maw 06/10/2008 PATCH 1009 added set of variable "SHOW VISITS" so that user can select visit if there, maybe in future release.
+4 ;
EN(DFN,BSDCLD,BSDREAS,BSDITEM) ;PEP;
+1 ; CALLED BY ANICLLARY PACKAGES (LAB, RAD, PHR)
+2 ; Used in INTERACTIVE MODE to select an appt to attach ordered items
+3 ; If appt is already checked in, returns visit IEN
+4 ; If not, proceeds to check patient in and create visit
+5 ; If patient has more than one appt, list is displayed
+6 ; There will always be a final choice of adding an walkin appt/visit
+7 ; to the ancillary service
+8 ;
+9 ; Called by using this approach:
+10 ; S VISIT=$$EN^BSDAPI3(patient ien,default clinic,default reason,item)
+11 ;
+12 ; INPUT VARIABLES:
+13 ; DFN - Patient IEN
+14 ; BSDCLD - Clinic Default IEN for ancillary walkin visits
+15 ; BSDREAS - Default reason for appt ("lab draw", "radiology walk-in", etc.)
+16 ; BSDITEM - Item name ("test(s)", "exam", "prescription", "order")
+17 ; Phrasing up to calling routine
+18 ;
+19 ; OUTPUT VARIABLES:
+20 ; Returns string - first piece is Visit IEN or zero if error occurred
+21 ; second piece set if error and is error message
+22 ;
+23 IF '$GET(DFN)!'$GET(BSDCLD)
QUIT 0_U_"Bad Input Parameters"
+24 IF $$GET1^DIQ(9009017.2,BSDCLD,.09)'="YES"
QUIT 0_U_"Default Clinic NOT set up to create visits"
+25 ;
+26 ;Get list of appts and their visits if any
+27 WRITE !!,"Attaching "_BSDITEM_" to an Appointment and PCC Visit . . ."
+28 NEW BSDDT,BSDEND,APPT,BSDCNT,BSDARR,BSDCLDN,BSDVST
+29 ;set name for default clinic
SET BSDCLDN=$$GET1^DIQ(44,BSDCLD,.01)
+30 ;start just before today
SET BSDDT=$$FMADD^XLFDT(DT,-1)_".24"
+31 ;only look at today
SET BSDEND=DT+.24
+32 FOR
SET BSDDT=$ORDER(^DPT(DFN,"S",BSDDT))
IF 'BSDDT
QUIT
IF BSDDT>BSDEND
QUIT
Begin DoDot:1
+33 SET APPT=$GET(^DPT(DFN,"S",BSDDT,0))
IF APPT=""
QUIT
+34 SET BSDCNT=$GET(BSDCNT)+1
+35 SET BSDARR(BSDCNT)=BSDDT_U_$PIECE(APPT,U)_U_$$STATUS(DFN,BSDDT)
End DoDot:1
+36 ;
+37 ;
+38 ; if no appts found, tell user walk-in appt to their service is being added
+39 IF '$GET(BSDCNT)
Begin DoDot:1
+40 WRITE !!,"No Appts Today for Patient; Adding Walk-in Appt to "_BSDCLDN
+41 ;add ancillary WALK-in and return visit ien
SET BSDVST=$$CHECKIN(BSDCLD,$$NOW^XLFDT,BSDREAS)
End DoDot:1
QUIT $GET(BSDVST)
+42 ;
CHOOSE ; Otherwise, display list of appts so user can select one
+1 NEW COUNT,APPT,Y
WRITE !
+2 SET COUNT=0
FOR
SET COUNT=$ORDER(BSDARR(COUNT))
IF 'COUNT
QUIT
Begin DoDot:1
+3 SET APPT=BSDARR(COUNT)
+4 WRITE !,$JUSTIFY(COUNT,3),?5,$$FMTE^XLFDT(+APPT)
+5 WRITE ?20,$EXTRACT($$GET1^DIQ(44,$PIECE(APPT,U,2),.01),1,25),?50,$PIECE(APPT,U,3)
End DoDot:1
+6 ;
+7 ;get highest count
SET COUNT=$ORDER(BSDARR(99),-1)
+8 WRITE !,$JUSTIFY(COUNT+1,3),?5,"Add walk-in appointment to "_BSDCLDN
+9 SET Y=$$READ^BDGF("N^1:"_(COUNT+1),"Select One from List")
+10 IF Y<1
WRITE !!,"You MUST select one from the list!"
DO CHOOSE
QUIT
+11 ;
+12 ; if last choice selected, add walk-in for default clinic
+13 IF Y=COUNT+1
WRITE !!,"Adding Walk-in Appt and Visit to "_BSDCLDN
QUIT $$CHECKIN(BSDCLD,$$NOW^XLFDT,BSDREAS)
+14 ;
+15 ; Take appt selected, and check if already has visit attached
+16 SET APPT=BSDARR(+Y)
+17 SET BSDVST=$$GETVST^BSDU2(DFN,+APPT)
+18 ;visit already made
IF BSDVST
WRITE !!,"PCC Visit found for checked in appointment."
QUIT BSDVST
+19 ;
+20 ; Otherwise perform check-in for appt
+21 WRITE !!,"Checking in patient to appointment in "_$$GET1^DIQ(44,$PIECE(APPT,U,2),.01)
+22 QUIT $$CHECKIN($PIECE(APPT,U,2),$PIECE(APPT,U))
+23 ;
+24 ;
+25 ; subroutines
STATUS(D0,D1) ; return appt's current status
+1 ; Call to SDAMU requries D0 and D1 set, returns X
+2 NEW X
DO CURRENT^SDAMU
+3 QUIT X
+4 ;
CHECKIN(CLN,APPT,OI) ; checkin appt OR create walkin for default clinic
+1 NEW BSDAR,BSDVST
+2 ;clinic ien passed in
SET BSDAR("HOS LOC")=CLN
+3 ;appt time passed in
SET BSDAR("APPT DATE")=APPT
+4 ;appt reason if passed in
SET BSDAR("OI")=$GET(OI)
+5 ;
+6 SET BSDAR("PAT")=DFN
+7 SET BSDAR("VISIT DATE")=$$NOW^XLFDT
+8 SET BSDAR("LEN")=$$GET1^DIQ(44,CLN,1912)
+9 SET BSDAR("USR")=DUZ
+10 SET BSDAR("FORCE ADD")=1
+11 SET BSDAR("OPT")="SD IHS ANCILLARY"
+12 SET BSDAR("SITE")=$$GET1^DIQ(44,CLINIC,3,"I")
+13 SET BSDAR("SRV CAT")="A"
+14 SET BSDAR("VISIT TYPE")=$$GET1^DIQ(9001001.2,CLN,.11,"I")
+15 ;S BSDAR("SHOW VISITS")=1 ;cmi/maw 6/10/2008 pass variable to show visits, maybe in future release
+16 DO GETVISIT^BSDAPI4(.BSDAR,.BSDVST)
+17 ;
+18 IF BSDVST(0)=0
QUIT BSDVST(0)
+19 ;I $G(BSDR("VIEN")) Q BSDR("VIEN") ;cmi/maw 6/10/2008 quit on visit variable if there, maybe in future release
+20 QUIT $ORDER(BSDVST(0))
