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

BSDDPA.m

Go to the documentation of this file. 
  1. BSDDPA ; IHS/ITSC/LJF, WAR - DISPLAY PAT APPTS ;  [ 04/16/2004  4:40 PM ]
  1.  ;;5.3;PIMS;**1003,1004**;MAY 28, 2004
  1.  ;IHS/ITSC/LJF 05/13/2005 PATCH 1003 added EP; to EN subroutine
  1.  ;IHS/OIT/LJF 07/20/2005 PATCH 1004 check if patient active on a wait list
  1.  ;                                  expanded default end date to 6 months from today
  1.  ;
  1. PAT ; -- ask user for patient
  1.  NEW DFN,BSDBD,BSDED
  1.  D KILL^AUPNPAT
  1.  S DFN=+$$READ^BDGF("PO^9000001:EQM","Select Patient") Q:DFN<1
  1.  ;
  1.  S BSDBD=$$READ^BDGF("D^::EX","Select Beginning Date","TODAY") Q:'BSDBD
  1.  ;
  1.  ;;IHS/OIT/LJF 7/20/2005 PATCH 1004
  1.  ;I '$O(^DPT(DFN,"S",BSDBD)) D  Q
  1.  ;. W !!,"NO APPOINTMENTS FOUND!",!
  1.  I '$O(^DPT(DFN,"S",BSDBD)),'$$ONWL^BSDWLV(DFN,"C") D  D PAT Q
  1.  . W !!,"NO APPOINTMENTS OR WAITING LIST ENTRIES FOUND!",!
  1.  ;end of PATCH 1004 changes
  1.  ;
  1.  ;S BSDED=$$READ^BDGF("D^::EX","Select Ending Date","T+90") Q:'BSDED
  1.  S BSDED=$$READ^BDGF("D^::EX","Select Ending Date","T+180") Q:'BSDED  ;IHS/OIT/LJF 7/20/2005 PATCH 1004
  1.  ;
  1.  D EN,PAT Q
  1.  ;
  1. EN ;EP; -- main entry point for SD IHS APPT MADE BY;IHS/ITSC/LJF PATCH 1003
  1.  NEW VALMCNT
  1.  S VALMCC=1 D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BSDAM DISPLAY APPTS")
  1.  D CLEAR^VALM1,EXIT
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  NEW X
  1.  S VALMHDR(1)=$$SP(15)_$$CONF^BDGF
  1.  S X=$G(IORVON)_$$GET1^DIQ(2,DFN,.01)_$G(IORVOFF)
  1.  S X=$$PAD(X,40)_"#"_$$HRCN^BDGF2(DFN,+$G(DUZ(2)))
  1.  S X=$$PAD(X,52)_"DOB: "_$$GET1^DIQ(2,DFN,.03)
  1.  S VALMHDR(2)=$$PAD(X,69)_"Sex: "_$E($$GET1^DIQ(2,DFN,.02),1)
  1.  I $$DEAD^BDGF2(DFN) S VALMHDR(3)=$$SP(25)_$G(IORVON)_"** Patient Died on "_$$DOD^BDGF2(DFN)_" **"_$G(IORVOFF)
  1.  E  S VALMHDR(3)=$$PCLINE^SDPPTEM(DFN,DT)
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  ; variables set are DFN, BSDBD, BSDED
  1.  ; BSDLN keeps track of line #s to update VALMCNT which is returned
  1.  ; BSDNUM used to link display line with entry
  1.  NEW APDT,NODE,LINE,END,BSDNUM,BSDLN,X,BSDM,BSDU
  1.  K ^TMP("BSDDPA",$J)
  1.  ;
  1.  ; loop thru pat's appts in date range
  1.  S APDT=BSDBD,END=BSDED+.2400
  1.  F  S APDT=$O(^DPT(DFN,"S",APDT)) Q:'APDT!(APDT>END)  D
  1.  . S NODE=^DPT(DFN,"S",APDT,0)
  1.  . S LINE=$$PAD($$FMTE^XLFDT(APDT),20)                   ;appt dt
  1.  . S LINE=LINE_$$PAD($$GET1^DIQ(44,+NODE,.01),24)_" "    ;clinic
  1.  . S LINE=LINE_$$STATUS(DFN,APDT,NODE)                   ;type/status
  1.  . S BSDNUM=$G(BSDNUM)+1,LINE=$J(BSDNUM,2)_". "_LINE     ;add number
  1.  . S X=DFN_U_+NODE_U_APDT D SET(LINE,X,BSDNUM,.BSDLN)    ;set line
  1.  . D SET($$OI(DFN,+NODE,APDT),"",BSDNUM,.BSDLN)          ;other info
  1.  . I $P(NODE,U,2)["C",$G(^DPT(DFN,"S",APDT,"R"))]"" D
  1.  .. D SET($$SP(15)_"Cancel Remark: "_^DPT(DFN,"S",APDT,"R"),"",BSDNUM,.BSDLN)  ;cncl rmark
  1.  . D SET(" ","",BSDNUM,.BSDLN)                           ;blank line
  1.  ;
  1.  ;IHS/OIT/LJF 07/20/2005 PATCH 1004 added display of active waiting list entries for patient
  1.  K BSDWLR D WLDATA^BSDWLV(DFN,"C",.BSDWLR)
  1.  S:'$D(BSDNUM) BSDNUM=0 D SET(" ","",BSDNUM,.BSDLN)
  1.  ;
  1.  I '$O(BSDWLR(0)) D SET($$SP(10)_BSDWLR(0),"",BSDNUM,.BSDLN) I 1
  1.  E  D
  1.  . D SET($$SP(17)_"**** ACTIVE WAIT LIST ENTRIES FOR PATIENT ****","",BSDNUM,.BSDLN)
  1.  . D SET(BSDWLR(0),"",BSDNUM,.BSDLN)                   ;caption line
  1.  . D SET($$REPEAT^XLFSTR("-",77),"",BSDNUM,.BSDLN)     ;dividing line
  1.  . NEW DATE,LINE
  1.  . S DATE=0 F  S DATE=$O(BSDWLR(DATE)) Q:'DATE  D
  1.  . . S LINE=0 F  S LINE=$O(BSDWLR(DATE,LINE)) Q:'LINE  D
  1.  . . . D SET($S(LINE=1:"",1:$$SP(3))_$P(BSDWLR(DATE,LINE),U,2),"",BSDNUM,.BSDLN)
  1.  . D SET(" ","",BSDNUM,.BSDLN)    ;extra line for spacing
  1.  ;end of PATCH 1004 additions
  1.  ;
  1.  S VALMCNT=+$G(BSDLN)
  1.  Q
  1.  ;
  1. SET(LINE,DATA,NUM,BSDLN) ; -- set ^tmp with display line
  1.  S BSDLN=$G(BSDLN)+1
  1.  S ^TMP("BSDDPA",$J,BSDLN,0)=LINE
  1.  S ^TMP("BSDDPA",$J,"IDX",BSDLN,NUM)=DATA
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K BSDBD,BSDED,BSDLN,BSDNUM
  1.  K SDC,SDIFN,SDP,SDPP,SDS,SDSTAT,VALMY,ORX
  1.  K VALMBCK,VALMCNT,VALMHDR
  1.  D KILL^AUPNPAT
  1.  Q
  1.  ;
  1.  ;
  1. RETURN ; -- reset variables for return to lt
  1.  D TERM^VALM0 S VALMBCK="R" Q
  1.  ;
  1. GETAPPT(BSDSUB) ; -- select appt from listing
  1.  ; BSDSUB=subscript of display global
  1.  NEW X,Y,Z,BSDA
  1.  D FULL^VALM1
  1.  S BSDA=""
  1.  D EN^VALM2(XQORNOD(0),"OS")
  1.  I '$D(VALMY) S BSDSOME=0 Q
  1.  S BSDSOME=1
  1.  S (SDW,X)=$O(VALMY(0))
  1.  S Y=0 F  S Y=$O(^TMP(BSDSUB,$J,"IDX",Y)) Q:Y=""  Q:BSDA]""  D
  1.  . S Z=$O(^TMP(BSDSUB,$J,"IDX",Y,0))
  1.  . Q:^TMP(BSDSUB,$J,"IDX",Y,Z)=""
  1.  . I Z=X S BSDA=^TMP(BSDSUB,$J,"IDX",Y,Z)
  1.  Q:BSDA=""
  1.  S DFN=$P(BSDA,U),SDCL=$P(BSDA,U,2),SDT=$P(BSDA,U,3)
  1.  Q
  1.  ;
  1. VA ;EP; called by View Appt action
  1.  NEW DFN,SDCL,SDT,SDW
  1.  NEW BSDSOME
  1.  S SUB=$P(VALMAR,"""",2)
  1.  S (DFN,SDCL,SDT)="" D GETAPPT(SUB)
  1.  I (DFN="")!(SDCL="")!(SDT="") D  D RETURN Q
  1.  . Q:'BSDSOME
  1.  . W !,"Sorry data missing on this appointment!"
  1.  D EN^BSDAMEP
  1.  D RETURN
  1.  Q
  1.  ;
  1. VV ;EP; called by View Visit action
  1.  NEW DFN,SDCL,SDT,SDW
  1.  S SUB=$P(VALMAR,"""",2)
  1.  S (DFN,SDCL,SDT)="" D GETAPPT(SUB)
  1.  ;
  1.  I (DFN="")!(SDCL="")!(SDT="") D  D RETURN Q
  1.  . W !,"Sorry data missing on this appointment!"
  1.  . D PAUSE^BDGF
  1.  ;
  1.  S APCDPAT=DFN,APCDVSIT=$$GETVST(DFN,SDT)
  1.  I $P($G(^AUPNVSIT(+APCDVSIT,0)),U,5)'=DFN D  D RETURN Q
  1.  . W !,"Sorry, this appointment does not have a visit attached yet."
  1.  . D PAUSE^BDGF
  1.  ;
  1.  D ^APCDVD
  1.  K APCDCLN,APCDCAT,APCDDATE,APCDLOC,APCDPAT,APCDVSIT,APCDLOOK,APCDTYPE
  1.  D RETURN
  1.  Q
  1.  ;
  1. FINDUSR(PAT,CLINIC,DATE,BSDU,BSDM) ; -- gets user and date made from file 44
  1.  NEW X,Y
  1.  ; look in patient file first
  1.  S Y=$P(^DPT(PAT,"S",DATE,0),U,18,19)
  1.  I +Y S BSDU=$P(Y,U),BSDM=$P(Y,U,2) D FORMAT Q
  1.  ;
  1.  ; if not there, check file 44
  1.  K Y S X=0 F  S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:(X="")!($D(Y))  D
  1.  . I +^SC(CLINIC,"S",DATE,1,X,0)'=DFN Q
  1.  . S Y=$P(^SC(CLINIC,"S",DATE,1,X,0),U,6,7)
  1.  S BSDU=$P($G(Y),U)
  1.  S BSDM=$P($G(Y),U,2)
  1. FORMAT ; -- convert data to external format
  1.  S BSDU=$S(BSDU="":"??",1:$$GET1^DIQ(200,BSDU,1))
  1.  I $$RESVIEW,'$D(^XUSEC("SDZSUP",DUZ)) S BSDU=""  ;who made appt rstrctd
  1.  S BSDM=$S(BSDM="":"??",1:$$FMTE^XLFDT(BSDM,"D"))
  1.  Q
  1.  ;
  1. STATUS(PAT,DATE,NODE) ; returns appt status
  1.  NEW TYP
  1.  S TYP=$$APPTYP^BSDU2(PAT,DATE)    ;sched vs. walkin
  1.  I $P(NODE,U,2)["C" Q TYP_" - CANCELLED"
  1.  I $P(NODE,U,2)'="NT",$P(NODE,U,2)["N" Q TYP_" - NO SHOW"
  1.  I $$CO^BSDU2(PAT,+NODE,DATE) Q TYP_" - CHECKED OUT"
  1.  I $$CI^BSDU2(PAT,+NODE,DATE) Q TYP_" - CHECKED IN"
  1.  Q TYP
  1.  ;
  1. OI(PAT,CLINIC,DATE) ; -- returns other info display line
  1.  Q $$SP(15)_$E($$OI^BSDU2(PAT,CLINIC,DATE),1,65)
  1.  ;
  1. PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
  1.  Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
  1.  ;
  1. SP(N) ; -- SUBRTN to pad N number of spaces
  1.  Q $$PAD(" ",N)
  1.  ;
  1. RESVIEW() ; -- returns 1 if restrict viewing of who made appt turned on
  1.  Q +$$GET1^DIQ(9009020.2,$$DIV^BSDU,.12,"I")
  1.  ;
  1. GETVST(PAT,DATE) ; returns visit ien for appt date and patient
  1.  NEW X
  1.  I ('PAT)!('DATE) Q 0
  1.  S X=$G(^DPT(PAT,"S",DATE,0)) I 'X Q 0   ;appt node
  1.  S X=$P(X,U,20) I 'X Q 0                 ;outpt encounter ptr
  1.  S X=$G(^SCE(X,0)) I 'X Q 0              ;outpt encounter node
  1.  I $P(X,U,2)'=PAT Q 0                    ;patient ptr
  1.  Q $P(X,U,5)                             ;visit ptr