AG3.m

AG3 ; IHS/ASDS/EFG - ENTRY UTILITY FOR NON-MANDATORY DATA ; 

 ;;7.1;PATIENT REGISTRATION;**2,4**;JAN 31, 2007

 ;

 W !!,">>This option asks all questions one after the other with no escaping<<",!!

L1 D S1,SSN^AG3A G:$D(DUOUT) S1

 I $D(DUOUT)!(X="") G:AGOPT(14)'="Y" L4 W !,"Without a Social Security Number a BIC cannot be issued - try again!" D S1,SSN^AG3A G S1:$D(DUOUT)

 ;IHS/SD/TPF 4/24/2006 AG*7.1*2 ITEM 12 PAGE 11

 ;ASK MARITAL STATUS

ASKMSTAT ;

 K DIE,DR,DIC,DIR,DA

 S DIE="^DPT("

 S DR=.05

 S DA=AGPATDFN

 D ^DIE

 G:$D(DUOUT)!($D(DTOUT))!($D(DIROUT)) L1

 ;END NEW CODE

L4 ;D S1,COB^AG3A G L1:$D(DUOUT)

 D S1,COB^AG3A G ASKMSTAT:$D(DUOUT)  ;IHS/SD/TPF 4/24/2006 AG*7.1*2 ITEM 12 PAGE 11

L5 D S1,SOB^AG3A G L4:$D(DUOUT)

 ;IHS/SD/TPF 4/24/2006 AG*7.1*2 ITEM 5 PAGE 11

ASKWEB ;

 D WEB^AGED1

 ;END NEW CODE

L6 ;D S1,ST^AG3A G L5:$D(DUOUT),L10:X=""

 D S1,ST^AG3A G ASKWEB:$D(DUOUT),L10:X=""  ;IHS/SD/TPF 4/24/2006 AG*7.1*2 ITEM 5 PAGE 11

L7 D S1,CITY^AG3A G L6:$D(DUOUT)

L8 D S1,STATE^AG3A G L7:$D(DUOUT)

L9 D S1,ZIP^AG3A G L8:$D(DUOUT)

L10 D S1,HPH^AG3A G L9:$D(DUOUT)

 ;BAR*71.*4 SCR D151

 W !!

 W !,$G(NEWST)

 W !,$G(NEWCITY),",",$G(NEWSTATE),"  ",$G(NEWZIP)

 W !,$G(NEWHPH)

 W !!

 N DUOUT,DTOUT,DFOUT

 K DIR

 S DIR(0)="YO"

 S DIR("A")="Is this address correct"

 S DIR("B")="Y"

 D ^DIR

 G:'Y!$D(DTOUT)!$D(DUOUT)!$D(DIRUT) L6

 W !!,"Adding to PREVIOUS MAIL ADDRESSES FIELD...." H 2

 D UPDTHADD^AGUTILS(DFN,"N")  ;N SIGNIFIES THIS IS AN EDIT AND NOT A POST INSTALL FORCE

 ;END BAR*7.1*4

L11 D S1,OPH^AG3A G L10:$D(DUOUT)

L11A D S1,MSGPH^AGED1 G L11:$D(DUOUT)  ;IHS/SD/TPF 3/13/2008 AG*7.1*4 SCR

L12OPT I AGOPT(3)="Y" D S1,ALIAS^AGOPT2 G L11:$D(DUOUT) I 1

 E  G L11:$D(DUOUT)

 G ^AG4

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

DUOUT ;EP

 G L12OPT

AG3       ; IHS/ASDS/EFG - ENTRY UTILITY FOR NON-MANDATORY DATA ; 

 +1       ;;7.1;PATIENT REGISTRATION;**2,4**;JAN 31, 2007

 +2       ;

 +3        WRITE !!,">>This option asks all questions one after the other with no escaping<<",!!

L1         DO S1

           DO SSN^AG3A

           IF $DATA(DUOUT)

               GOTO S1

 +1        IF $DATA(DUOUT)!(X="")

               IF AGOPT(14)'="Y"

                   GOTO L4

               WRITE !,"Without a Social Security Number a BIC cannot be issued - try again!"

               DO S1

               DO SSN^AG3A

               IF $DATA(DUOUT)

                   GOTO S1

 +2       ;IHS/SD/TPF 4/24/2006 AG*7.1*2 ITEM 12 PAGE 11

 +3       ;ASK MARITAL STATUS

ASKMSTAT  ;

 +1        KILL DIE,DR,DIC,DIR,DA

 +2        SET DIE="^DPT("

 +3        SET DR=.05

 +4        SET DA=AGPATDFN

 +5        DO ^DIE

 +6        IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DIROUT))

               GOTO L1

 +7       ;END NEW CODE

L4        ;D S1,COB^AG3A G L1:$D(DUOUT)

 +1       ;IHS/SD/TPF 4/24/2006 AG*7.1*2 ITEM 12 PAGE 11

           DO S1

           DO COB^AG3A

           IF $DATA(DUOUT)

               GOTO ASKMSTAT

L5         DO S1

           DO SOB^AG3A

           IF $DATA(DUOUT)

               GOTO L4

 +1       ;IHS/SD/TPF 4/24/2006 AG*7.1*2 ITEM 5 PAGE 11

ASKWEB    ;

 +1        DO WEB^AGED1

 +2       ;END NEW CODE

L6        ;D S1,ST^AG3A G L5:$D(DUOUT),L10:X=""

 +1       ;IHS/SD/TPF 4/24/2006 AG*7.1*2 ITEM 5 PAGE 11

           DO S1

           DO ST^AG3A

           IF $DATA(DUOUT)

               GOTO ASKWEB

           IF X=""

               GOTO L10

L7         DO S1

           DO CITY^AG3A

           IF $DATA(DUOUT)

               GOTO L6

L8         DO S1

           DO STATE^AG3A

           IF $DATA(DUOUT)

               GOTO L7

L9         DO S1

           DO ZIP^AG3A

           IF $DATA(DUOUT)

               GOTO L8

L10        DO S1

           DO HPH^AG3A

           IF $DATA(DUOUT)

               GOTO L9

 +1       ;BAR*71.*4 SCR D151

 +2        WRITE !!

 +3        WRITE !,$GET(NEWST)

 +4        WRITE !,$GET(NEWCITY),",",$GET(NEWSTATE),"  ",$GET(NEWZIP)

 +5        WRITE !,$GET(NEWHPH)

 +6        WRITE !!

 +7        NEW DUOUT,DTOUT,DFOUT

 +8        KILL DIR

 +9        SET DIR(0)="YO"

 +10       SET DIR("A")="Is this address correct"

 +11       SET DIR("B")="Y"

 +12       DO ^DIR

 +13       IF 'Y!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)

               GOTO L6

 +14       WRITE !!,"Adding to PREVIOUS MAIL ADDRESSES FIELD...."

           HANG 2

 +15      ;N SIGNIFIES THIS IS AN EDIT AND NOT A POST INSTALL FORCE

           DO UPDTHADD^AGUTILS(DFN,"N")

 +16      ;END BAR*7.1*4

L11        DO S1

           DO OPH^AG3A

           IF $DATA(DUOUT)

               GOTO L10

L11A      ;IHS/SD/TPF 3/13/2008 AG*7.1*4 SCR

           DO S1

           DO MSGPH^AGED1

           IF $DATA(DUOUT)

               GOTO L11

L12OPT     IF AGOPT(3)="Y"

               DO S1

               DO ALIAS^AGOPT2

               IF $DATA(DUOUT)

                   GOTO L11

               IF 1

 +1       IF '$TEST

               IF $DATA(DUOUT)

                   GOTO L11

 +2        GOTO ^AG4

S1         KILL DFOUT,DTOUT,DUOUT,DLOUT,DQOUT

           QUIT 

DUOUT     ;EP

 +1        GOTO L12OPT