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

BSDAMR4.m

Go to the documentation of this file. 
  1. BSDAMR4 ;cmi/anch/maw - BSD Appointment Management Reports Cancelled Appointment Listing 2/12/2007 1:22:04 PM
  1.  ;;5.3;PIMS;**1007,1014,1016**;DEC 01, 2006;Build 20
  1.  ;
  1.  ;cmi/anch/maw new report for PATCH 1007 item 1007.19
  1.  ;
  1. ASK ; -- ask user questions
  1.  NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDSUB,BSDTT,BSDSTAT,BSDSTE
  1.  D EXIT
  1.  ;
  1.  S BSDSUB="Clinic"
  1.  ;
  1.  ; get clinic arrays based on subtotal category
  1.  D CLINIC^BSDU(2) Q:$D(BSDQ)
  1.  ;
  1.  S BSDBD=$$READ^BDGF("DO^::EX","Select First Date to Search") Q:'BSDBD
  1.  S BSDED=$$READ^BDGF("DO^::EX","Select Last Date to Search") Q:'BSDED
  1.  ;
  1.  S BSDSTAT=$$READ^BDGF("S^C:Clinic;P:Patient","Cancelled By","Clinic")
  1.  I BSDSTAT="C" S BSDSTAT("C")="",BSDSTAT("CA")="",BSDSTE="Clinic"
  1.  I BSDSTAT="P" S BSDSTAT("PC")="",BSDSTAT("PCA")="",BSDSTE="Patient"
  1.  ;
  1.  ;
  1.  S Y=$$BROWSE^BDGF Q:"PB"'[Y  I Y="B" D EN Q  ;browse in list mgr mode
  1.  D ZIS^BDGF("PQ","START^BSDAMR4","APPT CAN","BSDSUB;BSDBD;BSDED;BSDSTE;.BSDSTAT;VAUTC*;VAUTD*")
  1.  Q
  1.  ;
  1. START ;EP; -- re-entry for printing to paper
  1.  D INIT,PRINT Q
  1.  ;
  1. EN ; -- main entry point for BSDRM APPT MGT NO ACTION
  1.  NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BSDRM APPT MGT CAN")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  S VALMHDR(1)=$$SP(15)_$$CONF^BSDU
  1.  S VALMHDR(2)=$$SP(20)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)
  1.  S VALMHDR(3)=$$SP(30)_"Cancelled by: "_BSDSTE
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  S VALMCNT=0 K ^TMP("BSDAMR4",$J),^TMP("BSD",$J)
  1.  NEW BSDAR S BSDAR=$S(VAUTC:"^SC",1:"VAUTC")
  1.  ;
  1.  ; -- loop by clinic
  1.  NEW BSDDFN,CLN,NAME,SUB,APPT,PAT,END,LINE,BSDREAI,BSDCANR
  1.  S BSDDFN=0
  1.  F  S BSDDFN=$O(^DPT(BSDDFN)) Q:'BSDDFN  D
  1.  . N BSDIEN
  1.  . S BSDIEN=0 F  S BSDIEN=$O(^DPT(BSDDFN,"S",BSDIEN)) Q:BSDIEN=""  D
  1.  .. Q:BSDIEN<(BSDBD-.0001)  ;quit if date is before selected
  1.  .. Q:BSDIEN>(BSDED+.9999)  ;quit if date is after selected
  1.  .. S CLN=$P($G(^DPT(BSDDFN,"S",BSDIEN,0)),U)  ;get clinic ien
  1.  .. Q:'$D(@BSDAR@(CLN))                  ;quit if clinic wasn't picked
  1.  .. Q:$D(^SC("AIHSPC",CLN))               ;quit if principal clinic
  1.  .. N BSDST
  1.  .. S BSDST=$P($G(^DPT(BSDDFN,"S",BSDIEN,0)),U,2)
  1.  .. Q:$G(BSDST)=""
  1.  .. Q:'$D(BSDSTAT(BSDST))               ;quit if they do not select the type of cancellation by clinic or patient
  1.  .. S NAME=$$GET1^DIQ(44,CLN,.01)         ;set clinic's name
  1.  .. S SUB=$$SUB1^BSDWKR1(CLN,NAME)        ;get subcategory for clinic
  1.  .. I '$G(VAUTD) Q:'$D(VAUTD(+$P($G(^SC(CLN,0)),U,15)))  ;cmi/anch/maw 11/22/06 added to screen on division item 1007.17 patch 1007
  1.  .. S BSDREAI=$P($G(^DPT(BSDDFN,"S",BSDIEN,0)),U,15)
  1.  .. I $G(BSDREAI) S BSDREA=$$GET1^DIQ(409.2,BSDREAI,.01)
  1.  .. S BSDCANR=$G(^DPT(BSDDFN,"S",BSDIEN,"R"))
  1.  .. I BSDCANR]"" S BSDCANR="("_BSDCANR_")"
  1.  .. S PAT=BSDDFN
  1.  .. ; put appts into display array
  1.  .. S LINE=$$PAD($E($$GET1^DIQ(2,PAT,.01),1,18),18)          ;patient name
  1.  .. S LINE=LINE_$J($$HRCN^BDGF2(PAT,$$FAC^BSDU(CLN)),7)   ;chart#
  1.  .. S LINE=$$PAD(LINE,27)_$$GET1^DIQ(2,PAT,.131)       ;phone
  1.  .. S LINE=$$PAD(LINE,42)_$$FMTE^XLFDT(BSDIEN)            ;appt date
  1.  .. S LINE=$$PAD(LINE,62)_$S($G(BSDREA)]"":BSDREA_" "_BSDCANR,1:"")         ;reason for appoinTment
  1.  .. S ^TMP("BSD",$J,SUB,PAT,BSDIEN)=LINE  ;sort by category,clinic,date
  1.  ;
  1.  ; put sorted list into display array
  1.  NEW S1,S2,S3
  1.  S S1=0 F  S S1=$O(^TMP("BSD",$J,S1)) Q:S1=""  D
  1.  . D SET(S1,.VALMCNT)
  1.  . S S2=0 F  S S2=$O(^TMP("BSD",$J,S1,S2)) Q:S2=""  D
  1.  .. ;I S1'=S2 D SET($$SP(2)_S2,.VALMCNT)
  1.  .. S S3=0 F  S S3=$O(^TMP("BSD",$J,S1,S2,S3)) Q:S3=""  D
  1.  ... D SET(^TMP("BSD",$J,S1,S2,S3),.VALMCNT)
  1.  .. I S1'=S2 D SET("",.VALMCNT)
  1.  . D SET("",.VALMCNT)
  1.  ;
  1.  K ^TMP("BSD",$J)
  1.  Q
  1.  ;
  1. SET(LINE,NUM) ; set line into display array
  1.  S NUM=NUM+1
  1.  S ^TMP("BSDAMR4",$J,NUM,0)=LINE
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("BSDAMR4",$J)
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. PRINT ; print report to paper
  1.  U IO D HDG
  1.  NEW X S X=0 F  S X=$O(^TMP("BSDAMR4",$J,X)) Q:'X  D
  1.  . I $Y>(IOSL-4) D HDG
  1.  . W !,^TMP("BSDAMR4",$J,X,0)
  1.  D ^%ZISC,EXIT
  1.  Q
  1.  ;
  1. HDG ; heading for paper report
  1.  D HDR W @IOF,?33,"Cancelled Appointment Listing"
  1.  F I=1:1 Q:'$D(VALMHDR(I))  W !,VALMHDR(I)
  1.  W !,$$REPEAT^XLFSTR("-",80)
  1.  W !,"Patient Name",?20,"HRCN",?28,"Phone",?43,"Appt Date",?63,"Reason"
  1.  W !,$$REPEAT^XLFSTR("=",80)
  1.  Q
  1.  ;
  1. PAD(D,L) ;EP -- SUBRTN to pad length of data
  1.  ; -- D=data L=length
  1.  Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
  1.  ;
  1. SP(N) ; -- SUBRTN to pad N number of spaces
  1.  Q $$PAD(" ",N)