- 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
