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

BSDPC.m

Go to the documentation of this file. 
  1. BSDPC ; IHS/ITSC/LJF,WAR - 1ST AVAIL APPT FOR PRIN CLINIC ; [ 08/20/2004  11:54 AM ]
  1.  ;;5.3;PIMS;**1001,1004,1005,1013**;MAY 28, 2004
  1.  ;IHS/ITSC/WAR 07/30/2004 PATCH 1001 check for undef of VALMCNT
  1.  ;IHS/OIT/LJF  07/15/2005 PATCH 1004 fixed heading & spacing
  1.  ;IHS/OIT/LJF  12/30/2005 PATCH 1005 removed 3 day restriction; fix to heading
  1.  ;ihs/cmi/maw  04/06/2011 PATCH 1013 added code to sort print clinic alphabetically
  1.  ;
  1. EN ;EP; called by SDM with SDPC set
  1.  NEW SDAY,SDX,SDN,SDD,Y,Z,SDSLOT
  1.  S %DT="AE",%DT("A")="Enter EARLIEST POSSIBLE APPT DATE: "
  1.  S %DT("B")="TODAY",X="" D ^%DT Q:Y<1  S SDAY=Y
  1.  ;
  1.  S %DT="AE",%DT("A")="Enter LATEST POSSIBLE APPT DATE: "
  1.  S %DT("B")="T+15",X="" D ^%DT Q:Y<1  S SDEND=Y+.2400 W !!
  1.  ;
  1.  NEW VALMCNT
  1.  S VALMCC=1 ;1=screen mode, 0=scrolling mode
  1.  D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BSDAM PRIN CLN AVAIL")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ;EP; -- header code
  1.  S VALMHDR(1)=$$GET1^DIQ(44,SDPC,.01)  ;prin cln name
  1.  Q
  1.  ;
  1. INIT ;EP; -- init variables and list array
  1.  K ^TMP("BSDPC",$J),^TMP("BSDPC1",$J)
  1.  D GUIR^XBLM("SC^BSDPC","^TMP(""BSDPC1"",$J,")
  1.  S X=0 F  S X=$O(^TMP("BSDPC1",$J,X)) Q:'X  D
  1.  . S VALMCNT=X
  1.  . S ^TMP("BSDPC",$J,X,0)=^TMP("BSDPC1",$J,X)
  1.  ;
  1.  ; add legend to display to explain 1s, 0s, As, Bs, *s, etc.
  1.  ;IHS/ITSC/WAR 7/30/04 PATCH #1001 found/corrected by AEF
  1.  ;S VALMCNT=VALMCNT+1,^TMP("BSDPC",$J,VALMCNT,0)=""  ;extra line
  1.  S VALMCNT=$G(VALMCNT)+1,^TMP("BSDPC",$J,VALMCNT,0)=""  ;extra line
  1.  NEW BSDX D LEGEND^BSDU(.BSDX)
  1.  S X=0 F  S X=$O(BSDX(X)) Q:'X  D
  1.  . ;IHS/ITSC/WAR 7/30/04 PATCH #1001 found/corrected by AEF
  1.  . ;S VALMCNT=VALMCNT+1,^TMP("BSDPC",$J,VALMCNT,0)=BSDX(X)
  1.  . S VALMCNT=$G(VALMCNT)+1,^TMP("BSDPC",$J,VALMCNT,0)=BSDX(X)
  1.  ;
  1.  K ^TMP("BSDPC1",$J)
  1.  Q
  1.  ;
  1. HELP ;EP; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ;EP; -- exit code
  1.  K ^TMP("BSDPC",$J) D CLEAN^VALM10
  1.  S VALMNOFF=1  ;suppress form feed 
  1.  Q
  1.  ;
  1. EXPND ;EP; -- expand code
  1.  Q
  1.  ;
  1. PAUSE ; -- end of action pause
  1.  D PAUSE^BDGF Q
  1.  ;
  1. RESET ; -- update partition for return to list manager
  1.  I $D(VALMQUIT) S VALMBCK="Q" Q
  1.  D TERM^VALM0 S VALMBCK="R"
  1.  D INIT,HDR Q
  1.  ;
  1. RESET2 ; -- update partition without recreating display array
  1.  I $D(VALMQUIT) S VALMBCK="Q" Q
  1.  D TERM^VALM0 S VALMBCK="R" D HDR Q
  1.  ;
  1.  ;
  1. SC ;EP; entry point to gather available appts from each clinic
  1.  NEW SDN,SDCNT,SDD,SDSLOT,SDX,Z,NDA
  1.  N CLNORD
  1.  NEW BSDIOM,BSDTOT S BSDIOM=150,BSDTOT=BSDIOM-15  ;used in place of 80 & 65;IHS/OIT/LJF 7/15/2005 PATCH 1004
  1.  ;ihs/cmi/maw 04/06/2011 PATCH 1013 RQMT153 added next 6 lines to sort alpha
  1.  ;S SDN=0 F  S SDN=$O(^SC("AIHSPC",SDPC,SDN)) Q:'SDN  D DAY
  1.  S NDA=0 F  S NDA=$O(^SC("AIHSPC",SDPC,NDA)) Q:'NDA  D
  1.  . S (CLNORD($P(^SC(NDA,0),U),NDA))=""
  1.  N CDA,SDN
  1.  S CDA=0 F  S CDA=$O(CLNORD(CDA)) Q:CDA=""  D
  1.  . S SDN=0 F  S SDN=$O(CLNORD(CDA,SDN)) Q:'SDN  D
  1.  .. D DAY
  1.  ;ihs/cmi/maw 04/06/2011 end of mods
  1.  W ! Q
  1.  ;
  1. HD ;Write month heading lines
  1.  ;IHS/OIT/LJF 7/15/2005 PATCH 1004 rewrote so each clinic has correct heading & spacing
  1.  NEW SI,SL,STARTDAY,SC,Y,J   ;IHS/OIT/LJF 12/30/2005 PATCH 1005 needed one more tweak
  1.  S SI=$P($G(^SC(SDN,"SL")),U,6),SI=$S(SI<3:4,1:SI)
  1.  I $G(STARTDAY)="" D
  1.  .S SL=$G(^SC(+SDN,"SL")),X=$P(SL,U,3),STARTDAY=$S(X:X,1:8),SC=+SDN
  1.  W !!,?16,"TIME",?SI+SI-1 F Y=STARTDAY:1:BSDTOT\(SI+SI)+STARTDAY W $E("|"_$S('Y:0,1:(Y-1#12+1))_"                 ",1,SI+SI)
  1.  W !,?16,"DATE",?SI+SI-1,"|" K J F Y=0:1:6 I $D(^SC(+SDN,"T"_Y)) S J(Y)=""
  1.  F Y=1:1:BSDTOT\(SI+SI) W $J("|",SI+SI)
  1.  Q
  1.  ;
  1.  ;IHS/OIT/LJF 12/30/2005 PATCH 1005 rewrote so display goes to End date, not just 1st 3 dates
  1. DAY S SDD=SDAY-.001,Z="",SDSLOT=0,SDCNT=0
  1.  ;F  S SDD=$O(^SC(SDN,"ST",SDD)) Q:'SDD  Q:SDD>SDEND  Q:SDCNT=3  D
  1.  F  S SDD=$O(^SC(SDN,"ST",SDD)) Q:'SDD  Q:SDD>SDEND  D
  1.  . S SDX=0
  1.  . ;F  S SDX=$O(^SC(SDN,"ST",SDD,SDX)) Q:'SDX  Q:SDCNT=3  D
  1.  . F  S SDX=$O(^SC(SDN,"ST",SDD,SDX)) Q:'SDX  D
  1.  .. S Z=$E(^SC(SDN,"ST",SDD,SDX),6,$L(^SC(SDN,"ST",SDD,SDX)))
  1.  .. Q:Z["CANCELLED"
  1.  .. I (Z'["|"),(Z'["[") Q
  1.  .. S SDSLOT=$TR(Z,"|[@#]!$* ABCDEFXjklmno",0)
  1.  .. Q:+SDSLOT<1                                   ;no appt slots found
  1.  .. I SDCNT=0 D HD W !,$P(^SC(SDN,0),U,1)         ;display times & clinic name
  1.  .. S Y=$$FMTE^XLFDT(SDD)                         ;printable date
  1.  .. W !,Y,?15
  1.  .. I $E(^SC(SDN,"ST",SDD,SDX),6,7)'="  " D
  1.  ... W ^SC(SDN,"ST",SDD,SDX)
  1.  .. E  D
  1.  ... W $E(^SC(SDN,"ST",SDD,SDX),1,5),$E(^SC(SDN,"ST",SDD,SDX),8,120)
  1.  .. S SDCNT=SDCNT+1                              ;keep count so know when to print heading
  1.  Q