AGOPT2.m

AGOPT2 ; IHS/ASDS/EFG - ENTER OPTIONAL ITEMS ;  

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

 ;

TQTM ;EP - Tribal Blood Quantum.

 D S1

 S DR=1109

 D END

 Q

TRINUM ;EP - Tribal Enrollment Number.

 D S1

 S DR=.07

 D END

 Q

ALIAS ;EP - Other Names.

 D S2

 S DR=1

 D END

 Q

OTHRTR ;EP - Other Tribes & Quanta.

 D S1

 S DR=4301

 D END

 Q

S1 ;

 K DUOUT

 S DIE="^AUPNPAT("

 S DA=DFN

 W !

 Q

S2 ;

 K DUOUT

 S DIE="^DPT("

 S DA=DFN

 W !

 Q

END ;

 D ^DIE

 S:$D(Y) DUOUT=""

 Q

AGOPT2    ; IHS/ASDS/EFG - ENTER OPTIONAL ITEMS ;  

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

 +2       ;

TQTM      ;EP - Tribal Blood Quantum.

 +1        DO S1

 +2        SET DR=1109

 +3        DO END

 +4        QUIT 

TRINUM    ;EP - Tribal Enrollment Number.

 +1        DO S1

 +2        SET DR=.07

 +3        DO END

 +4        QUIT 

ALIAS     ;EP - Other Names.

 +1        DO S2

 +2        SET DR=1

 +3        DO END

 +4        QUIT 

OTHRTR    ;EP - Other Tribes & Quanta.

 +1        DO S1

 +2        SET DR=4301

 +3        DO END

 +4        QUIT 

S1        ;

 +1        KILL DUOUT

 +2        SET DIE="^AUPNPAT("

 +3        SET DA=DFN

 +4        WRITE !

 +5        QUIT 

S2        ;

 +1        KILL DUOUT

 +2        SET DIE="^DPT("

 +3        SET DA=DFN

 +4        WRITE !

 +5        QUIT 

END       ;

 +1        DO ^DIE

 +2        IF $DATA(Y)

               SET DUOUT=""

 +3        QUIT