DGHELP.m

DGHELP ;ALB/JDS - EXECUTABLE ADT HELP PROMPTS ; 14 JUN 84  11:29

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 ;

EN ;called from ques node on dispo multiple

 Q

P305 W !!,"Enter a string of characters, 1-5 characters in length",!,"It must only contain:",?25,"'A' for Aide and Assistance amount"

 W !?25,"'H' for HB amount",!?25,"'S' for Social Security amount",!?25,"'R' for Retirement pay amount",!?25,"'D' for Disability amount."

 W !?25,"'P' for Pension amount"

 Q

UP I X'?.UNP F %=1:1:$L(X) I $E(X,%)?1L S X=$E(X,0,%-1)_$C($A(X,%)-32)_$E(X,%+1,999)

 Q

IN S %=0 D UP I X]""&(Z[(U_X)) F I=$F(Z,U_X):1 S %=$E(Z,I) Q:%=U!(%']"")  W %

 E  S %=-1

 S:'% X=$E(X,1) K Z

 Q

LOCK I '$D(^XUSEC("DG ELIGIBILITY",DUZ)),$D(^DPT(DFN,.361)) I $P(^(.361),U,1)="V" W !,"Verification of Eligibility done Eligibility Key required to edit this field" K X

 Q

LOC I '$D(^XUSEC("DG ELIGIBILITY",DUZ)) W !,"Eligibility Key required to edit this field" K X

 Q

DOB S Y=$P(^DPT(DA,0),U,3) I Y,X<(100000+Y) K X X ^DD("DD") W !,"Patient's DOB is ",Y

 Q

SSN I X'?.UN F %=1:1:$L(X) I $E(X,%)?1P S X=$E(X,0,%-1)_$E(X,%+1,999)

DGHELP    ;ALB/JDS - EXECUTABLE ADT HELP PROMPTS ; 14 JUN 84  11:29

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 +2       ;

EN        ;called from ques node on dispo multiple

 +1        QUIT 

P305       WRITE !!,"Enter a string of characters, 1-5 characters in length",!,"It must only contain:",?25,"'A' for Aide and Assistance amount"

 +1        WRITE !?25,"'H' for HB amount",!?25,"'S' for Social Security amount",!?25,"'R' for Retirement pay amount",!?25,"'D' for Disability amount."

 +2        WRITE !?25,"'P' for Pension amount"

 +3        QUIT 

UP         IF X'?.UNP

               FOR %=1:1:$LENGTH(X)

                   IF $EXTRACT(X,%)?1L

                       SET X=$EXTRACT(X,0,%-1)_$CHAR($ASCII(X,%)-32)_$EXTRACT(X,%+1,999)

 +1        QUIT 

IN         SET %=0

           DO UP

           IF X]""&(Z[(U_X))

               FOR I=$FIND(Z,U_X):1

                   SET %=$EXTRACT(Z,I)

                   IF %=U!(%']"")

                       QUIT 

                   WRITE %

 +1       IF '$TEST

               SET %=-1

 +2        IF '%

               SET X=$EXTRACT(X,1)

           KILL Z

 +3        QUIT 

LOCK       IF '$DATA(^XUSEC("DG ELIGIBILITY",DUZ))

               IF $DATA(^DPT(DFN,.361))

                   IF $PIECE(^(.361),U,1)="V"

                       WRITE !,"Verification of Eligibility done Eligibility Key required to edit this field"

                       KILL X

 +1        QUIT 

LOC        IF '$DATA(^XUSEC("DG ELIGIBILITY",DUZ))

               WRITE !,"Eligibility Key required to edit this field"

               KILL X

 +1        QUIT 

DOB        SET Y=$PIECE(^DPT(DA,0),U,3)

           IF Y

               IF X<(100000+Y)

                   KILL X

                   XECUTE ^DD("DD")

                   WRITE !,"Patient's DOB is ",Y

 +1        QUIT 

SSN        IF X'?.UN

               FOR %=1:1:$LENGTH(X)

                   IF $EXTRACT(X,%)?1P

                       SET X=$EXTRACT(X,0,%-1)_$EXTRACT(X,%+1,999)