- DGRPP ;ALB/MRL,AEG,LBD,ASF,LEG,RN - 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**;Aug 13, 1993;Build 70
- ;
- ;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,"
- 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
- R DGRPANN:DTIME S:'$T DGRPOUT=1 I DGRPANN']"",'DGRPOUT G NEXT
- ; 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
- 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 ;
- G:DGRPANN="^" Q G JUMP^DGRPP1:DGRPANN?1"^".N.".".N.".".N I DGRPOUT!(DGRPANN?1"^".E) G Q
- S (DGRPANN,X)=$$UPPER^DGUTL(DGRPANN)
- 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
- I 'DGRPV S DGEDCN=1 D ^DGRPC K DGEDCN
- QQ 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRPP 5566 printed Mar 13, 2025@22:01:11 Page 2
- DGRPP ;ALB/MRL,AEG,LBD,ASF,LEG,RN - 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**;Aug 13, 1993;Build 70
- +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 SET Z="<RET>"
- DO W
- WRITE " to ",$SELECT(DGRPS<DGRPLAST:"CONTINUE",1:"QUIT"),", "
- +14 IF DGRPAN]""
- SET Z=DGRPANP
- DO W
- Begin DoDot:1
- +15 IF '$GET(DGRPV)
- WRITE " or "
- SET Z="ALL"
- DO W
- +16 ; jam; DG*5.3*997 - add screen 11.5 to allow group 1 to be expanded in View Reg option - DGRPV=1)
- +17 WRITE " to "_$SELECT('$GET(DGRPV):"EDIT, ",DGRPS=6!(DGRPS=11)!(DGRPS=11.5):"EXPAND, ",1:"")
- End DoDot:1
- +18 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 ": "
- +19 IF DGRPSEL]""
- DO MOREHLP^DGRPP1
- +20 ;RGB/VM 4/28/10 Just go to next screen for non-interactive jobs
- if $EXTRACT(IOST,1,2)="P-"
- GOTO NEXT
- +21 READ DGRPANN:DTIME
- if '$TEST
- SET DGRPOUT=1
- IF DGRPANN']""
- IF 'DGRPOUT
- GOTO NEXT
- +22 ; DG*5.3*1040 - If timed out, clean screen with W @IOF, use variable DGRPOUT to track timeout and exit
- +23 IF +$GET(DGRPOUT)
- WRITE @IOF,!!!
- GOTO QQ
- +24 IF $EXTRACT(DGRPANN)="E"
- IF $GET(DGNOBUCK)
- IF ("8^9"[DGRPS)
- Begin DoDot:1
- +25 SET DGNOCOPY=1
- +26 ; remove COPY option DG*5.3*688
- +27 SET DGRPANN=U_DGRPS
- SET DGRPVV(9)="000"
- SET DGRPVV(8)="00"
- SET DGIAINEW=1
- End DoDot:1
- JUMP ;
- +1 if DGRPANN="^"
- GOTO Q
- if DGRPANN?1"^".N.".".N.".".N
- GOTO JUMP^DGRPP1
- IF DGRPOUT!(DGRPANN?1"^".E)
- GOTO Q
- +2 SET (DGRPANN,X)=$$UPPER^DGUTL(DGRPANN)
- +3 IF $EXTRACT(DGRPANN)="A"
- SET X=DGRPANN
- SET Z="^ALL"
- DO IN^DGHELP
- IF %'=-1
- SET DGRPANN=DGRPANP
- +4 ;LEG; DG*5.3*997 ; add screen 11.5
- +5 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
- +6 SET DGDR=""
- FOR I=1:1
- SET DGCH=$PIECE(DGRPANN,",",I)
- if DGCH']""!($LENGTH(DGCH)>5)
- QUIT
- DO CHOICE
- +7 IF DGDR']""
- DO ^DGRPH
- SET X=DGRPS
- GOTO SCRX
- +8 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 IF 'DGRPV
- SET DGEDCN=1
- DO ^DGRPC
- KILL DGEDCN
- QQ 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
