DGRPP ;ALB/MRL,AEG,LBD,ASF,LEG,RN,JAM - REGISTRATION SCREEN PROCESSOR ;Apr 05, 2020@15:16
;;5.3;Registration;**92,147,343,404,397,489,689,688,828,797,871,997,1014,1040,1027,1143**;Aug 13, 1993;Build 36
;
;DGRPS : Screen to edit
;DGRPSEL : If screen 9 (income screening) set to allowable selections
; (V=Veteran, S=Spouse, D=Dependents)
;DGRPSELT : If screen 9, type selected (V, S, or D or all if none specified)
;DGRPAN : Selectable items on screen for edit (user input)
;DGRPANP : Selectable items for print on page footer - i.e. 1-3
;DGRPANN : Selected item(s) extrapolated (screen_item)
;
;
EN ;
D:'$$BEGUPLD^DGENUPL3(DFN)
.D UNLOCK^DGENPTA1(DFN)
.D CKUPLOAD^DGENUPL3(DFN)
.I $$LOCK^DGENPTA1(DFN)
D ENDUPLD^DGENUPL3(DFN)
; DG*5.3*1040 - If timed out, clean screen with W @IOF, use variable DGRPOUT to track timeout and exit
I $D(DTOUT)!(+$G(DGTMOT)) S DGRPOUT=1 W @IOF,!!! G QQ
;jam; Patch DG*5.3*997 - include screen 11.5 group 1 to be editable when in View Reg option (DGRPV=1)
D Q1,WHICH^DGRPP1 W ! K DGRP S DGRPAN="" F I=1:1:$L(DGRPVV(DGRPS)) I $S('DGRPV:1,DGRPS=6:I=1!(I=2)!(I=3),DGRPS=11:I=5,DGRPS=11.5:I=1!(I=2),1:0) S:'$E(DGRPVV(DGRPS),I) DGRPAN=DGRPAN_I_"," ;LEG; DG*5.3*1014 added I=2 for <11.5>
D STR^DGRPP1 F I=$Y:1:20 W !
; remove COPY option DG*5.3*688
I ("8^9"[DGRPS),($G(DGEFDT)'=DT) S Z="E" D W W "=ENTER new "_(DGISYR+1)_" data,"
; DG*5.3*1143 - If RTA editing array is defined (1 or more groups have edits), give a prompt for Save/Discard changes
I $D(DGADDEDIT) D
. S Z="(S)ave or (D)iscard changes, 1-5 or ALL to EDIT, or '^' to QUIT:" D W
; Otherwise display usual prompts
ELSE D
. S Z="<RET>" D W W " to ",$S(DGRPS<DGRPLAST:"CONTINUE",1:"QUIT"),", "
. I DGRPAN]"" S Z=DGRPANP D W D
. . I '$G(DGRPV) W " or " S Z="ALL" D W
. . ; jam; DG*5.3*997 - add screen 11.5 to allow group 1 to be expanded in View Reg option - DGRPV=1)
. . W " to "_$S('$G(DGRPV):"EDIT, ",DGRPS=6!(DGRPS=11)!(DGRPS=11.5):"EXPAND, ",1:"")
. 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 ": "
. I DGRPSEL]"" D MOREHLP^DGRPP1
;
G:$E(IOST,1,2)="P-" NEXT ;RGB/VM 4/28/10 Just go to next screen for non-interactive jobs
; 1143 - Changes to processing of user input
;R DGRPANN:DTIME S:'$T DGRPOUT=1 I DGRPANN']"",'DGRPOUT G NEXT
R DGRPANN:DTIME S:'$T DGRPOUT=1
; DG*5.3*1040 - If timed out, clean screen with W @IOF, use variable DGRPOUT to track timeout and exit
I +$G(DGRPOUT) W @IOF,!!! G QQ
;
; DG*5.3*1143 - Handle response when RTA editing array is defined (1 or more of the address groups have edits)
; <RET> is not accepted - repaint the screen
I $D(DGADDEDIT) I DGRPANN']"" S X=DGRPS G SCRX
; Jump to another screen is not accepted - repaint the screen
I $D(DGADDEDIT) I DGRPANN?1"^"1.E S X=DGRPS G SCRX
S (DGRPANN,X)=$$UPPER^DGUTL(DGRPANN)
; ^ will discard changes and quit
; Prompt for confirmation - repaint the screen, if no timeout or exit
I $D(DGADDEDIT) I DGRPANN="^" N DGCONFIRM D I 'DGRPOUT S X=DGRPS G SCRX
. S DGCONFIRM=$$DISCONF
. I 'DGCONFIRM Q
. ; Discard the changes
. D DISCARD
. W !,"Screen <1.1> changes discarded." D REF
; If timeout or ^, clear screen and quit
I +$G(DGRPOUT) W @IOF,!!! G QQ
; Discard changes - refresh the screen if no timeout/exit
I $D(DGADDEDIT) I $E(DGRPANN,1,$L(DGRPANN))=$E("DISCARD",1,$L(DGRPANN)) N DGCONF D I 'DGRPOUT S X=DGRPS G SCRX
. S DGCONFIRM=$$DISCONF
. I 'DGCONFIRM Q
. ; Discard the changes
. D DISCARD
. W !,"Screen <1.1> changes discarded." D REF
; If timeout or ^, clear screen and quit
I +$G(DGRPOUT) W @IOF,!!! G QQ
;
; Save changes
I $D(DGADDEDIT) I $E(DGRPANN,1,$L(DGRPANN))=$E("SAVE",1,$L(DGRPANN)) G SAVEADDR
;
; DG*5.3*1143 From this point the user input is processed with RTA not active or no RTA updates pending
; If user is going to next screen and if RTA flag is set, clean up remaining RTA variables
I DGRPANN']"",'DGRPOUT D:$G(DGRTAON)=1 CLEAN^DGRPCADD G NEXT
I $E(DGRPANN)="E",$G(DGNOBUCK),("8^9"[DGRPS) D
. S DGNOCOPY=1
. ; remove COPY option DG*5.3*688
. S DGRPANN=U_DGRPS,DGRPVV(9)="000",DGRPVV(8)="00",DGIAINEW=1
JUMP ;
I DGRPANN="^" G Q
; DG*5.3*1143 If user is jumping to a screen, if RTA flag is set clean up RTA variables
I DGRPANN?1"^".N.".".N.".".N D:$G(DGRTAON)=1 CLEAN^DGRPCADD G JUMP^DGRPP1
I DGRPOUT!(DGRPANN?1"^".E) G Q
I $E(DGRPANN)="A" S X=DGRPANN,Z="^ALL" D IN^DGHELP I %'=-1 S DGRPANN=DGRPANP
;LEG; DG*5.3*997 ; add screen 11.5
I DGRPANN'?1N.E D ^DGRPH G:DGRPS'=1.1&(DGRPS'=11.5) @("^DGRP"_DGRPS) G:DGRPS=1.1 ^DGRPCADD G:DGRPS=11.5 ^DGRP11A
S DGDR="" F I=1:1 S DGCH=$P(DGRPANN,",",I) Q:DGCH']""!($L(DGCH)>5) D CHOICE
I DGDR']"" D ^DGRPH S X=DGRPS G SCRX
D ^DGRPE G QQ:'$D(^DPT(DFN,0)) S X=DGRPS G SCRX
Q I 'DGELVER D:$S(DGRPOUT:0,'$D(DGRPV):0,'DGRPV:1,1:0) LT^DGRPP1
K DGDEP,DGINC,DGINR,DGMTC,DGMTED,DGREL,DGTOT,DGSP
K DGCH,DGGTOT,DGIRI,DGPRI,DGRPSE1,DGNOCOPY
D SENSCHK
; DG*5.3*1027 Setting default values for DGDONE and DGDONE2 used in DGRPC
N DGDONE,DGDONE2 S DGDONE=0,DGDONE2=0
; DG*5.3*1143 - Prior to calling consistency checker, clear out RTA flags
K DGRTAON,DGRTAHOLD
I 'DGRPV S DGEDCN=1 D ^DGRPC K DGEDCN
QQ ; DG*5.3*1143 - Discard edits if the RTA Edit Flag is set (edits are pending)
I $D(DGADDEDIT) D DISCARD
K DGRPNA,DGRPS,DGRPTYPE,DGRPU,DGRPV,DGRPVV,DGRPW,DGVI,DGVO,DGRPCM,DGELVER,DGRPLAST
Q1 K %DT,C,DGA,DGA1,DGA2,DGAD,DGDR,DGRP,DGRPAG,DGRPAN,DGRPANN,DGRPANP,DGRPD,DGRPSEL,DGRPSELT,DGRPVR,DGRPX,DGAAC
; DG*5.3*1040 - clean-up variable DGTMOT
K DIRUT,DUOUT,DTOUT,DGTMOT
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
Q
;
SENSCHK ; check whether patient record should be made sensitive
N ELIG,FLAG,X
S ELIG=0,FLAG=0
I '$D(^DPT($G(DFN),0)) Q ; patient not defined
I $D(^DGSL(38.1,DFN,0)) Q ; patient already in dg security log file
S X=$S($D(^DPT(DFN,"TYPE")):+^("TYPE"),1:"") I $D(^DG(391,+X,0)),$P(^(0),"^",4) D SEC Q:FLAG
F S ELIG=$O(^DPT(DFN,"E",ELIG)) Q:'ELIG D Q:FLAG
. S X=$G(^DIC(8,ELIG,0))
. I $P(X,"^",12) D SEC
Q
;
SEC ;if patient type says make record sensitive, add to security log file
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
I $D(^DGSL(38.1,DFN,0)) W !!,"===> Record has been classified as sensitive." S FLAG=1
K DIC,X,DINUM,DA,DD,DO,Y
Q
;
CHOICE ;parse out which items were selected for edit
;
;DGCH=choice to be parsed (either number or number-number)
;
N DGFL S DGFL=0
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)_","
I DGCH'["-",DGCH?1.2N,(DGRPAN[(DGCH_",")) S DGDR=DGDR_(DGRPS*100+DGCH)_","
Q
;
NEXT ;find next available screen...goto
I DGRPS=DGRPLAST G Q ;last screen and return...quit
S X=DGRPLAST
F I=DGRPS+1:1 S J=$E(DGRPVV,I) Q:J']"" I 'J S X=I Q
I DGRPS=1 S X=1.1
;LEG; DG*5.3*997; added screen 11.5
I DGRPS=11 S X=11.5
I DGRPS=11.5 S X=12
SCRX ;goto screen X
I X[".",X'=1.1,X'=11.5 S X=$P(X,".",1) ;ASF; DG*5.3*997 ; Added screen 11.5
G:X=1.1 ^DGRPCADD
;ASF; DG*5.3*997; add condition for 11.5
G:X=11.5 ^DGRP11A
G:(X'=1.1)&(X'=11.5) @("^DGRP"_X) ;goto next available screen;
W ;write highlighted text on screen (if parameter on)
I IOST="C-QUME",$L(DGVI)'=2 W Z
E W @DGVI,Z,@DGVO
Q
;
SCR9 ; see if MT is completed. Allow only selective editing if so
I 'DGMTC Q
I '$D(DGRPSELT) S:DGMTC=1 DGFL=1 Q ;if no non-mt dependents
I DGRPSELT="S",$D(DGMTC("S")) Q
I DGRPSELT="D",$D(DGMTC("D")) Q
S DGFL=1
Q
;
SAVEADDR ; DG*5.3*1143 - (S)ave option from screen 1.1 editing
; Call function to transmit the data and save
D RTASEND^DGRPCADD(DFN)
; If a timeout/exit occurred, quit
I +$G(DGRPOUT) W @IOF,!!! G QQ
; Whether or not the save was successful, repaint the screen
S X=DGRPS G SCRX
;
DISCARD ; DG*5.3*1143 - Discard changes - via "D" option on screen 1.1, timeouts, or user is exiting with ^
D DISCARD^DGRPCADD
Q
;
DISCONF() ; DG*5.3*1143 - Confirm if user wants to discard the changes
N DIR,X,Y,DTOUT,DUOUT,DIROUT
S DIR(0)="Y"
S DIR("A")="Are you sure that you want to DISCARD the changes"
S DIR("?")="Please answer Y for YES or N for NO."
D ^DIR
; DIRUT defined if the user entered an up-arrow, or timed out
I $D(DIRUT) S DGTMOT=1,DGRPOUT=1 Q 0
I $G(Y)=0 Q 0
Q 1
;
REF ;End of page prompt (Refresh)
N DIR,DTOUT,DUOUT,DIROUT,X,Y
S DIR(0)="E"
S DIR("A")="Press ENTER to refresh the screen"
D ^DIR
S:$D(DTOUT) DGTMOT=1,DGRPOUT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRPP 8742 printed May 25, 2026@13:00:24 Page 2
DGRPP ;ALB/MRL,AEG,LBD,ASF,LEG,RN,JAM - REGISTRATION SCREEN PROCESSOR ;Apr 05, 2020@15:16
+1 ;;5.3;Registration;**92,147,343,404,397,489,689,688,828,797,871,997,1014,1040,1027,1143**;Aug 13, 1993;Build 36
+2 ;
+3 ;DGRPS : Screen to edit
+4 ;DGRPSEL : If screen 9 (income screening) set to allowable selections
+5 ; (V=Veteran, S=Spouse, D=Dependents)
+6 ;DGRPSELT : If screen 9, type selected (V, S, or D or all if none specified)
+7 ;DGRPAN : Selectable items on screen for edit (user input)
+8 ;DGRPANP : Selectable items for print on page footer - i.e. 1-3
+9 ;DGRPANN : Selected item(s) extrapolated (screen_item)
+10 ;
+11 ;
EN ;
+1 if '$$BEGUPLD^DGENUPL3(DFN)
Begin DoDot:1
+2 DO UNLOCK^DGENPTA1(DFN)
+3 DO CKUPLOAD^DGENUPL3(DFN)
+4 IF $$LOCK^DGENPTA1(DFN)
End DoDot:1
+5 DO ENDUPLD^DGENUPL3(DFN)
+6 ; DG*5.3*1040 - If timed out, clean screen with W @IOF, use variable DGRPOUT to track timeout and exit
+7 IF $DATA(DTOUT)!(+$GET(DGTMOT))
SET DGRPOUT=1
WRITE @IOF,!!!
GOTO QQ
+8 ;jam; Patch DG*5.3*997 - include screen 11.5 group 1 to be editable when in View Reg option (DGRPV=1)
+9 ;LEG; DG*5.3*1014 added I=2 for <11.5>
DO Q1
DO WHICH^DGRPP1
WRITE !
KILL DGRP
SET DGRPAN=""
FOR I=1:1:$LENGTH(DGRPVV(DGRPS))
IF $SELECT('DGRPV:1,DGRPS=6:I=1!(I=2)!(I=3),DGRPS=11:I=5,DGRPS=11.5:I=1!(I=2),1:0)
if '$EXTRACT(DGRPVV(DGRPS),I)
SET DGRPAN=DGRPAN_I_","
+10 DO STR^DGRPP1
FOR I=$Y:1:20
WRITE !
+11 ; remove COPY option DG*5.3*688
+12 IF ("8^9"[DGRPS)
IF ($GET(DGEFDT)'=DT)
SET Z="E"
DO W
WRITE "=ENTER new "_(DGISYR+1)_" data,"
+13 ; DG*5.3*1143 - If RTA editing array is defined (1 or more groups have edits), give a prompt for Save/Discard changes
+14 IF $DATA(DGADDEDIT)
Begin DoDot:1
+15 SET Z="(S)ave or (D)iscard changes, 1-5 or ALL to EDIT, or '^' to QUIT:"
DO W
End DoDot:1
+16 ; Otherwise display usual prompts
+17 IF '$TEST
Begin DoDot:1
+18 SET Z="<RET>"
DO W
WRITE " to ",$SELECT(DGRPS<DGRPLAST:"CONTINUE",1:"QUIT"),", "
+19 IF DGRPAN]""
SET Z=DGRPANP
DO W
Begin DoDot:2
+20 IF '$GET(DGRPV)
WRITE " or "
SET Z="ALL"
DO W
+21 ; jam; DG*5.3*997 - add screen 11.5 to allow group 1 to be expanded in View Reg option - DGRPV=1)
+22 WRITE " to "_$SELECT('$GET(DGRPV):"EDIT, ",DGRPS=6!(DGRPS=11)!(DGRPS=11.5):"EXPAND, ",1:"")
End DoDot:2
+23 SET DGRPOUT=0
SET Z="^N"
DO W
WRITE " for screen N or "
SET Z="'^'"
DO W
WRITE " to QUIT"
IF DGRPSEL=""!(DGRPVV(9)'["0")!+$GET(DGRPV)
WRITE ": "
+24 IF DGRPSEL]""
DO MOREHLP^DGRPP1
End DoDot:1
+25 ;
+26 ;RGB/VM 4/28/10 Just go to next screen for non-interactive jobs
if $EXTRACT(IOST,1,2)="P-"
GOTO NEXT
+27 ; 1143 - Changes to processing of user input
+28 ;R DGRPANN:DTIME S:'$T DGRPOUT=1 I DGRPANN']"",'DGRPOUT G NEXT
+29 READ DGRPANN:DTIME
if '$TEST
SET DGRPOUT=1
+30 ; DG*5.3*1040 - If timed out, clean screen with W @IOF, use variable DGRPOUT to track timeout and exit
+31 IF +$GET(DGRPOUT)
WRITE @IOF,!!!
GOTO QQ
+32 ;
+33 ; DG*5.3*1143 - Handle response when RTA editing array is defined (1 or more of the address groups have edits)
+34 ; <RET> is not accepted - repaint the screen
+35 IF $DATA(DGADDEDIT)
IF DGRPANN']""
SET X=DGRPS
GOTO SCRX
+36 ; Jump to another screen is not accepted - repaint the screen
+37 IF $DATA(DGADDEDIT)
IF DGRPANN?1"^"1.E
SET X=DGRPS
GOTO SCRX
+38 SET (DGRPANN,X)=$$UPPER^DGUTL(DGRPANN)
+39 ; ^ will discard changes and quit
+40 ; Prompt for confirmation - repaint the screen, if no timeout or exit
+41 IF $DATA(DGADDEDIT)
IF DGRPANN="^"
NEW DGCONFIRM
Begin DoDot:1
+42 SET DGCONFIRM=$$DISCONF
+43 IF 'DGCONFIRM
QUIT
+44 ; Discard the changes
+45 DO DISCARD
+46 WRITE !,"Screen <1.1> changes discarded."
DO REF
End DoDot:1
IF 'DGRPOUT
SET X=DGRPS
GOTO SCRX
+47 ; If timeout or ^, clear screen and quit
+48 IF +$GET(DGRPOUT)
WRITE @IOF,!!!
GOTO QQ
+49 ; Discard changes - refresh the screen if no timeout/exit
+50 IF $DATA(DGADDEDIT)
IF $EXTRACT(DGRPANN,1,$LENGTH(DGRPANN))=$EXTRACT("DISCARD",1,$LENGTH(DGRPANN))
NEW DGCONF
Begin DoDot:1
+51 SET DGCONFIRM=$$DISCONF
+52 IF 'DGCONFIRM
QUIT
+53 ; Discard the changes
+54 DO DISCARD
+55 WRITE !,"Screen <1.1> changes discarded."
DO REF
End DoDot:1
IF 'DGRPOUT
SET X=DGRPS
GOTO SCRX
+56 ; If timeout or ^, clear screen and quit
+57 IF +$GET(DGRPOUT)
WRITE @IOF,!!!
GOTO QQ
+58 ;
+59 ; Save changes
+60 IF $DATA(DGADDEDIT)
IF $EXTRACT(DGRPANN,1,$LENGTH(DGRPANN))=$EXTRACT("SAVE",1,$LENGTH(DGRPANN))
GOTO SAVEADDR
+61 ;
+62 ; DG*5.3*1143 From this point the user input is processed with RTA not active or no RTA updates pending
+63 ; If user is going to next screen and if RTA flag is set, clean up remaining RTA variables
+64 IF DGRPANN']""
IF 'DGRPOUT
if $GET(DGRTAON)=1
DO CLEAN^DGRPCADD
GOTO NEXT
+65 IF $EXTRACT(DGRPANN)="E"
IF $GET(DGNOBUCK)
IF ("8^9"[DGRPS)
Begin DoDot:1
+66 SET DGNOCOPY=1
+67 ; remove COPY option DG*5.3*688
+68 SET DGRPANN=U_DGRPS
SET DGRPVV(9)="000"
SET DGRPVV(8)="00"
SET DGIAINEW=1
End DoDot:1
JUMP ;
+1 IF DGRPANN="^"
GOTO Q
+2 ; DG*5.3*1143 If user is jumping to a screen, if RTA flag is set clean up RTA variables
+3 IF DGRPANN?1"^".N.".".N.".".N
if $GET(DGRTAON)=1
DO CLEAN^DGRPCADD
GOTO JUMP^DGRPP1
+4 IF DGRPOUT!(DGRPANN?1"^".E)
GOTO Q
+5 IF $EXTRACT(DGRPANN)="A"
SET X=DGRPANN
SET Z="^ALL"
DO IN^DGHELP
IF %'=-1
SET DGRPANN=DGRPANP
+6 ;LEG; DG*5.3*997 ; add screen 11.5
+7 IF DGRPANN'?1N.E
DO ^DGRPH
if DGRPS'=1.1&(DGRPS'=11.5)
GOTO @("^DGRP"_DGRPS)
if DGRPS=1.1
GOTO ^DGRPCADD
if DGRPS=11.5
GOTO ^DGRP11A
+8 SET DGDR=""
FOR I=1:1
SET DGCH=$PIECE(DGRPANN,",",I)
if DGCH']""!($LENGTH(DGCH)>5)
QUIT
DO CHOICE
+9 IF DGDR']""
DO ^DGRPH
SET X=DGRPS
GOTO SCRX
+10 DO ^DGRPE
if '$DATA(^DPT(DFN,0))
GOTO QQ
SET X=DGRPS
GOTO SCRX
Q IF 'DGELVER
if $SELECT(DGRPOUT
DO LT^DGRPP1
+1 KILL DGDEP,DGINC,DGINR,DGMTC,DGMTED,DGREL,DGTOT,DGSP
+2 KILL DGCH,DGGTOT,DGIRI,DGPRI,DGRPSE1,DGNOCOPY
+3 DO SENSCHK
+4 ; DG*5.3*1027 Setting default values for DGDONE and DGDONE2 used in DGRPC
+5 NEW DGDONE,DGDONE2
SET DGDONE=0
SET DGDONE2=0
+6 ; DG*5.3*1143 - Prior to calling consistency checker, clear out RTA flags
+7 KILL DGRTAON,DGRTAHOLD
+8 IF 'DGRPV
SET DGEDCN=1
DO ^DGRPC
KILL DGEDCN
QQ ; DG*5.3*1143 - Discard edits if the RTA Edit Flag is set (edits are pending)
+1 IF $DATA(DGADDEDIT)
DO DISCARD
+2 KILL DGRPNA,DGRPS,DGRPTYPE,DGRPU,DGRPV,DGRPVV,DGRPW,DGVI,DGVO,DGRPCM,DGELVER,DGRPLAST
Q1 KILL %DT,C,DGA,DGA1,DGA2,DGAD,DGDR,DGRP,DGRPAG,DGRPAN,DGRPANN,DGRPANP,DGRPD,DGRPSEL,DGRPSELT,DGRPVR,DGRPX,DGAAC
+1 ; DG*5.3*1040 - clean-up variable DGTMOT
+2 KILL DIRUT,DUOUT,DTOUT,DGTMOT
+3 KILL DIC,I,I1,I2,I3,J,X,X1,X2,X3,Y,Z,Z1
IF $DATA(DFN)#2
IF DFN]""
if $DATA(^DPT(DFN,0))
SET DA=DFN
+4 QUIT
+5 ;
SENSCHK ; check whether patient record should be made sensitive
+1 NEW ELIG,FLAG,X
+2 SET ELIG=0
SET FLAG=0
+3 ; patient not defined
IF '$DATA(^DPT($GET(DFN),0))
QUIT
+4 ; patient already in dg security log file
IF $DATA(^DGSL(38.1,DFN,0))
QUIT
+5 SET X=$SELECT($DATA(^DPT(DFN,"TYPE")):+^("TYPE"),1:"")
IF $DATA(^DG(391,+X,0))
IF $PIECE(^(0),"^",4)
DO SEC
if FLAG
QUIT
+6 FOR
SET ELIG=$ORDER(^DPT(DFN,"E",ELIG))
if 'ELIG
QUIT
Begin DoDot:1
+7 SET X=$GET(^DIC(8,ELIG,0))
+8 IF $PIECE(X,"^",12)
DO SEC
End DoDot:1
if FLAG
QUIT
+9 QUIT
+10 ;
SEC ;if patient type says make record sensitive, add to security log file
+1 KILL DD,DO
SET DIC="^DGSL(38.1,"
SET (X,DINUM)=DFN
SET DIC(0)="L"
SET DIC("DR")="2///1;3////"_DUZ_";4///NOW;"
DO FILE^DICN
+2 IF $DATA(^DGSL(38.1,DFN,0))
WRITE !!,"===> Record has been classified as sensitive."
SET FLAG=1
+3 KILL DIC,X,DINUM,DA,DD,DO,Y
+4 QUIT
+5 ;
CHOICE ;parse out which items were selected for edit
+1 ;
+2 ;DGCH=choice to be parsed (either number or number-number)
+3 ;
+4 NEW DGFL
SET DGFL=0
+5 IF DGCH["-"
if DGCH'?1.2N1"-"1.2N!($PIECE(DGCH,"-",2)>17)
QUIT
FOR J=$PIECE(DGCH,"-",1):1:$PIECE(DGCH,"-",2)
IF DGRPAN[(J_",")
if (DGRPS=9)
DO SCR9
IF 'DGFL
SET DGDR=DGDR_(DGRPS*100+J)_","
+6 IF DGCH'["-"
IF DGCH?1.2N
IF (DGRPAN[(DGCH_","))
SET DGDR=DGDR_(DGRPS*100+DGCH)_","
+7 QUIT
+8 ;
NEXT ;find next available screen...goto
+1 ;last screen and return...quit
IF DGRPS=DGRPLAST
GOTO Q
+2 SET X=DGRPLAST
+3 FOR I=DGRPS+1:1
SET J=$EXTRACT(DGRPVV,I)
if J']""
QUIT
IF 'J
SET X=I
QUIT
+4 IF DGRPS=1
SET X=1.1
+5 ;LEG; DG*5.3*997; added screen 11.5
+6 IF DGRPS=11
SET X=11.5
+7 IF DGRPS=11.5
SET X=12
SCRX ;goto screen X
+1 ;ASF; DG*5.3*997 ; Added screen 11.5
IF X["."
IF X'=1.1
IF X'=11.5
SET X=$PIECE(X,".",1)
+2 if X=1.1
GOTO ^DGRPCADD
+3 ;ASF; DG*5.3*997; add condition for 11.5
+4 if X=11.5
GOTO ^DGRP11A
+5 ;goto next available screen;
if (X'=1.1)&(X'=11.5)
GOTO @("^DGRP"_X)
W ;write highlighted text on screen (if parameter on)
+1 IF IOST="C-QUME"
IF $LENGTH(DGVI)'=2
WRITE Z
+2 IF '$TEST
WRITE @DGVI,Z,@DGVO
+3 QUIT
+4 ;
SCR9 ; see if MT is completed. Allow only selective editing if so
+1 IF 'DGMTC
QUIT
+2 ;if no non-mt dependents
IF '$DATA(DGRPSELT)
if DGMTC=1
SET DGFL=1
QUIT
+3 IF DGRPSELT="S"
IF $DATA(DGMTC("S"))
QUIT
+4 IF DGRPSELT="D"
IF $DATA(DGMTC("D"))
QUIT
+5 SET DGFL=1
+6 QUIT
+7 ;
SAVEADDR ; DG*5.3*1143 - (S)ave option from screen 1.1 editing
+1 ; Call function to transmit the data and save
+2 DO RTASEND^DGRPCADD(DFN)
+3 ; If a timeout/exit occurred, quit
+4 IF +$GET(DGRPOUT)
WRITE @IOF,!!!
GOTO QQ
+5 ; Whether or not the save was successful, repaint the screen
+6 SET X=DGRPS
GOTO SCRX
+7 ;
DISCARD ; DG*5.3*1143 - Discard changes - via "D" option on screen 1.1, timeouts, or user is exiting with ^
+1 DO DISCARD^DGRPCADD
+2 QUIT
+3 ;
DISCONF() ; DG*5.3*1143 - Confirm if user wants to discard the changes
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIROUT
+2 SET DIR(0)="Y"
+3 SET DIR("A")="Are you sure that you want to DISCARD the changes"
+4 SET DIR("?")="Please answer Y for YES or N for NO."
+5 DO ^DIR
+6 ; DIRUT defined if the user entered an up-arrow, or timed out
+7 IF $DATA(DIRUT)
SET DGTMOT=1
SET DGRPOUT=1
QUIT 0
+8 IF $GET(Y)=0
QUIT 0
+9 QUIT 1
+10 ;
REF ;End of page prompt (Refresh)
+1 NEW DIR,DTOUT,DUOUT,DIROUT,X,Y
+2 SET DIR(0)="E"
+3 SET DIR("A")="Press ENTER to refresh the screen"
+4 DO ^DIR
+5 if $DATA(DTOUT)
SET DGTMOT=1
SET DGRPOUT=1
+6 QUIT
