- 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 Mar 13, 2025@22:01:08 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
