DGRUGU1 ;ALB/CMM - UTILITIES FOR CNH PAI ;04/17/96
;;5.3;Registration;**89,111,573**;Aug 13, 1993
;
;
SCREEN() ;This is the screen for LOCATION field in PAF file to allow only
;the selection of vendors who are under valid CNH contract.
;
N EN,FLAG
S FLAG=0
I $D(DA),$P($G(^DG(45.9,DA,0)),"^",6)'="3" Q FLAG
I ($P($G(^FBAAV(+Y,0)),"^",9)=5),$P($G(^("ADEL")),"^")'="Y" S FLAG=1
; ^ ptr to PARTCIPATION CODE file 5=CNH
Q FLAG
;
KSCREEN(Y) ;This is the screen to allow selected PAI to be deleted
;
N FLAG
S FLAG=0
I '$D(^DG(45.9,+Y,"C")) S FLAG=1
I $D(^DG(45.9,+Y,"C")),(+^DG(45.9,+Y,"C")<2)!(+^DG(45.9,+Y,"C")=5) S FLAG=1
I FLAG D
.S FLAG=0
.I ($D(^XUSEC("DG RUG SUPERVISOR",DUZ))) S FLAG=1 Q
.I $D(DGCNH),$P(^DG(45.9,+Y,0),"^",6)=3 S FLAG=1 Q
.I '$D(DGCNH),$P(^DG(45.9,+Y,0),"^",6)'=3 S FLAG=1 Q
Q FLAG
;
OSCREEN() ;This is the screen to allow selected PAI to be re-opened
;
N FLAG
S FLAG=0
I $D(^DG(45.9,+Y,"C")),"^2^4^"[("^"_+^DG(45.9,+Y,"C")_"^") S FLAG=1
I FLAG D
.S FLAG=0
.I ($D(^XUSEC("DG RUG SUPERVISOR",DUZ))) S FLAG=1 Q
.I $D(DGCNH),$P(^DG(45.9,+Y,0),"^",6)=3 S FLAG=1 Q
.I '$D(DGCNH),$P(^DG(45.9,+Y,0),"^",6)'=3 S FLAG=1 Q
Q FLAG
;
CSCREEN() ;This is the screen to allow selected PAI to be closed
;
N FLAG
S FLAG=0
I $D(^DG(45.9,+Y,"C")),(+^DG(45.9,+Y,"C")<2) S FLAG=1
I FLAG D
.S FLAG=0
.I ($D(^XUSEC("DG RUG SUPERVISOR",DUZ))) S FLAG=1 Q
.I $D(DGCNH),$P(^DG(45.9,+Y,0),"^",6)=3 S FLAG=1 Q
.I '$D(DGCNH),$P(^DG(45.9,+Y,0),"^",6)'=3 S FLAG=1 Q
Q FLAG
;
CHOSE() ;pick both CNH and Regular PAIs or one
;
N SEL
S DIR("A")="(C)NH, (R)egular PAIs, (B)oth: ",DIR("B")="B"
S DIR(0)="SAM^C:CNH;R:REGULAR PAIS;B:BOTH"
S DIR("?")="^D HELP^DGRUGU1"
D ^DIR S SEL=Y
I SEL=""!(SEL="^") Q -1
I SEL="R"!(SEL="B") D RUGWARD^DGRUGPP
I SEL="C"!(SEL="B") D RUGCNH
;
I $D(DGW) I SEL="R",'+$O(DGW(0)),'DGW Q -1
I $D(DGCL) I SEL="C"&('+$O(DGCL(0)))&'DGCL Q -1
I '$D(DGW)&'$D(DGCL) Q -1
I $D(DGW),$D(DGCL),(DGW'=1)&(DGCL'=1)&('+$O(DGCL(0)))&('+$O(DGW(0))) Q -1
Q "1^"_SEL
;
HELP ;
W !,"Enter C for contract nursing home",!,"Enter R for regular PAIs",!,"Enter B for both contract nursing home and regular PAIs.",!
Q
;
RUGCNH ;prompt for CNH locations
I '$D(DGCNH) S (DGCNH,DGFCNH)=""
S DIC="^FBAAV(",VAUTSTR="CNH location",VAUTVB="DGCL",DIC("S")="I $$SCREEN^DGRUGU1"
S VAUTNI=2
D FIRST^VAUTOMA
I $D(DGFCNH) K DGCNH,DGFCNH
K DIC,VAUTSTR,VAUTVB,VAUTNI
Q
;
PTSCREEN() ;screen for selecting patients from PAF file
;
N FLG
S FLG=0
I $D(DGCNH),$P($G(^DG(45.9,+Y,0)),"^",6)="3" S FLG=1
I '$D(DGCNH),$P($G(^DG(45.9,+Y,0)),"^",6)'="3" S FLG=1
I $D(DGFCNH),$P($G(^DG(45.9,+Y,0)),"^",6)'="3" S FLG=1
Q FLG
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRUGU1 2749 printed Dec 13, 2024@02:58:36 Page 2
DGRUGU1 ;ALB/CMM - UTILITIES FOR CNH PAI ;04/17/96
+1 ;;5.3;Registration;**89,111,573**;Aug 13, 1993
+2 ;
+3 ;
SCREEN() ;This is the screen for LOCATION field in PAF file to allow only
+1 ;the selection of vendors who are under valid CNH contract.
+2 ;
+3 NEW EN,FLAG
+4 SET FLAG=0
+5 IF $DATA(DA)
IF $PIECE($GET(^DG(45.9,DA,0)),"^",6)'="3"
QUIT FLAG
+6 IF ($PIECE($GET(^FBAAV(+Y,0)),"^",9)=5)
IF $PIECE($GET(^("ADEL")),"^")'="Y"
SET FLAG=1
+7 ; ^ ptr to PARTCIPATION CODE file 5=CNH
+8 QUIT FLAG
+9 ;
KSCREEN(Y) ;This is the screen to allow selected PAI to be deleted
+1 ;
+2 NEW FLAG
+3 SET FLAG=0
+4 IF '$DATA(^DG(45.9,+Y,"C"))
SET FLAG=1
+5 IF $DATA(^DG(45.9,+Y,"C"))
IF (+^DG(45.9,+Y,"C")<2)!(+^DG(45.9,+Y,"C")=5)
SET FLAG=1
+6 IF FLAG
Begin DoDot:1
+7 SET FLAG=0
+8 IF ($DATA(^XUSEC("DG RUG SUPERVISOR",DUZ)))
SET FLAG=1
QUIT
+9 IF $DATA(DGCNH)
IF $PIECE(^DG(45.9,+Y,0),"^",6)=3
SET FLAG=1
QUIT
+10 IF '$DATA(DGCNH)
IF $PIECE(^DG(45.9,+Y,0),"^",6)'=3
SET FLAG=1
QUIT
End DoDot:1
+11 QUIT FLAG
+12 ;
OSCREEN() ;This is the screen to allow selected PAI to be re-opened
+1 ;
+2 NEW FLAG
+3 SET FLAG=0
+4 IF $DATA(^DG(45.9,+Y,"C"))
IF "^2^4^"[("^"_+^DG(45.9,+Y,"C")_"^")
SET FLAG=1
+5 IF FLAG
Begin DoDot:1
+6 SET FLAG=0
+7 IF ($DATA(^XUSEC("DG RUG SUPERVISOR",DUZ)))
SET FLAG=1
QUIT
+8 IF $DATA(DGCNH)
IF $PIECE(^DG(45.9,+Y,0),"^",6)=3
SET FLAG=1
QUIT
+9 IF '$DATA(DGCNH)
IF $PIECE(^DG(45.9,+Y,0),"^",6)'=3
SET FLAG=1
QUIT
End DoDot:1
+10 QUIT FLAG
+11 ;
CSCREEN() ;This is the screen to allow selected PAI to be closed
+1 ;
+2 NEW FLAG
+3 SET FLAG=0
+4 IF $DATA(^DG(45.9,+Y,"C"))
IF (+^DG(45.9,+Y,"C")<2)
SET FLAG=1
+5 IF FLAG
Begin DoDot:1
+6 SET FLAG=0
+7 IF ($DATA(^XUSEC("DG RUG SUPERVISOR",DUZ)))
SET FLAG=1
QUIT
+8 IF $DATA(DGCNH)
IF $PIECE(^DG(45.9,+Y,0),"^",6)=3
SET FLAG=1
QUIT
+9 IF '$DATA(DGCNH)
IF $PIECE(^DG(45.9,+Y,0),"^",6)'=3
SET FLAG=1
QUIT
End DoDot:1
+10 QUIT FLAG
+11 ;
CHOSE() ;pick both CNH and Regular PAIs or one
+1 ;
+2 NEW SEL
+3 SET DIR("A")="(C)NH, (R)egular PAIs, (B)oth: "
SET DIR("B")="B"
+4 SET DIR(0)="SAM^C:CNH;R:REGULAR PAIS;B:BOTH"
+5 SET DIR("?")="^D HELP^DGRUGU1"
+6 DO ^DIR
SET SEL=Y
+7 IF SEL=""!(SEL="^")
QUIT -1
+8 IF SEL="R"!(SEL="B")
DO RUGWARD^DGRUGPP
+9 IF SEL="C"!(SEL="B")
DO RUGCNH
+10 ;
+11 IF $DATA(DGW)
IF SEL="R"
IF '+$ORDER(DGW(0))
IF 'DGW
QUIT -1
+12 IF $DATA(DGCL)
IF SEL="C"&('+$ORDER(DGCL(0)))&'DGCL
QUIT -1
+13 IF '$DATA(DGW)&'$DATA(DGCL)
QUIT -1
+14 IF $DATA(DGW)
IF $DATA(DGCL)
IF (DGW'=1)&(DGCL'=1)&('+$ORDER(DGCL(0)))&('+$ORDER(DGW(0)))
QUIT -1
+15 QUIT "1^"_SEL
+16 ;
HELP ;
+1 WRITE !,"Enter C for contract nursing home",!,"Enter R for regular PAIs",!,"Enter B for both contract nursing home and regular PAIs.",!
+2 QUIT
+3 ;
RUGCNH ;prompt for CNH locations
+1 IF '$DATA(DGCNH)
SET (DGCNH,DGFCNH)=""
+2 SET DIC="^FBAAV("
SET VAUTSTR="CNH location"
SET VAUTVB="DGCL"
SET DIC("S")="I $$SCREEN^DGRUGU1"
+3 SET VAUTNI=2
+4 DO FIRST^VAUTOMA
+5 IF $DATA(DGFCNH)
KILL DGCNH,DGFCNH
+6 KILL DIC,VAUTSTR,VAUTVB,VAUTNI
+7 QUIT
+8 ;
PTSCREEN() ;screen for selecting patients from PAF file
+1 ;
+2 NEW FLG
+3 SET FLG=0
+4 IF $DATA(DGCNH)
IF $PIECE($GET(^DG(45.9,+Y,0)),"^",6)="3"
SET FLG=1
+5 IF '$DATA(DGCNH)
IF $PIECE($GET(^DG(45.9,+Y,0)),"^",6)'="3"
SET FLG=1
+6 IF $DATA(DGFCNH)
IF $PIECE($GET(^DG(45.9,+Y,0)),"^",6)'="3"
SET FLG=1
+7 QUIT FLG
