Routine: DGRPH

DGRPH ;ALB/MRL,TMK - REGISTRATION HELP ROUTINE ;19 OCT 05

 ;;5.3;Registration;**114,343,397,415,489,545,638,624,689,1015**;Aug 13, 1993;Build 21

 S DGRPH="" D H^DGRPU K DGRPH W !,"Enter '^' to stop the display ",$S(DGRPV:"",1:"and edit "),"of data, '^N' to jump to screen #N (see",!,"listing below), <RET> to continue on to the next available screen" I DGRPV W "." G M

 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."

 S Z="DATA GROUPS ON SCREEN "_DGRPS,DGRPCM=1 W ! D WW^DGRPV S DGRPCM=0 D:DGRPS=1.1 A1 D:DGRPS'=1.1 @DGRPS D:$S(DGRPS<11: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

1 S X="Name, SSN, DOB, Sex^Alias Name & SSN (if applicable)^Remarks concerning this patient^Home Address, Phone & Work Phone^Temporary Address, Dates, Phone" Q

A1 S X="Conf. Address,Dates and Types^E-Mail, Cell Phone & Pager #s" Q

2 S X="POB, Parents, etc.^Dates/Locations of Previous Care^Race and Ethnicity^Date of Death Information" Q

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" 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)" Q

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

15 W !,"Sponsor information is displayed for patients." Q

S W ! S Z="AVAILABLE SCREENS",DGRPCM=1 D WW^DGRPV S DGRPCM=0

 S X="Demographic^Confidential Address^Patient^Contact^Employment^Insurance^Service Record^Eligibility^Family Demographic^Income Screening^Missing/Ineligible^Eligibility Verification^"

 S X=X_"Admission Info^Application Info^Appointment Info^Sponsor Demograhics"

 ;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

 .S Z1=$S((C#2)&(DGJ?1N):36,(C#2):35,1:1)

 .S Z=$S(DGJ?1N:"  ",1:" ")_$P(X,U,I)_" Data"

 .D WW1^DGRPV:(C#2)

 .I '(C#2) W Z

W F I=1:1 S J=$P(X,"^",I) Q:J=""  S Z=I,DGRPW=(I#2) 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:'((I-1)#2) ! Q

DGRPH     ;ALB/MRL,TMK - REGISTRATION HELP ROUTINE ;19 OCT 05

 +1       ;;5.3;Registration;**114,343,397,415,489,545,638,624,689,1015**;Aug 13, 1993;Build 21

 +2        SET DGRPH=""

           DO H^DGRPU

           KILL DGRPH

           WRITE !,"Enter '^' to stop the display ",$SELECT(DGRPV:"",1:"and edit "),"of data, '^N' to jump to screen #N (see",!,"listing below), <RET> to continue on to the next available screen"

           IF DGRPV

               WRITE "."

               GOTO M

 +3        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."

 +4        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        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'=1.1

               DO @DGRPS

           IF $SELECT(DGRPS<11

               DO W

           DO S

           WRITE !

           FOR I=$Y:1:20

               WRITE !

 +3       ;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

 +4        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

1          SET X="Name, SSN, DOB, Sex^Alias Name & SSN (if applicable)^Remarks concerning this patient^Home Address, Phone & Work Phone^Temporary Address, Dates, Phone"

           QUIT

A1         SET X="Conf. Address,Dates and Types^E-Mail, Cell Phone & Pager #s"

           QUIT

2          SET X="POB, Parents, etc.^Dates/Locations of Previous Care^Race and Ethnicity^Date of Death Information"

           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"

           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)"

           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

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        SET X="Demographic^Confidential Address^Patient^Contact^Employment^Insurance^Service Record^Eligibility^Family Demographic^Income Screening^Missing/Ineligible^Eligibility Verification^"

 +2        SET X=X_"Admission Info^Application Info^Appointment Info^Sponsor Demograhics"

 +3       ;S">S C=0 F I=1:1 S">S J=$P(X,"^",I) Q:J=""  I '$E(DGRPVV,I) S">S C=C+1,Z="^"_I,DGRPW=(C#2) D WW^DGRPV S">S Z=$S">S(I?1N:"  ",1:" ")_J_" Data",Z1=$S">S((C#2)&(I?1N):36,(C#2):35,1:1) D WW1^DGRPV:(C#2) I '(C#2) W Z

 +4        NEW DGJ

 +5        SET DGJ=""

 +6        SET C=0

           FOR I=1:1

               SET DGJ=$ORDER(DGRPVV(DGJ))

               IF DGJ=""

                   QUIT

               IF '$EXTRACT(DGRPVV,DGJ)

                   Begin DoDot:1

 +7                    SET C=C+1

                       SET Z="^"_DGJ

                       SET DGRPW=(C#2)

 +8                    DO WW^DGRPV

 +9                    SET Z1=$SELECT((C#2)&(DGJ?1N):36,(C#2):35,1:1)

 +10                   SET Z=$SELECT(DGJ?1N:"  ",1:" ")_$PIECE(X,U,I)_" Data"

 +11                   IF (C#2)

                           DO WW1^DGRPV

 +12                   IF '(C#2)

                           WRITE Z

                   End DoDot:1

 +13       QUIT

W          FOR I=1:1

               SET J=$PIECE(X,"^",I)

               IF J=""

                   QUIT

               SET Z=I

               SET DGRPW=(I#2)

               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

 +1        IF '((I-1)#2)

               WRITE !

           QUIT

DGRPH.m