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