- 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))