1 | DGRPP ;ALB/MRL,AEG - REGISTRATION SCREEN PROCESSOR ;06 JUN 88@2300
|
---|
2 | ;;5.3;Registration;**92,147,343,404,397,489,689**;Aug 13, 1993;Build 1
|
---|
3 | ;
|
---|
4 | ;DGRPS : Screen to edit
|
---|
5 | ;DGRPSEL : If screen 9 (income screening) set to allowable selections
|
---|
6 | ; (V=Veteran, S=Spouse, D=Dependents)
|
---|
7 | ;DGRPSELT : If screen 9, type selected (V, S, or D or all if none specified)
|
---|
8 | ;DGRPAN : Selectable items on screen for edit (user input)
|
---|
9 | ;DGRPANP : Selectable items for print on page footer - i.e. 1-3
|
---|
10 | ;DGRPANN : Selected item(s) extrapolated (screen_item)
|
---|
11 | ;
|
---|
12 | ;
|
---|
13 | EN ;
|
---|
14 | D:'$$BEGUPLD^DGENUPL3(DFN)
|
---|
15 | .D UNLOCK^DGENPTA1(DFN)
|
---|
16 | .D CKUPLOAD^DGENUPL3(DFN)
|
---|
17 | .I $$LOCK^DGENPTA1(DFN)
|
---|
18 | D ENDUPLD^DGENUPL3(DFN)
|
---|
19 | D Q1,WHICH^DGRPP1 W ! K DGRP S DGRPAN="" F I=1:1:$L(DGRPVV(DGRPS)) I $S('DGRPV:1,DGRPS=6:I=2!(I=3),1:0) S:'$E(DGRPVV(DGRPS),I) DGRPAN=DGRPAN_I_","
|
---|
20 | D STR^DGRPP1 F I=$Y:1:20 W !
|
---|
21 | I ("8^9"[DGRPS),$G(DGNOBUCK) S Z="C" D W W "=COPY,"
|
---|
22 | I ("8^9"[DGRPS),($G(DGEFDT)'=DT) S Z="E" D W W "=ENTER new "_(DGISYR+1)_" data,"
|
---|
23 | S Z="<RET>" D W W " to ",$S(DGRPS<DGRPLAST:"CONTINUE",1:"QUIT"),", "
|
---|
24 | I DGRPAN]"" S Z=DGRPANP D W D
|
---|
25 | . I '$G(DGRPV) W " or " S Z="ALL" D W
|
---|
26 | . W " to "_$S('$G(DGRPV):"EDIT, ",DGRPS=6:"EXPAND, ",1:"")
|
---|
27 | S DGRPOUT=0,Z="^N" D W W " for screen N or " S Z="'^'" D W W " to QUIT" I DGRPSEL=""!(DGRPVV(9)'["0")!+$G(DGRPV) W ": "
|
---|
28 | I DGRPSEL]"" D MOREHLP^DGRPP1
|
---|
29 | R DGRPANN:DTIME S:'$T DGRPOUT=1 I DGRPANN']"",'DGRPOUT G NEXT
|
---|
30 | I $E(DGRPANN)="E",$G(DGNOBUCK),("8^9"[DGRPS) D
|
---|
31 | .S DGNOCOPY=1
|
---|
32 | .S DGRPANN=U_DGRPS,DGRPVV(9)="0000000000",DGRPVV(8)="00"
|
---|
33 | I $E(DGRPANN)="C",$G(DGNOBUCK),("8^9"[DGRPS) D
|
---|
34 | .W !!," COPYING will move Family Demographic and Income Data into the next year...",!
|
---|
35 | .I DGNOBUCK=2 D
|
---|
36 | ..W !," YOU HAVE ALREADY MODIFIED CURRENT YEAR DEPENDENT INFORMATION"
|
---|
37 | ..W !," COPYING will OVERWRITE this modified dependent information"
|
---|
38 | ..W !," with LAST year's data - ** Please review dependent data **"
|
---|
39 | ..D COPY^DGMTU22(DFN,DT) S DGRPANN=U_8
|
---|
40 | .I DGNOBUCK=1 D COPY^DGMTU22(DFN,DT) S DGRPANN=U_DGRPS
|
---|
41 | .I Y>0 D
|
---|
42 | ..W !," ...FAMILY DEMOGRAPHIC DATA COPIED"
|
---|
43 | ..W !," ...............INCOME DATA COPIED"
|
---|
44 | ..H 2
|
---|
45 | ..S DGRPVV(9)="0000000000",DGRPVV(8)="00",DA=$$GETIN^DGMTU2(DFN,+DGREL("V"),DT) S DIE=408.21,DR=".18///^S X=""YES""" D ^DIE K DA,DIE,DR
|
---|
46 | JUMP G JUMP^DGRPP1:DGRPANN?1"^"1N.".".1N I DGRPOUT!(DGRPANN?1"^".E) G Q
|
---|
47 | S (DGRPANN,X)=$$UPPER^DGUTL(DGRPANN)
|
---|
48 | I $E(DGRPANN)="A" S X=DGRPANN,Z="^ALL" D IN^DGHELP I %'=-1 S DGRPANN=DGRPANP
|
---|
49 | I DGRPANN]"",(DGRPSEL[$E(DGRPANN)) S DGRPSELT=$E(DGRPANN),DGRPANN=$P(DGRPANN,DGRPSELT,2) ; save off type, run through all other checks
|
---|
50 | I DGRPANN'?1N.E D ^DGRPH G:DGRPS'=1.1 @("^DGRP"_DGRPS) G:DGRPS=1.1 ^DGRPCADD
|
---|
51 | S DGDR="" F I=1:1 S DGCH=$P(DGRPANN,",",I) Q:DGCH']""!($L(DGCH)>5) D CHOICE
|
---|
52 | I DGDR']"" D ^DGRPH S X=DGRPS G SCRX
|
---|
53 | D ^DGRPE G QQ:'$D(^DPT(DFN,0)) S X=DGRPS G SCRX
|
---|
54 | Q I 'DGELVER D:$S(DGRPOUT:0,'$D(DGRPV):0,'DGRPV:1,1:0) LT^DGRPP1
|
---|
55 | K DGDEP,DGINC,DGINR,DGMTC,DGMTED,DGREL,DGTOT,DGSP
|
---|
56 | K DGCH,DGGTOT,DGIRI,DGPRI,DGRPSE1,DGNOCOPY
|
---|
57 | D SENSCHK
|
---|
58 | I 'DGRPV S DGEDCN=1 D ^DGRPC K DGEDCN
|
---|
59 | QQ K DGRPNA,DGRPS,DGRPTYPE,DGRPU,DGRPV,DGRPVV,DGRPW,DGVI,DGVO,DGRPCM,DGELVER,DGRPLAST
|
---|
60 | Q1 K %DT,C,DGA,DGA1,DGA2,DGAD,DGDR,DGRP,DGRPAG,DGRPAN,DGRPANN,DGRPANP,DGRPD,DGRPSEL,DGRPSELT,DGRPVR,DGRPX,DGAAC
|
---|
61 | K DIRUT,DUOUT,DTOUT
|
---|
62 | K DIC,I,I1,I2,I3,J,X,X1,X2,X3,Y,Z,Z1 I $D(DFN)#2,DFN]"" S:$D(^DPT(DFN,0)) DA=DFN
|
---|
63 | Q
|
---|
64 | ;
|
---|
65 | SENSCHK ; check whether patient record should be made sensitive
|
---|
66 | N ELIG,FLAG,X
|
---|
67 | S ELIG=0,FLAG=0
|
---|
68 | I '$D(^DPT($G(DFN),0)) Q ; patient not defined
|
---|
69 | I $D(^DGSL(38.1,DFN,0)) Q ; patient already in dg security log file
|
---|
70 | S X=$S($D(^DPT(DFN,"TYPE")):+^("TYPE"),1:"") I $D(^DG(391,+X,0)),$P(^(0),"^",4) D SEC Q:FLAG
|
---|
71 | F S ELIG=$O(^DPT(DFN,"E",ELIG)) Q:'ELIG D Q:FLAG
|
---|
72 | . S X=$G(^DIC(8,ELIG,0))
|
---|
73 | . I $P(X,"^",12) D SEC
|
---|
74 | Q
|
---|
75 | ;
|
---|
76 | SEC ;if patient type says make record sensitive, add to security log file
|
---|
77 | K DD,DO S DIC="^DGSL(38.1,",(X,DINUM)=DFN,DIC(0)="L",DIC("DR")="2///1;3////"_DUZ_";4///NOW;" D FILE^DICN
|
---|
78 | I $D(^DGSL(38.1,DFN,0)) W !!,"===> Record has been classified as sensitive." S FLAG=1
|
---|
79 | K DIC,X,DINUM,DA,DD,DO,Y
|
---|
80 | Q
|
---|
81 | ;
|
---|
82 | CHOICE ;parse out which items were selected for edit
|
---|
83 | ;
|
---|
84 | ;DGCH=choice to be parsed (either number or number-number)
|
---|
85 | ;
|
---|
86 | N DGFL S DGFL=0
|
---|
87 | I DGCH["-" Q:DGCH'?1.2N1"-"1.2N!($P(DGCH,"-",2)>17) F J=$P(DGCH,"-",1):1:$P(DGCH,"-",2) I DGRPAN[(J_",") D:(DGRPS=9) SCR9 I 'DGFL S DGDR=DGDR_(DGRPS*100+J)_","
|
---|
88 | I DGCH'["-",DGCH?1.2N,(DGRPAN[(DGCH_",")) S DGDR=DGDR_(DGRPS*100+DGCH)_","
|
---|
89 | Q
|
---|
90 | ;
|
---|
91 | NEXT ;find next available screen...goto
|
---|
92 | I DGRPS=DGRPLAST G Q ;last screen and return...quit
|
---|
93 | S X=DGRPLAST
|
---|
94 | F I=DGRPS+1:1 S J=$E(DGRPVV,I) Q:J']"" I 'J S X=I Q
|
---|
95 | I DGRPS=1 S X=1.1
|
---|
96 | SCRX ;goto screen X
|
---|
97 | ;I DGRPLAST=DGRPS,DGRPLAST=X G Q
|
---|
98 | I X[".",X'=1.1 S X=$P(X,".",1)
|
---|
99 | G:X=1.1 ^DGRPCADD
|
---|
100 | G:X'=1.1 @("^DGRP"_X) ;goto next available screen
|
---|
101 | ;
|
---|
102 | W ;write highlighted text on screen (if parameter on)
|
---|
103 | I IOST="C-QUME",$L(DGVI)'=2 W Z
|
---|
104 | E W @DGVI,Z,@DGVO
|
---|
105 | Q
|
---|
106 | ;
|
---|
107 | SCR9 ; see if MT is completed. Allow only selective editing if so
|
---|
108 | I 'DGMTC Q
|
---|
109 | I '$D(DGRPSELT) S:DGMTC=1 DGFL=1 Q ;if no non-mt dependents
|
---|
110 | I DGRPSELT="S",$D(DGMTC("S")) Q
|
---|
111 | I DGRPSELT="D",$D(DGMTC("D")) Q
|
---|
112 | S DGFL=1
|
---|
113 | Q
|
---|