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

BSDOAS.m

Go to the documentation of this file. 
  1. BSDOAS ; cmi/anch/maw - Original Clinic Availability Setup ;  [ 01/02/2004  10:48 AM ]
  1.  ;;5.3;PIMS;**1007**;FEB 27, 2007
  1.  ;
  1.  ;cmi/anch/maw 2/23/2007 added option for PATCH 1007 item 1007.32
  1.  ;
  1. ASK ; ask clinic and set variables
  1.  S BSDD=$$READ^BDGF("D^::EX","Select Date") Q:'BSDD
  1.  ;
  1.  ; get clinic arrays based on subtotal category
  1.  D CLINIC^BSDU(2) Q:$D(BSDQ)
  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^BSDOAS","ORIGINAL AVAILABILITY SETUP","BSDD;VAUTC*;VAUTD*")
  1.  Q
  1.  ;
  1. START ;EP; -- re-entry for printing to paper
  1.  D INIT,PRINT Q
  1.  ;
  1. EN ;EP; -- main entry point for month-at-a-glance list templates
  1.  NEW VALMCNT,DIR,DIC
  1.  ;BSDANS = answer to date to start display
  1.  S VALMCC=1    ;1=screen mode, 0=scrolling mode
  1.  D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BSDAM ORIGINAL CLINIC DISPLAY")
  1.  Q
  1.  ;
  1. HDR ;EP; -- header code
  1.  S VALMHDR(1)=$$SP(23)_"Original Availability Setup Display"
  1.  S VALMHDR(2)=$$SP(30)_"For date: "_$$FMTE^XLFDT(BSDD)
  1.  Q
  1.  ;
  1. INIT ;EP; -- init variables and list array
  1.  S VALMCNT=0 K ^TMP("BSDM",$J),^TMP("BSD",$J)
  1.  NEW BSDAR S BSDAR=$S(VAUTC:"^SC",1:"VAUTC")
  1.  S BSDIOM=150,BSDTOT=BSDIOM-15  ;used in place of 80 & 65 below
  1.  ;
  1.  ; -- loop by clinic
  1.  NEW CLN,NAME,BSDS,BSDSCD,BSDPC,BSDH,BSDCS
  1.  S CLN=0 F  S CLN=$O(@BSDAR@(CLN)) Q:'CLN  D
  1.  . Q:'$$GET1^DIQ(44,CLN,3.5,"I")  ;No Div entered for this clinic
  1.  . I $D(VAUTD) Q:(VAUTD'=1&('$D(VAUTD($$GET1^DIQ(44,CLN,3.5,"I")))))  ;this Div notd
  1.  . S NAME=$$GET1^DIQ(44,CLN,.01)         ;set clinic's name
  1.  . I $D(^SC("AIHSPC",CLN)) D  Q               ;quit if principal clinic
  1.  .. D SET("PRINCIPAL CLINIC: "_NAME_" - "_$$FMTE^XLFDT(BSDD),.VALMCNT)
  1.  . S BSDSCD=$$GET1^DIQ(44,CLN,8)         ;clinic code
  1.  . S BSDPC=$$GET1^DIQ(44,CLN,1916)       ;principal clinic
  1.  . S BSDCS=$P($G(^SC(CLN,"SL")),U,3)
  1.  . N BSDPTR
  1.  . I $D(^SC(CLN,"OST",BSDD,1)) D
  1.  .. S BSDPTR=$G(^SC(CLN,"OST",BSDD,1))
  1.  . I '$D(^SC(CLN,"OST",BSDD,1)) D
  1.  .. S BSDPTR=$$UP^XLFSTR($E($$DOW(BSDD,""),1,2))_" "_$E(BSDD,6,7)_"  "_$G(^SC(CLN,$$DOWN(BSDD),9999999,1))
  1.  . D SET(NAME_" - "_$$FMTE^XLFDT(BSDD),.VALMCNT)
  1.  . S LINE=" TIME  " F Y=BSDCS:1:BSDTOT\16+BSDCS S LINE=LINE_$E("|"_$S('Y:0,1:(Y-1#12+1))_"                 ",1,8)
  1.  . D SET(LINE,.VALMCNT)
  1.  . S LINE=" DATE  |"
  1.  . D SET(LINE,.VALMCNT)
  1.  . D SET(BSDPTR,.VALMCNT)
  1.  . D SET("",.VALMCNT)
  1.  ;
  1.  ; add legend to display to explain 1s, 0s, As, Bs, *s, etc.
  1.  S VALMCNT=VALMCNT+1,^TMP("BSDM",$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.  . D SET(BSDX(X),.VALMCNT)
  1.  ;
  1.  K ^TMP("BSD",$J)
  1.  Q
  1.  ;
  1. WMH ;Write month heading lines
  1.  W !!," TIME",?7 F Y=BSDCS:1:BSDTOT\16+BSDCS W $E("|"_$S('BSDD:0,1:(BSDD-1#12+1))_"                 ",1,8)
  1.  W !," DATE",?7,"|"
  1.  F Y=1:1:BSDTOT\(8) W $J("|",8)
  1.  S BSDCNT=0   ;reset count after printing time headings
  1.  Q
  1.  ;
  1. SET(LINE,NUM) ; -- sets display line into array
  1.  S NUM=NUM+1
  1.  S ^TMP("BSDM",$J,NUM,0)=LINE
  1.  Q
  1.  ;
  1. HELP ;EP; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ;EP; -- exit code
  1.  D CLEAR^VALM1
  1.  K ^TMP("BSDM",$J)
  1.  S VALMNOFF=1  ;suppress form feed before next question
  1.  Q
  1.  ;
  1. EXPND ;EP; -- expand code
  1.  Q
  1.  ;
  1. PAUSE ; -- end of action pause
  1.  D PAUSE^BDGF Q
  1.  ;
  1. DT W $$FMTE^XLFDT(Y) Q
  1.  ;
  1. DOW(X,F) Q $$DOW^XLFDT(X,F)
  1.  ;
  1. DOWN(DOW) ;-- get the node to display for Day of Week
  1.  S DOW=$$DOW^XLFDT(DOW,1)
  1.  Q "T"_DOW
  1.  ;
  1. HELP1 ;EP; help for print individual dates question
  1.  D MSG^BDGF("The report will display the Original,",2,0)
  1.  D MSG^BDGF("Availability Setup based on the date.",1,0)
  1.  D MSG^BDGF("passed in.",1,1)
  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("BSDM",$J,X)) Q:'X  D
  1.  . I $Y>(IOSL-4) D HDG
  1.  . W !,^TMP("BSDM",$J,X,0)
  1.  D ^%ZISC,EXIT
  1.  Q
  1.  ;
  1. HDG ; heading for paper report
  1.  D HDR W @IOF,?30,"Original Availability Setup"
  1.  F I=1:1 Q:'$D(VALMHDR(I))  W !,VALMHDR(I)
  1.  W !,$$REPEAT^XLFSTR("-",80)
  1.  W !,"Clinic Pattern"
  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)
  1.  ;
  1. END D KVAR^VADPT K SDAPTYP,SDSC,%,%DT,ASKC,COV,DA,DIC,DIE,DP,DR
  1.  K HEY,HSI,HY,J,SB,SC,SDDIF,SDJ,SDLN,SD17,SDMAX,SDU,SDYC,SI,SL
  1.  K SSC,STARTDAY,STR,SDZPR,WY,X,XX,Y,S,SD,SDAP16,SDEDT,SDTY,SM
  1.  K SS,ST,ARG,CCX,CCXN,HX,I,PXR,SDINA,SDW,COLLAT,SDDIS,SDMM,SDMLT1
  1.  K SDAV,SDHX,SDSOH,SDT
  1.  Q