source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRUGU1.m@ 1801

Last change on this file since 1801 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1DGRUGU1 ;ALB/CMM - UTILITIES FOR CNH PAI ;04/17/96
2 ;;5.3;Registration;**89,111,573**;Aug 13, 1993
3 ;
4 ;
5SCREEN() ;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 ;
15KSCREEN(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 ;
28OSCREEN() ;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 ;
40CSCREEN() ;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 ;
52CHOSE() ;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 ;
69HELP ;
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 ;
73RUGCNH ;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 ;
82PTSCREEN() ;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
Note: See TracBrowser for help on using the repository browser.