AGELPHCK.m

AGELPHCK ; IHS/ASDS/EFG - Check if Registered Policy Holder ;   

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

 ;

 I $D(AGELP("PHPAT")),AGELP("PHPAT")]"",$D(^DPT(AGELP("PHPAT"),0)) G REG

 W !!,"Presently the POLICY HOLDER is NOT known as a REGISTERED PATIENT."

 W !

 K DIR

 S DIR(0)="Y",DIR("B")="Y"

 S DIR("A")="Want to SCAN to see if the Policy Holder is Registered"

 D ^DIR

 K DIR

 G XIT:$D(DTOUT)!(Y="^")

 G NAME:Y=0,PLK

REG I AGELP("MODE")="A" G NAME

 W !!?5,"The Policy Holder is presently linked to "

 W $P(^DPT(AGELP("PHPAT"),0),U),$S($D(^AUPNPAT(AGELP("PHPAT"),41,DUZ(2),0)):" ["_$P(^(0),U,2)_"]",1:"")

 W !?5,"in your Patient Registration data base."

 K DIR

 W !

 S DIR("A")="Want to REMOVE the linkage with this Registered Patient (Y/N)"

 S DIR(0)="Y",DIR("B")="N"

 D ^DIR

 K DIR

 G XIT:$D(DTOUT)!(Y="^")

 I Y=1 D

 .S DIE="^AUPN3PPH("

 .S DA=AGELP("PH")

 .S DR=".02///@;.08///@;.19///@"

 .D ^DIE

 .K AGELP("PHPAT")

 .G AGELPHCK

 G NAME

PLK K DIC

 S DIC(0)="QZEAM",DIC="^AUPNPAT("

 D ^DIC

 I +Y<0 G NAME

 S AGEL("YCK")=Y

 W !

 K DIR

 S DIR(0)="Y",DIR("B")="Y"

 S DIR("A")="Is "_Y(0,0)_" the Policy Holder (Y/N)"

 D ^DIR

 K DIR

 G XIT:$D(DTOUT)!(Y="^")

 I Y=0 G PLK

 S DIE="^AUPN3PPH(",DA=AGELP("PH")

 S DR=".02////"_+AGEL("YCK")

 D ^DIE

NAME W !

 S DIE="^AUPN3PPH(",DA=AGELP("PH")

 S DR=".01Name as Stated on Policy..: "

 D ^DIE

 S DR=".09;.11;.12;.13;.14"

 D ^DIE

XIT K DIR,DUOUT,DTOUT,DIROUT,DIRUT

 Q

AGELPHCK  ; IHS/ASDS/EFG - Check if Registered Policy Holder ;   

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

 +2       ;

 +3        IF $DATA(AGELP("PHPAT"))

               IF AGELP("PHPAT")]""

                   IF $DATA(^DPT(AGELP("PHPAT"),0))

                       GOTO REG

 +4        WRITE !!,"Presently the POLICY HOLDER is NOT known as a REGISTERED PATIENT."

 +5        WRITE !

 +6        KILL DIR

 +7        SET DIR(0)="Y"

           SET DIR("B")="Y"

 +8        SET DIR("A")="Want to SCAN to see if the Policy Holder is Registered"

 +9        DO ^DIR

 +10       KILL DIR

 +11       IF $DATA(DTOUT)!(Y="^")

               GOTO XIT

 +12       IF Y=0

               GOTO NAME

           GOTO PLK

REG        IF AGELP("MODE")="A"

               GOTO NAME

 +1        WRITE !!?5,"The Policy Holder is presently linked to "

 +2        WRITE $PIECE(^DPT(AGELP("PHPAT"),0),U),$SELECT($DATA(^AUPNPAT(AGELP("PHPAT"),41,DUZ(2),0)):" ["_$PIECE(^(0),U,2)_"]",1:"")

 +3        WRITE !?5,"in your Patient Registration data base."

 +4        KILL DIR

 +5        WRITE !

 +6        SET DIR("A")="Want to REMOVE the linkage with this Registered Patient (Y/N)"

 +7        SET DIR(0)="Y"

           SET DIR("B")="N"

 +8        DO ^DIR

 +9        KILL DIR

 +10       IF $DATA(DTOUT)!(Y="^")

               GOTO XIT

 +11       IF Y=1

               Begin DoDot:1

 +12               SET DIE="^AUPN3PPH("

 +13               SET DA=AGELP("PH")

 +14               SET DR=".02///@;.08///@;.19///@"

 +15               DO ^DIE

 +16               KILL AGELP("PHPAT")

 +17               GOTO AGELPHCK

               End DoDot:1

 +18       GOTO NAME

PLK        KILL DIC

 +1        SET DIC(0)="QZEAM"

           SET DIC="^AUPNPAT("

 +2        DO ^DIC

 +3        IF +Y<0

               GOTO NAME

 +4        SET AGEL("YCK")=Y

 +5        WRITE !

 +6        KILL DIR

 +7        SET DIR(0)="Y"

           SET DIR("B")="Y"

 +8        SET DIR("A")="Is "_Y(0,0)_" the Policy Holder (Y/N)"

 +9        DO ^DIR

 +10       KILL DIR

 +11       IF $DATA(DTOUT)!(Y="^")

               GOTO XIT

 +12       IF Y=0

               GOTO PLK

 +13       SET DIE="^AUPN3PPH("

           SET DA=AGELP("PH")

 +14       SET DR=".02////"_+AGEL("YCK")

 +15       DO ^DIE

NAME       WRITE !

 +1        SET DIE="^AUPN3PPH("

           SET DA=AGELP("PH")

 +2        SET DR=".01Name as Stated on Policy..: "

 +3        DO ^DIE

 +4        SET DR=".09;.11;.12;.13;.14"

 +5        DO ^DIE

XIT        KILL DIR,DUOUT,DTOUT,DIROUT,DIRUT

 +1        QUIT