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

BSDNXAA.m

Go to the documentation of this file. 
  1. BSDNXAA ; IHS/ANMC/LJF - # DAYS TIL NEXT APPT ; 
  1.  ;;5.3;PIMS;**1010,1011**;APR 26, 2002
  1.  ;
  1.  ;
  1.  ;cmi/anch/maw 11/17/2008 PATCH 1010 put fix in NA per Walt Reisch for find of cancelled appointments
  1.  ;
  1. ASK ; -- ask user for clinics and device
  1.  NEW VAUTC,VAUTD,BSD3RD,POP
  1.  S BSD3RD=$$READ^BDGF("YO","Search for Next 3rd Available Appt.","","^D HELP1^BSDNXAA")
  1.  Q:BSD3RD=U  Q:BSD3RD=""
  1.  D CLINIC^BSDU(2) Q:$D(BSDQ)
  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^BSDNXAA","NEXT AVAIL APPT","VAUTC*;VAUTD*;BSD3RD")
  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 BSDRM NEXT AVAIL APPT
  1.  NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BSDRM NEXT AVAIL APPT")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  NEW ARRAY,CLINIC,PC,NAME
  1.  S VALMCNT=0 K ^TMP("BSDNXAA",$J),^TMP("BSDNXAA1",$J)
  1.  S ARRAY=$S(VAUTC:"^SC",1:"VAUTC")
  1.  S CLINIC=0
  1.  F  S CLINIC=$O(@ARRAY@(CLINIC)) Q:'CLINIC  D
  1.  . Q:'$$OKAY(CLINIC)                   ;quit if inactive clinic
  1.  . I $D(^SC("AIHSPC",CLINIC)) Q        ;quit if principal clinic
  1.  . S PC=$$PRIN^BSDU(CLINIC)            ;get princ clinic name
  1.  . S NAME=$$GET1^DIQ(44,CLINIC,.01)    ;clinic's name
  1.  . ;
  1.  . ; put in principal clinic order, then by clinic name
  1.  . S ^TMP("BSDNXAA1",$J,PC,NAME,CLINIC)=""
  1.  ;
  1.  I '$D(^TMP("BSDNXAA1",$J)) D SET("NONE FOUND",.VALMCNT) Q
  1.  ;
  1.  ; pull in sorted order and get display data
  1.  S PC=0 F  S PC=$O(^TMP("BSDNXAA1",$J,PC)) Q:PC=""  D
  1.  . D SET(PC,.VALMCNT)       ;principal clinic subheading
  1.  . S NAME=0 F  S NAME=$O(^TMP("BSDNXAA1",$J,PC,NAME)) Q:NAME=""  D
  1.  .. S CLINIC=0
  1.  .. F  S CLINIC=$O(^TMP("BSDNXAA1",$J,PC,NAME,CLINIC)) Q:'CLINIC  D
  1.  ... D SET($$DAY(CLINIC,NAME),.VALMCNT)  ;put into display global
  1.  ;
  1.  K ^TMP("BSDNXAA1",$J)
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("BSDNXAA",$J),VALMCNT,POP
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1.  ;
  1. DAY(CLN,NAME) ; -- loop visit days / clinic and print next appt
  1.  NEW BSDAY,LINE,BSD3CT
  1.  S LINE=$$PAD($$SP(26)_NAME,57)
  1.  S BSDAY=DT-.0001,BSD3CT=0
  1.  ; find next available appt
  1.  F  S BSDAY=$O(^SC(CLN,"ST",BSDAY)) Q:'BSDAY  Q:$$NA
  1.  ;
  1.  I 'BSDAY Q LINE_"none"   ;if none found, say so
  1.  ;
  1.  ; if found set line with date and # of days
  1.  Q $$PAD(LINE_$$FMTE^XLFDT(BSDAY),71)_$J($$D(BSDAY),2)_" days"
  1.  Q
  1.  ;
  1. NA() ; -- next appointment
  1.  NEW X,Y,Z,J
  1.  S Y=$O(^SC(CLN,"ST",BSDAY,0)) Q:'Y 0
  1.  I $D(^SC(CLN,"ST",BSDAY,"CAN")) Q 0  ;cmi/maw 11/17/2008 PATCH 1010 added per walt reisch find at PIMC dont count if cancelled
  1.  ;S X="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"  ;cmi/11/2/2009 PATCH 1011 orig line
  1.  S X="#@!$* ZYXXWVUTSRQPONMLKJIHGFEDCBAzyxwvutsrqponmlkjihgfedcba0123456789"  ;cmi/11/2/2009 PATCH 1011 add remaining letters to lower case
  1.  S Z=$E(^SC(CLN,"ST",BSDAY,Y),6,$L(^SC(CLN,"ST",BSDAY,Y)))
  1.  I BSD3RD F J=1:1:$L(Z) D
  1.  . I $E(X,$F(X,"0"),$L(X))[$E(Z,J) S:BSD3RD BSD3CT=BSD3CT+1
  1.  I 'BSD3RD F J=1:1:$L(Z) D
  1.  . I $E(X,$F(X,"0"),$L(X))[$E(Z,J) S J=999
  1.  Q $S(J=999:1,BSD3CT>2:1,1:0)
  1.  ;
  1. D(X1,X2,X) ; -- number of days from today
  1.  S X2=DT D ^%DTC Q X
  1.  ;
  1.  ;
  1. SET(DATA,NUM) ; -- set display data into global
  1.  S NUM=NUM+1
  1.  S ^TMP("BSDNXAA",$J,NUM,0)=DATA
  1.  Q
  1.  ;
  1. PRINT ; -- print display global to paper
  1.  U IO D HD
  1.  NEW X
  1.  S X=0 F  S X=$O(^TMP("BSDNXAA",$J,X)) Q:'X  D
  1.  . I $Y>(IOSL-4) D HD
  1.  . W !,^TMP("BSDNXAA",$J,X,0)
  1.  D ^%ZISC,EXIT,HOME^%ZIS
  1.  Q
  1.  ;
  1. HD ; -- heading
  1.  W @IOF,!!,?2,"Next Available Appointment by Principle Clinic"
  1.  W ?50,"Printed at ",$$FMTE^XLFDT($$NOW^XLFDT),!
  1.  Q
  1.  ;
  1. OKAY(C) ; -- active clinic? (yes=true)
  1.  NEW X
  1.  S X=$G(^SC(C,"I")) Q:'$D(^SC(C,"ST")) 0 Q:'$O(^("ST",DT)) 0
  1.  Q $S($P(^SC(C,0),U,3)'="C":0,'X:1,(DT>(X-1))&('$P(X,U,2)):0,1:1)
  1.  ;
  1. HELP1 ;EP; help for 3rd appt question
  1.  D MSG^BDGF("Answer YES to use the 3rd next available appointment",2,0)
  1.  D MSG^BDGF("in your calculations.  Some research has shown that",1,0)
  1.  D MSG^BDGF("using the 3rd next available appointment instead of",1,0)
  1.  D MSG^BDGF("the very next one, gives a clearer picture of the",1,0)
  1.  D MSG^BDGF("clinic schedule.",1,0)
  1.  D MSG^BDGF("Answer NO to use next available appointment.",2,1)
  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)