| [613] | 1 | DGRUGU1 ;ALB/CMM - UTILITIES FOR CNH PAI ;04/17/96
|
|---|
| 2 | ;;5.3;Registration;**89,111,573**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | SCREEN() ;This is the screen for LOCATION field in PAF file to allow only
|
|---|
| 6 | ;the selection of vendors who are under valid CNH contract.
|
|---|
| 7 | ;
|
|---|
| 8 | N EN,FLAG
|
|---|
| 9 | S FLAG=0
|
|---|
| 10 | I $D(DA),$P($G(^DG(45.9,DA,0)),"^",6)'="3" Q FLAG
|
|---|
| 11 | I ($P($G(^FBAAV(+Y,0)),"^",9)=5),$P($G(^("ADEL")),"^")'="Y" S FLAG=1
|
|---|
| 12 | ; ^ ptr to PARTCIPATION CODE file 5=CNH
|
|---|
| 13 | Q FLAG
|
|---|
| 14 | ;
|
|---|
| 15 | KSCREEN(Y) ;This is the screen to allow selected PAI to be deleted
|
|---|
| 16 | ;
|
|---|
| 17 | N FLAG
|
|---|
| 18 | S FLAG=0
|
|---|
| 19 | I '$D(^DG(45.9,+Y,"C")) S FLAG=1
|
|---|
| 20 | I $D(^DG(45.9,+Y,"C")),(+^DG(45.9,+Y,"C")<2)!(+^DG(45.9,+Y,"C")=5) S FLAG=1
|
|---|
| 21 | I FLAG D
|
|---|
| 22 | .S FLAG=0
|
|---|
| 23 | .I ($D(^XUSEC("DG RUG SUPERVISOR",DUZ))) S FLAG=1 Q
|
|---|
| 24 | .I $D(DGCNH),$P(^DG(45.9,+Y,0),"^",6)=3 S FLAG=1 Q
|
|---|
| 25 | .I '$D(DGCNH),$P(^DG(45.9,+Y,0),"^",6)'=3 S FLAG=1 Q
|
|---|
| 26 | Q FLAG
|
|---|
| 27 | ;
|
|---|
| 28 | OSCREEN() ;This is the screen to allow selected PAI to be re-opened
|
|---|
| 29 | ;
|
|---|
| 30 | N FLAG
|
|---|
| 31 | S FLAG=0
|
|---|
| 32 | I $D(^DG(45.9,+Y,"C")),"^2^4^"[("^"_+^DG(45.9,+Y,"C")_"^") S FLAG=1
|
|---|
| 33 | I FLAG D
|
|---|
| 34 | .S FLAG=0
|
|---|
| 35 | .I ($D(^XUSEC("DG RUG SUPERVISOR",DUZ))) S FLAG=1 Q
|
|---|
| 36 | .I $D(DGCNH),$P(^DG(45.9,+Y,0),"^",6)=3 S FLAG=1 Q
|
|---|
| 37 | .I '$D(DGCNH),$P(^DG(45.9,+Y,0),"^",6)'=3 S FLAG=1 Q
|
|---|
| 38 | Q FLAG
|
|---|
| 39 | ;
|
|---|
| 40 | CSCREEN() ;This is the screen to allow selected PAI to be closed
|
|---|
| 41 | ;
|
|---|
| 42 | N FLAG
|
|---|
| 43 | S FLAG=0
|
|---|
| 44 | I $D(^DG(45.9,+Y,"C")),(+^DG(45.9,+Y,"C")<2) S FLAG=1
|
|---|
| 45 | I FLAG D
|
|---|
| 46 | .S FLAG=0
|
|---|
| 47 | .I ($D(^XUSEC("DG RUG SUPERVISOR",DUZ))) S FLAG=1 Q
|
|---|
| 48 | .I $D(DGCNH),$P(^DG(45.9,+Y,0),"^",6)=3 S FLAG=1 Q
|
|---|
| 49 | .I '$D(DGCNH),$P(^DG(45.9,+Y,0),"^",6)'=3 S FLAG=1 Q
|
|---|
| 50 | Q FLAG
|
|---|
| 51 | ;
|
|---|
| 52 | CHOSE() ;pick both CNH and Regular PAIs or one
|
|---|
| 53 | ;
|
|---|
| 54 | N SEL
|
|---|
| 55 | S DIR("A")="(C)NH, (R)egular PAIs, (B)oth: ",DIR("B")="B"
|
|---|
| 56 | S DIR(0)="SAM^C:CNH;R:REGULAR PAIS;B:BOTH"
|
|---|
| 57 | S DIR("?")="^D HELP^DGRUGU1"
|
|---|
| 58 | D ^DIR S SEL=Y
|
|---|
| 59 | I SEL=""!(SEL="^") Q -1
|
|---|
| 60 | I SEL="R"!(SEL="B") D RUGWARD^DGRUGPP
|
|---|
| 61 | I SEL="C"!(SEL="B") D RUGCNH
|
|---|
| 62 | ;
|
|---|
| 63 | I $D(DGW) I SEL="R",'+$O(DGW(0)),'DGW Q -1
|
|---|
| 64 | I $D(DGCL) I SEL="C"&('+$O(DGCL(0)))&'DGCL Q -1
|
|---|
| 65 | I '$D(DGW)&'$D(DGCL) Q -1
|
|---|
| 66 | I $D(DGW),$D(DGCL),(DGW'=1)&(DGCL'=1)&('+$O(DGCL(0)))&('+$O(DGW(0))) Q -1
|
|---|
| 67 | Q "1^"_SEL
|
|---|
| 68 | ;
|
|---|
| 69 | HELP ;
|
|---|
| 70 | W !,"Enter C for contract nursing home",!,"Enter R for regular PAIs",!,"Enter B for both contract nursing home and regular PAIs.",!
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | RUGCNH ;prompt for CNH locations
|
|---|
| 74 | I '$D(DGCNH) S (DGCNH,DGFCNH)=""
|
|---|
| 75 | S DIC="^FBAAV(",VAUTSTR="CNH location",VAUTVB="DGCL",DIC("S")="I $$SCREEN^DGRUGU1"
|
|---|
| 76 | S VAUTNI=2
|
|---|
| 77 | D FIRST^VAUTOMA
|
|---|
| 78 | I $D(DGFCNH) K DGCNH,DGFCNH
|
|---|
| 79 | K DIC,VAUTSTR,VAUTVB,VAUTNI
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | PTSCREEN() ;screen for selecting patients from PAF file
|
|---|
| 83 | ;
|
|---|
| 84 | N FLG
|
|---|
| 85 | S FLG=0
|
|---|
| 86 | I $D(DGCNH),$P($G(^DG(45.9,+Y,0)),"^",6)="3" S FLG=1
|
|---|
| 87 | I '$D(DGCNH),$P($G(^DG(45.9,+Y,0)),"^",6)'="3" S FLG=1
|
|---|
| 88 | I $D(DGFCNH),$P($G(^DG(45.9,+Y,0)),"^",6)'="3" S FLG=1
|
|---|
| 89 | Q FLG
|
|---|
