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

BRNU.m

Go to the documentation of this file. 
  1. BRNU ; IHS/OIT/LJF - UTILITY & FUNCTION CALLS
  1.  ;;2.0;RELEASE OF INFO SYSTEM;*1*;APR 10, 2003
  1.  ;IHS/OIT/LJF 10/19/2007 PATCH 1 Added this routine
  1.  ;
  1.  Q
  1.  ;
  1. READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN,DIRA) ;EP; calls reader, returns response
  1.  NEW DIR,Y,DIRUT
  1.  S DIR(0)=TYPE
  1.  I $E(TYPE,1)="P",$P(TYPE,":",2)["L" S DLAYGO=+$P(TYPE,U,2)
  1.  I $D(SCREEN) S DIR("S")=SCREEN
  1.  I $G(PROMPT)]"" S DIR("A")=PROMPT
  1.  I $G(DEFAULT)]"" S DIR("B")=DEFAULT
  1.  I $D(HELP) S DIR("?")=HELP
  1.  I $D(DIRA(1)) S Y=0 F  S Y=$O(DIRA(Y)) Q:Y=""  S DIR("A",Y)=DIRA(Y)
  1.  D ^DIR
  1.  Q Y
  1.  ;
  1. PAUSE ;EP; -- ask user to press return - no form feed
  1.  NEW DIR Q:IOST'["C-"
  1.  S DIR(0)="E",DIR("A")="Press ENTER to continue" D ^DIR
  1.  Q
  1.  ;
  1. ZIS(X,BRNRTN,BRNDESC,BRNVAR,BRNDEV) ;EP; -- called to select device and send print
  1.  K %ZIS,IOP,ZTIO
  1.  I X="F" D     ;forced queuing; no user interaction
  1.  . S ZTIO=BRNDEV,ZTDTH=$H
  1.  E  D   Q:POP  I '$D(IO("Q")) D @BRNRTN Q
  1.  . S %ZIS=X I $G(BRNDEV)]"" S %ZIS("B")=BRNDEV
  1.  . D ^%ZIS
  1.  ;
  1.  K IO("Q") S ZTRTN=BRNRTN,ZTDESC=BRNDESC
  1.  F I=1:1 S J=$P(BRNVAR,";",I) Q:J=""  S ZTSAVE(J)=""
  1.  D ^%ZTLOAD K ZTSK D ^%ZISC
  1.  Q
  1.  ;
  1. NAMEPRT(DFN,CONVERT) ;EP; return printable name
  1.  ;CONVERT=1 means convert to mixed case letters
  1.  NEW VADM,X
  1.  D DEM^VADPT
  1.  S X=$P($P(VADM(1),",",2)," ")_" "_$P(VADM(1),",")
  1.  I $G(CONVERT) X ^DD("FUNC",14,1)
  1.  Q X
  1.  ;
  1. XTMP(N,J,D) ;EP - set xtmp 0 node
  1.  Q:$G(N)=""  Q:'$G(J)
  1.  S ^XTMP(N,J,0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_$G(D)
  1.  Q
  1.  ;
  1. SUSPEND(IEN) ;EP; called by computed SUSPENDED DISCLOSURE field
  1.  NEW START,STOP
  1.  S START=$P($G(^BRNREC(IEN,24)),U,3) I START="" Q ""
  1.  S STOP=$P($G(^BRNREC(IEN,24)),U,4)
  1.  I (START'>DT)&((STOP="")!(STOP>DT)) Q "YES"
  1.  Q ""
  1.  ;
  1.  ;SUBROUTINES BASED ON NEW FACILITY FIELD
  1. ACTIVFAC(BRN,DA) ;EP - returns 1 if facility parameter entry is active
  1.  ; Called by screen on field FACILITY in ROI LISTING RECORD file
  1.  I '$D(^BRNPARM(BRN,0)) Q 0                                     ;not in file
  1.  I $P($G(^BRNPARM(BRN,0)),U,6)="" Q 1                           ;no inactivation date
  1.  I '$G(DA),$G(BRNBD) I $P(^BRNPARM(BRN,0),U,6)>(BRNBD-1) Q 1    ;if running RRU
  1.  I $P(^BRNPARM(BRN,0),U,6)>$P($G(^BRNREC(+$G(DA),0)),U) Q 1     ;inactivation date after request date
  1.  Q 0
  1.  ;
  1. USERFAC ;EP - checks if user's DUZ(2) matches an active facility
  1.  ;     in the ROI LISTING PARAMETER file
  1.  I '$G(DUZ(2)) W !,"NO DIVISION SET - CANNOT USE ROI" D PAUSE^BRNU S XQUIT=1 Q
  1.  I '$D(^BRNPARM("B",DUZ(2))) D  Q
  1.  . W !!,"Your DIVISION is NOT set to a facility defined in the ROI PARAMETERS"
  1.  . W !,"Therefore, you CANNOT perform any DATA ENTRY FUNCTIONS until either your"
  1.  . W !,"DIVISION is RESET OR the facility is ADDED to the ROI PARAMETERS file."
  1.  . D PAUSE^BRNU
  1.  . S XQUIT=1
  1.  ;
  1.  NEW X,IDATE
  1.  S X=$O(^BRNPARM("B",DUZ(2),0)),IDATE=$P($G(^BRNPARM(+X,0)),U,6)
  1.  I IDATE="" Q
  1.  I IDATE>DT Q
  1.  W !!,$$REPEAT^XLFSTR("* ",30)
  1.  W !,"Your DIVISION is set to a facilitiy that has been INACTIVATED in the"
  1.  W !,"in the ROI PARAMETER file.  You will ONLY be able to ADD requests"
  1.  W !,"with a request date BEFORE ",$$FMTE^XLFDT(IDATE),"."
  1.  W !,$$REPEAT^XLFSTR("* ",30),!
  1.  D PAUSE^BRNU
  1.  Q
  1.  ;
  1. FACOK(DATE) ;EP - returns 1 if DATE is before INACTIVATION DATE for
  1.  ; faciliy set to user's DUZ(2)
  1.  I '$D(^BRNPARM("B",DUZ(2))) Q 0
  1.  NEW X,IDATE
  1.  S X=$O(^BRNPARM("B",DUZ(2),0)),IDATE=$P($G(^BRNPARM(+X,0)),U,6)
  1.  I IDATE="" Q 1
  1.  I IDATE>DATE Q 1
  1.  Q 0
  1.  ;
  1. ASKFAC(BRNFAC) ;EP; returns BRNFAC variable set to facility choice
  1.  ; called using D ASKFAC^BRNU(.BRNFAC)
  1.  ; If only one facility in parameter file, BRNFAC=0
  1.  ; If user selected ALL facilities, BRNFAC=0
  1.  ; Else, BRNFAC=IEN of facility parameter entry chosen
  1.  ; OR if user ^ out or didn't choose, then BRNFAC=""
  1.  ;
  1.  I '$O(^BRNPARM(+$O(^BRNPARM(0)))) S BRNFAC=0 Q
  1.  NEW Y S Y=$$READ^BRNU("Y","Print for ALL Facilities","YES")
  1.  I Y=U S BRNFAC="" Q         ;^ out
  1.  I Y=1 S BRNFAC=0 Q          ;Yes to ALL facilities
  1.  S BRNFAC=+$$READ^BRNU("P^90264.2:AEMQZ","Select Facility")
  1.  I BRNFAC<1 S BRNFAC=""
  1.  Q