AG8.m

AG8 ; IHS/ADSS/EFG - ENTRY UTILITY FOR NON-MANDATORY DATA ;  

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

L1 D S1,REL^AG8A G DUOUT^AG7:$D(DUOUT)

L2 D S1,FNAME^AG8A G L1:$D(DUOUT),L6:X=""

L4 D S1,FCOB^AG8A G L2:$D(DUOUT)

L5 D S1,FSOB^AG8A G L4:$D(DUOUT)

 D S1,FEMP^AG8A

L6 D S1,MNAME^AG8A G L5:$D(DUOUT),L81:X=""

L7 D S1,MCOB^AG8A G L6:$D(DUOUT)

L8 D S1,MSOB^AG8A G L7:$D(DUOUT)

 D S1,MEMP^AG8A

L81 ;IF PATIENT IS UNDER 18, PARENT EMPLOYER ENTRY IS REQUIRED

 I $$AGE^AUPNPAT(DFN)<18,$P($G(^AUPNPAT(DFN,27)),U)="",$P($G(^AUPNPAT(DFN,27)),U,2)="" W !!,"PATIENT IS A MINOR AND MUST HAVE FATHER'S OR MOTHER'S EMPLOYER ENTERED" H 2 G L2

L9 D S1,ECNAME^AG8A G L8:$D(DUOUT),L16:X=""

L10 D S1,ECREL^AG8A G L9:$D(DUOUT)

L11 D S1,ECSTR^AG8A G L10:$D(DUOUT),L15:X=""

L12 D S1,ECCITY^AG8A G L11:$D(DUOUT)

L13 D S1,ECST^AG8A G L12:$D(DUOUT)

L14 D S1,ECZIP^AG8A G L13:$D(DUOUT)

L15 D S1,ECPH^AG8A G L14:$D(DUOUT)

L16 D S1,EMPLR^AGED2 G L15:$D(DUOUT)

L17 D S1,SPSEMP^AGED2 G L16:$D(DUOUT)

END1 I AGOPT(7)'="Y" G ADD^AGED9

N1 D S1,NKNAME^AG8B G L17:$D(DUOUT),END2:'$D(X),END2:X=""

N2 D S1,NKREL^AG8B G N1:$D(DUOUT)

N3 D S1,NKSTR^AG8B G N2:$D(DUOUT)

N4 D S1,NKCITY^AG8B G N3:$D(DUOUT)

N5 D S1,NKST^AG8B G N4:$D(DUOUT)

N6 D S1,NKZIP^AG8B G N5:$D(DUOUT)

N7 D S1,NKPH^AG8B G N6:$D(DUOUT)

END2 G ADD^AGED9

S1 K DFOUT,DTOUT,DUOUT,DLOUT,DQOUT Q

DUOUT G L15:AGOPT(7)'="Y",N7

AG8       ; IHS/ADSS/EFG - ENTRY UTILITY FOR NON-MANDATORY DATA ;  

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

L1         DO S1

           DO REL^AG8A

           IF $DATA(DUOUT)

               GOTO DUOUT^AG7

L2         DO S1

           DO FNAME^AG8A

           IF $DATA(DUOUT)

               GOTO L1

           IF X=""

               GOTO L6

L4         DO S1

           DO FCOB^AG8A

           IF $DATA(DUOUT)

               GOTO L2

L5         DO S1

           DO FSOB^AG8A

           IF $DATA(DUOUT)

               GOTO L4

 +1        DO S1

           DO FEMP^AG8A

L6         DO S1

           DO MNAME^AG8A

           IF $DATA(DUOUT)

               GOTO L5

           IF X=""

               GOTO L81

L7         DO S1

           DO MCOB^AG8A

           IF $DATA(DUOUT)

               GOTO L6

L8         DO S1

           DO MSOB^AG8A

           IF $DATA(DUOUT)

               GOTO L7

 +1        DO S1

           DO MEMP^AG8A

L81       ;IF PATIENT IS UNDER 18, PARENT EMPLOYER ENTRY IS REQUIRED

 +1        IF $$AGE^AUPNPAT(DFN)<18

               IF $PIECE($GET(^AUPNPAT(DFN,27)),U)=""

                   IF $PIECE($GET(^AUPNPAT(DFN,27)),U,2)=""

                       WRITE !!,"PATIENT IS A MINOR AND MUST HAVE FATHER'S OR MOTHER'S EMPLOYER ENTERED"

                       HANG 2

                       GOTO L2

L9         DO S1

           DO ECNAME^AG8A

           IF $DATA(DUOUT)

               GOTO L8

           IF X=""

               GOTO L16

L10        DO S1

           DO ECREL^AG8A

           IF $DATA(DUOUT)

               GOTO L9

L11        DO S1

           DO ECSTR^AG8A

           IF $DATA(DUOUT)

               GOTO L10

           IF X=""

               GOTO L15

L12        DO S1

           DO ECCITY^AG8A

           IF $DATA(DUOUT)

               GOTO L11

L13        DO S1

           DO ECST^AG8A

           IF $DATA(DUOUT)

               GOTO L12

L14        DO S1

           DO ECZIP^AG8A

           IF $DATA(DUOUT)

               GOTO L13

L15        DO S1

           DO ECPH^AG8A

           IF $DATA(DUOUT)

               GOTO L14

L16        DO S1

           DO EMPLR^AGED2

           IF $DATA(DUOUT)

               GOTO L15

L17        DO S1

           DO SPSEMP^AGED2

           IF $DATA(DUOUT)

               GOTO L16

END1       IF AGOPT(7)'="Y"

               GOTO ADD^AGED9

N1         DO S1

           DO NKNAME^AG8B

           IF $DATA(DUOUT)

               GOTO L17

           IF '$DATA(X)

               GOTO END2

           IF X=""

               GOTO END2

N2         DO S1

           DO NKREL^AG8B

           IF $DATA(DUOUT)

               GOTO N1

N3         DO S1

           DO NKSTR^AG8B

           IF $DATA(DUOUT)

               GOTO N2

N4         DO S1

           DO NKCITY^AG8B

           IF $DATA(DUOUT)

               GOTO N3

N5         DO S1

           DO NKST^AG8B

           IF $DATA(DUOUT)

               GOTO N4

N6         DO S1

           DO NKZIP^AG8B

           IF $DATA(DUOUT)

               GOTO N5

N7         DO S1

           DO NKPH^AG8B

           IF $DATA(DUOUT)

               GOTO N6

END2       GOTO ADD^AGED9

S1         KILL DFOUT,DTOUT,DUOUT,DLOUT,DQOUT

           QUIT 

DUOUT      IF AGOPT(7)'="Y"

               GOTO L15

           GOTO N7