DGRPH ;ALB/MRL,TMK,JAM,ARF,ASF,LEG,ARF - REGISTRATION HELP ROUTINE ;Mar 10, 2020@19:19
;;5.3;Registration;**114,343,397,415,489,545,638,624,689,842,941,985,997,1014,1056,1064**;Aug 13, 1993;Build 41
;
S DGRPH="" D H^DGRPU K DGRPH
;LEG; DG*5.3*997; cosmetically adjusted the spacing around the word "listing" to account for if "and edit" text was/wasn't included
W !,"Enter '^' to stop the display ",$S(DGRPV:"",1:"and edit "),"of data, '^N' to jump to screen #N (see ",$S(DGRPV:"listing ",1:""),!,$S(DGRPV:"",1:"listing "),"below), <RET> to continue on to the next available screen"
I DGRPV,DGRPS'=11.5 W "." G M ;LEG; DG*5.3*1014 - added <11.5> processing
W " or enter",!,"the field group number(s) you wish to edit using commas and dashes as",!,"delimiters. Those groups enclosed in brackets ""[]"" are editable while those",!,"enclosed in arrows ""<>"" are not."
W " Enter 'ALL' to edit all editable data",!,"elements on the screen."
M I DGRPS=9,DGRPSEL="V" W !!,"You may precede your selection with 'V' to denote veteran."
I DGRPS=9,DGRPSEL]"V" W !!,"To edit a specific column, enter 'V'",$S($D(DGREL("S")):", 'S'",1:""),$S($D(DGREL("D")):", 'D'",1:"")," in front of the selected items."
;ASF; DG*5.3*997; added screen 11.5
S Z="DATA GROUPS ON SCREEN "_DGRPS,DGRPCM=1 W ! D WW^DGRPV S DGRPCM=0 D:DGRPS=1.1 A1 D:DGRPS=11.5 A2 D:DGRPS'=1.1&(DGRPS'?1"11.5".E) @DGRPS D:$S(DGRPS<12:1,DGRPS=14:1,1:0) W D S W ! F I=$Y:1:20 W !
;S Z="Press RETURN key",DGRPCM=1 D WW^DGRPV S DGRPCM=0 W " to EXIT Screen ",DGRPS," HELP " R X:DTIME S X="" Q
S DGRPW=0 W "Press " S Z="<RETURN>",DGRPCM=1 D WW^DGRPV W " KEY " S Z="TO EXIT" D WW^DGRPV W " SCREEN ",DGRPS," " S Z="HELP" D WW^DGRPV W " " R X:DTIME S (DGRPCM,DGRPW)=0 Q
;JAM; DG*5.3*941; Groups on screen 1 and 1.1 have changed so update help text to reflect new locations
;ARF; DG*5.3*985; Add 'Birth' to 'Sex' and 'Preferred Name of Patient' to the Help screen for PATIENT DEMOGRAPHIC SCREEN 1
1 S X="Name, SSN, DOB, Birth Sex^Alias Name & SSN (if applicable)^Remarks concerning this patient^Cell Phone, Pager, E-Mail^Date & Time, Preferred Language^Preferred Name of Patient" Q
;ARF; DG*5.3*1056 removed Permanent from the following address label
A1 S X="Residential Address^Mailing Address^Temporary Mailing Address^Confidential Mailing Address" Q
2 S X="POB, Parents, etc.^Dates/Locations of Previous Care^Race and Ethnicity^Date of Death Information^Emergency Response^Indian Attestation" Q ;jam; DG*5.3*1064 - Added Groups 5 and 6
3 S X="Primary Next-of-Kin^Secondary Next-of-Kin^Primary Emergency Contact^Secondary Emergency Contact^Designee to receive personal effects" Q
4 S X="Applicant Employer, Address^Spouses Employer, Address" Q
5 S X="Unexpired Insurance Policies^Eligibile for Medicaid" Q
6 S X="Service History^Conflict Locations^Exposure Factors^Prisoner of War^Combat^Military Retirement/Disability^Dental History^Purple Heart Recipient^Medal of Honor^Class II Dental Indicator" Q
7 S X="Patient Type, SC Data, Claim Info^VA Monetary Benefits^POS, Eligibility Code(s)^SC Conditions relayed by applicant" Q
8 S X="Spouse's Demographic Info^Dependents' Demographic Info" Q
9 S X="Social Security^U.S. Civil Service^U.S. Railroad Retirement^Military Retirement^Unemployment^Other Retirement^Total Employment Income^Interest,Dividend,Annuity^Workers Comp or Black Lung^Other Income" Q
10 S X="Ineligible Patient Information^Missing Patient Information" Q
11 S X="Eligibility Verification^Monetary Benefits Verification^Service Record Verification^Rated Disabilities (VA)^VHA Profiles (VHAP)" Q
A2 S X="Caregiver Status Data^Community Care Program (CCP) Collateral Data" Q ;LEG; DG*5.3*1014 added CCP
12 W !,"Four most recent admission episodes on file for this applicant are displayed",!,"in inverse order." Q
13 W !,"Four most recent applications for care (registrations) are displayed in",!,"inverse order." Q
14 S X="Clinics in which actively enrolled^Pending (future) appointments" Q
;LEG; DG*5.3*1014 added Q to end of line to resolve double AVAILABLE SCREENS display
15 W !,"Sponsor information is displayed for patients." Q
S W ! S Z="AVAILABLE SCREENS",DGRPCM=1 D WW^DGRPV S DGRPCM=0
;jam; DG*5.3*941; New wording for screens 1 and 1.1
S X="Patient Demographic^Additional Patient Demographic^Patient^Contact^Employment^Insurance^Service Record^Eligibility^Family Demographic^Income Screening^Missing/Ineligible^Eligibility Verification^"
;LEG; DG*5.3.997 ;added new Additional Eligibility Verification screen
S X=X_"Additional Elig Verification^Admission Info^Application Info^Appointment Info^Sponsor Demographics"
;S C=0 F I=1:1 S J=$P(X,"^",I) Q:J="" I '$E(DGRPVV,I) S C=C+1,Z="^"_I,DGRPW=(C#2) D WW^DGRPV S Z=$S(I?1N:" ",1:" ")_J_" Data",Z1=$S((C#2)&(I?1N):36,(C#2):35,1:1) D WW1^DGRPV:(C#2) I '(C#2) W Z
N DGJ
S DGJ=""
S C=0 F I=1:1 S DGJ=$O(DGRPVV(DGJ)) Q:DGJ="" I '$E(DGRPVV,DGJ) D
.S C=C+1,Z="^"_DGJ,DGRPW=(C#2)
.D WW^DGRPV
.;jam; DG*5.3*941; Change column position to fit the text of the new wording for screens 1 and 1.1
.S Z1=$S((C#2)&(DGJ?1N):33,(C#2):32,1:1)
.S Z=$S(DGJ?1N:" ",1:" ")_$P(X,U,I)_" Data"
.;LEG; DG*5.3*997; added to Available Screens list
.S:DGJ=11.5 Z=" Add'l Elig Verification Data",Z1=30
.D WW1^DGRPV:(C#2)
.I '(C#2) W Z
Q
W ;LEG; DG*5.3*1014 added C2L check for string too long if in column 2
F I=1:1 S J=$P(X,"^",I) Q:J="" S Z=I,DGRPW=(I#2) D:'DGRPW C2L D WW^DGRPV S Z=$S(I<10:" ",1:" ")_J,Z1=$S((I#2)&(I>10):36,(I#2):37,1:1) D WW1^DGRPV
W:'DGRPW ! ;'((I-1)#2) ! ;Q
Q
;LEG; DG*5.3*1014
C2L ;checks if string is too long for end of line display
I ($L(J)+$S(I>10:36,1:37))>80 S DGRPW=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRPH 5699 printed Sep 23, 2025@20:32:18 Page 2
DGRPH ;ALB/MRL,TMK,JAM,ARF,ASF,LEG,ARF - REGISTRATION HELP ROUTINE ;Mar 10, 2020@19:19
+1 ;;5.3;Registration;**114,343,397,415,489,545,638,624,689,842,941,985,997,1014,1056,1064**;Aug 13, 1993;Build 41
+2 ;
+3 SET DGRPH=""
DO H^DGRPU
KILL DGRPH
+4 ;LEG; DG*5.3*997; cosmetically adjusted the spacing around the word "listing" to account for if "and edit" text was/wasn't included
+5 WRITE !,"Enter '^' to stop the display ",$SELECT(DGRPV:"",1:"and edit "),"of data, '^N' to jump to screen #N (see ",$SELECT(DGRPV:"listing ",1:""),!,$SELECT(DGRPV:"",1:"listing "),"below), <RET> to continue on to the next available screen"
+6 ;LEG; DG*5.3*1014 - added <11.5> processing
IF DGRPV
IF DGRPS'=11.5
WRITE "."
GOTO M
+7 WRITE " or enter",!,"the field group number(s) you wish to edit using commas and dashes as",!,"delimiters. Those groups enclosed in brackets ""[]"" are editable while those",!,"enclosed in arrows ""<>"" are not."
+8 WRITE " Enter 'ALL' to edit all editable data",!,"elements on the screen."
M IF DGRPS=9
IF DGRPSEL="V"
WRITE !!,"You may precede your selection with 'V' to denote veteran."
+1 IF DGRPS=9
IF DGRPSEL]"V"
WRITE !!,"To edit a specific column, enter 'V'",$SELECT($DATA(DGREL("S")):", 'S'",1:""),$SELECT($DATA(DGREL("D")):", 'D'",1:"")," in front of the selected items."
+2 ;ASF; DG*5.3*997; added screen 11.5
+3 SET Z="DATA GROUPS ON SCREEN "_DGRPS
SET DGRPCM=1
WRITE !
DO WW^DGRPV
SET DGRPCM=0
if DGRPS=1.1
DO A1
if DGRPS=11.5
DO A2
if DGRPS'=1.1&(DGRPS'?1"11.5".E)
DO @DGRPS
if $SELECT(DGRPS<12
DO W
DO S
WRITE !
FOR I=$Y:1:20
WRITE !
+4 ;S Z="Press RETURN key",DGRPCM=1 D WW^DGRPV S DGRPCM=0 W " to EXIT Screen ",DGRPS," HELP " R X:DTIME S X="" Q
+5 SET DGRPW=0
WRITE "Press "
SET Z="<RETURN>"
SET DGRPCM=1
DO WW^DGRPV
WRITE " KEY "
SET Z="TO EXIT"
DO WW^DGRPV
WRITE " SCREEN ",DGRPS," "
SET Z="HELP"
DO WW^DGRPV
WRITE " "
READ X:DTIME
SET (DGRPCM,DGRPW)=0
QUIT
+6 ;JAM; DG*5.3*941; Groups on screen 1 and 1.1 have changed so update help text to reflect new locations
+7 ;ARF; DG*5.3*985; Add 'Birth' to 'Sex' and 'Preferred Name of Patient' to the Help screen for PATIENT DEMOGRAPHIC SCREEN 1
1 SET X="Name, SSN, DOB, Birth Sex^Alias Name & SSN (if applicable)^Remarks concerning this patient^Cell Phone, Pager, E-Mail^Date & Time, Preferred Language^Preferred Name of Patient"
QUIT
+1 ;ARF; DG*5.3*1056 removed Permanent from the following address label
A1 SET X="Residential Address^Mailing Address^Temporary Mailing Address^Confidential Mailing Address"
QUIT
2 ;jam; DG*5.3*1064 - Added Groups 5 and 6
SET X="POB, Parents, etc.^Dates/Locations of Previous Care^Race and Ethnicity^Date of Death Information^Emergency Response^Indian Attestation"
QUIT
3 SET X="Primary Next-of-Kin^Secondary Next-of-Kin^Primary Emergency Contact^Secondary Emergency Contact^Designee to receive personal effects"
QUIT
4 SET X="Applicant Employer, Address^Spouses Employer, Address"
QUIT
5 SET X="Unexpired Insurance Policies^Eligibile for Medicaid"
QUIT
6 SET X="Service History^Conflict Locations^Exposure Factors^Prisoner of War^Combat^Military Retirement/Disability^Dental History^Purple Heart Recipient^Medal of Honor^Class II Dental Indicator"
QUIT
7 SET X="Patient Type, SC Data, Claim Info^VA Monetary Benefits^POS, Eligibility Code(s)^SC Conditions relayed by applicant"
QUIT
8 SET X="Spouse's Demographic Info^Dependents' Demographic Info"
QUIT
9 SET X="Social Security^U.S. Civil Service^U.S. Railroad Retirement^Military Retirement^Unemployment^Other Retirement^Total Employment Income^Interest,Dividend,Annuity^Workers Comp or Black Lung^Other Income"
QUIT
10 SET X="Ineligible Patient Information^Missing Patient Information"
QUIT
11 SET X="Eligibility Verification^Monetary Benefits Verification^Service Record Verification^Rated Disabilities (VA)^VHA Profiles (VHAP)"
QUIT
A2 ;LEG; DG*5.3*1014 added CCP
SET X="Caregiver Status Data^Community Care Program (CCP) Collateral Data"
QUIT
12 WRITE !,"Four most recent admission episodes on file for this applicant are displayed",!,"in inverse order."
QUIT
13 WRITE !,"Four most recent applications for care (registrations) are displayed in",!,"inverse order."
QUIT
14 SET X="Clinics in which actively enrolled^Pending (future) appointments"
QUIT
+1 ;LEG; DG*5.3*1014 added Q to end of line to resolve double AVAILABLE SCREENS display
15 WRITE !,"Sponsor information is displayed for patients."
QUIT
S WRITE !
SET Z="AVAILABLE SCREENS"
SET DGRPCM=1
DO WW^DGRPV
SET DGRPCM=0
+1 ;jam; DG*5.3*941; New wording for screens 1 and 1.1
+2 SET X="Patient Demographic^Additional Patient Demographic^Patient^Contact^Employment^Insurance^Service Record^Eligibility^Family Demographic^Income Screening^Missing/Ineligible^Eligibility Verification^"
+3 ;LEG; DG*5.3.997 ;added new Additional Eligibility Verification screen
+4 SET X=X_"Additional Elig Verification^Admission Info^Application Info^Appointment Info^Sponsor Demographics"
+5 ;S C=0 F I=1:1 S J=$P(X,"^",I) Q:J="" I '$E(DGRPVV,I) S C=C+1,Z="^"_I,DGRPW=(C#2) D WW^DGRPV S Z=$S(I?1N:" ",1:" ")_J_" Data",Z1=$S((C#2)&(I?1N):36,(C#2):35,1:1) D WW1^DGRPV:(C#2) I '(C#2) W Z
+6 NEW DGJ
+7 SET DGJ=""
+8 SET C=0
FOR I=1:1
SET DGJ=$ORDER(DGRPVV(DGJ))
if DGJ=""
QUIT
IF '$EXTRACT(DGRPVV,DGJ)
Begin DoDot:1
+9 SET C=C+1
SET Z="^"_DGJ
SET DGRPW=(C#2)
+10 DO WW^DGRPV
+11 ;jam; DG*5.3*941; Change column position to fit the text of the new wording for screens 1 and 1.1
+12 SET Z1=$SELECT((C#2)&(DGJ?1N):33,(C#2):32,1:1)
+13 SET Z=$SELECT(DGJ?1N:" ",1:" ")_$PIECE(X,U,I)_" Data"
+14 ;LEG; DG*5.3*997; added to Available Screens list
+15 if DGJ=11.5
SET Z=" Add'l Elig Verification Data"
SET Z1=30
+16 if (C#2)
DO WW1^DGRPV
+17 IF '(C#2)
WRITE Z
End DoDot:1
+18 QUIT
W ;LEG; DG*5.3*1014 added C2L check for string too long if in column 2
+1 FOR I=1:1
SET J=$PIECE(X,"^",I)
if J=""
QUIT
SET Z=I
SET DGRPW=(I#2)
if 'DGRPW
DO C2L
DO WW^DGRPV
SET Z=$SELECT(I<10:" ",1:" ")_J
SET Z1=$SELECT((I#2)&(I>10):36,(I#2):37,1:1)
DO WW1^DGRPV
+2 ;'((I-1)#2) ! ;Q
if 'DGRPW
WRITE !
+3 QUIT
+4 ;LEG; DG*5.3*1014
C2L ;checks if string is too long for end of line display
+1 IF ($LENGTH(J)+$SELECT(I>10:36,1:37))>80
SET DGRPW=1
+2 QUIT
