DGRP13.m

DGRP13 ;ALB/MRL - REGISTRATION SCREEN 13/APPLICATION INFORMATION ;06 JUN 88@2300

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

 S DGRPS=13 D H^DGRPU S DGRPW=1,(C,Z)=0 F I=0:0 S I=$O(^DPT(DFN,"DIS",I)) Q:'I!(C=4)  I $D(^DPT(DFN,"DIS",I,0)) S I1=^(0),X=$P(I1,"^",1),C=C+1 D AC

 I 'C W !!,"NO APPLICATION DATA ON FILE FOR THIS PATIENT!",*7

 G ^DGRPP

AC S Y=X X:Y ^DD("DD") S Z=C D WW^DGRPV W "    Registered: ",$S(Y]"":Y,1:DGRPU_" DATE")," by '",$S($D(^VA(200,+$P(I1,"^",5),0)):$P(^(0),"^",1)_" (#"_$P(I1,"^",5)_")",1:DGRPU_" USER")_"'"

 S X=$P(I1,"^",3) S:X>0 X=$P("HOSPITAL^DOMICILIARY^OUTPATIENT MEDICAL^OUTPATIENT DENTAL^NURSING HOME CARE","^",X) S:$L(X)'>7 X=DGRPU W !?6,"Applied for: ",X

 S Y=$P(I1,"^",6) X:Y ^DD("DD") W !?4,"Dispositioned: ",$S(Y]"":Y,1:"OPEN DISPOSITION") I Y]"" W " by '",$S($D(^VA(200,+$P(I1,"^",9),0)):$P(^(0),"^",1)_" (#"_$P(I1,"^",9)_")",1:"UNKNOWN USER"),"'."

 W !?4,"Type of Disp.: ",$S($D(^DIC(37,+$P(I1,"^",7),0)):$P(^(0),"^",1),$P(I1,"^",9):DGRPU,1:"OPEN DISPOSITION")

DGRP13    ;ALB/MRL - REGISTRATION SCREEN 13/APPLICATION INFORMATION ;06 JUN 88@2300

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

 +2        SET DGRPS=13

           DO H^DGRPU

           SET DGRPW=1

           SET (C,Z)=0

           FOR I=0:0

               SET I=$ORDER(^DPT(DFN,"DIS",I))

               IF 'I!(C=4)

                   QUIT 

               IF $DATA(^DPT(DFN,"DIS",I,0))

                   SET I1=^(0)

                   SET X=$PIECE(I1,"^",1)

                   SET C=C+1

                   DO AC

 +3        IF 'C

               WRITE !!,"NO APPLICATION DATA ON FILE FOR THIS PATIENT!",*7

 +4        GOTO ^DGRPP

AC         SET Y=X

           IF Y

               XECUTE ^DD("DD")

           SET Z=C

           DO WW^DGRPV

           WRITE "    Registered: ",$SELECT(Y]"":Y,1:DGRPU_" DATE")," by '",$SELECT($DATA(^VA(200,+$PIECE(I1,"^",5),0)):$PIECE(^(0),"^",1)_" (#"_$PIECE(I1,"^",5)_")",1:DGRPU_" USER")_"'"

 +1        SET X=$PIECE(I1,"^",3)

           IF X>0

               SET X=$PIECE("HOSPITAL^DOMICILIARY^OUTPATIENT MEDICAL^OUTPATIENT DENTAL^NURSING HOME CARE","^",X)

           IF $LENGTH(X)'>7

               SET X=DGRPU

           WRITE !?6,"Applied for: ",X

 +2        SET Y=$PIECE(I1,"^",6)

           IF Y

               XECUTE ^DD("DD")

           WRITE !?4,"Dispositioned: ",$SELECT(Y]"":Y,1:"OPEN DISPOSITION")

           IF Y]""

               WRITE " by '",$SELECT($DATA(^VA(200,+$PIECE(I1,"^",9),0)):$PIECE(^(0),"^",1)_" (#"_$PIECE(I1,"^",9)_")",1:"UNKNOWN USER"),"'."

 +3        WRITE !?4,"Type of Disp.: ",$SELECT($DATA(^DIC(37,+$PIECE(I1,"^",7),0)):$PIECE(^(0),"^",1),$PIECE(I1,"^",9):DGRPU,1:"OPEN DISPOSITION")