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

DGRUGU1.m

Go to the documentation of this file. 
  1. DGRUGU1 ;ALB/CMM - UTILITIES FOR CNH PAI ;04/17/96
  1.  ;;5.3;Registration;**89,111,573,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  ;
  1. 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.
  1.  ;
  1.  N EN,FLAG
  1.  S FLAG=0
  1.  I $D(DA),$P($G(^DG(45.9,DA,0)),"^",6)'="3" Q FLAG
  1.  I ($P($G(^FBAAV(+Y,0)),"^",9)=5),$P($G(^("ADEL")),"^")'="Y" S FLAG=1
  1.  ;  ^ ptr to PARTCIPATION CODE file 5=CNH
  1.  Q FLAG
  1.  ;
  1. KSCREEN(Y) ;This is the screen to allow selected PAI to be deleted
  1.  ;
  1.  N FLAG
  1.  S FLAG=0
  1.  I '$D(^DG(45.9,+Y,"C")) S FLAG=1
  1.  I $D(^DG(45.9,+Y,"C")),(+^DG(45.9,+Y,"C")<2)!(+^DG(45.9,+Y,"C")=5) S FLAG=1
  1.  I FLAG D
  1.  .S FLAG=0
  1.  .I ($D(^XUSEC("DG RUG SUPERVISOR",DUZ))) S FLAG=1 Q
  1.  .I $D(DGCNH),$P(^DG(45.9,+Y,0),"^",6)=3 S FLAG=1 Q
  1.  .I '$D(DGCNH),$P(^DG(45.9,+Y,0),"^",6)'=3 S FLAG=1 Q
  1.  Q FLAG
  1.  ;
  1. OSCREEN() ;This is the screen to allow selected PAI to be re-opened
  1.  ;
  1.  N FLAG
  1.  S FLAG=0
  1.  I $D(^DG(45.9,+Y,"C")),"^2^4^"[("^"_+^DG(45.9,+Y,"C")_"^") S FLAG=1
  1.  I FLAG D
  1.  .S FLAG=0
  1.  .I ($D(^XUSEC("DG RUG SUPERVISOR",DUZ))) S FLAG=1 Q
  1.  .I $D(DGCNH),$P(^DG(45.9,+Y,0),"^",6)=3 S FLAG=1 Q
  1.  .I '$D(DGCNH),$P(^DG(45.9,+Y,0),"^",6)'=3 S FLAG=1 Q
  1.  Q FLAG
  1.  ;
  1. CSCREEN() ;This is the screen to allow selected PAI to be closed
  1.  ;
  1.  N FLAG
  1.  S FLAG=0
  1.  I $D(^DG(45.9,+Y,"C")),(+^DG(45.9,+Y,"C")<2) S FLAG=1
  1.  I FLAG D
  1.  .S FLAG=0
  1.  .I ($D(^XUSEC("DG RUG SUPERVISOR",DUZ))) S FLAG=1 Q
  1.  .I $D(DGCNH),$P(^DG(45.9,+Y,0),"^",6)=3 S FLAG=1 Q
  1.  .I '$D(DGCNH),$P(^DG(45.9,+Y,0),"^",6)'=3 S FLAG=1 Q
  1.  Q FLAG
  1.  ;
  1. CHOSE() ;pick both CNH and Regular PAIs or one
  1.  ;
  1.  N SEL
  1.  S DIR("A")="(C)NH, (R)egular PAIs, (B)oth: ",DIR("B")="B"
  1.  S DIR(0)="SAM^C:CNH;R:REGULAR PAIS;B:BOTH"
  1.  S DIR("?")="^D HELP^DGRUGU1"
  1.  D ^DIR S SEL=Y
  1.  I SEL=""!(SEL="^") Q -1
  1.  I SEL="R"!(SEL="B") D RUGWARD^DGRUGPP
  1.  I SEL="C"!(SEL="B") D RUGCNH
  1.  ;
  1.  I $D(DGW) I SEL="R",'+$O(DGW(0)),'DGW Q -1
  1.  I $D(DGCL) I SEL="C"&('+$O(DGCL(0)))&'DGCL Q -1
  1.  I '$D(DGW)&'$D(DGCL) Q -1
  1.  I $D(DGW),$D(DGCL),(DGW'=1)&(DGCL'=1)&('+$O(DGCL(0)))&('+$O(DGW(0))) Q -1
  1.  Q "1^"_SEL
  1.  ;
  1. HELP ;
  1.  W !,"Enter C for contract nursing home",!,"Enter R for regular PAIs",!,"Enter B for both contract nursing home and regular PAIs.",!
  1.  Q
  1.  ;
  1. RUGCNH ;prompt for CNH locations
  1.  I '$D(DGCNH) S (DGCNH,DGFCNH)=""
  1.  S DIC="^FBAAV(",VAUTSTR="CNH location",VAUTVB="DGCL",DIC("S")="I $$SCREEN^DGRUGU1"
  1.  S VAUTNI=2
  1.  D FIRST^VAUTOMA
  1.  I $D(DGFCNH) K DGCNH,DGFCNH
  1.  K DIC,VAUTSTR,VAUTVB,VAUTNI
  1.  Q
  1.  ;
  1. PTSCREEN() ;screen for selecting patients from PAF file
  1.  ;
  1.  N FLG
  1.  S FLG=0
  1.  I $D(DGCNH),$P($G(^DG(45.9,+Y,0)),"^",6)="3" S FLG=1
  1.  I '$D(DGCNH),$P($G(^DG(45.9,+Y,0)),"^",6)'="3" S FLG=1
  1.  I $D(DGFCNH),$P($G(^DG(45.9,+Y,0)),"^",6)'="3" S FLG=1
  1.  Q FLG