DGRP12.m

DGRP12 ;ALB/MRL - REGISTRATION SCREEN 12/ADMISSION INFORMATION ;06 JUN 88@2300

 ;;5.3;Registration;;Aug 13, 1993

 S DGRPS=12 D H^DGRPU S DGRPW=1,(Z,C)=0 F I=0:0 S I=$O(^DGPM("ATID1",DFN,I)) Q:'I!(C=4)  S I1=$O(^(I,0)) I $D(^DGPM(I1,0)) S I1=^(0),I2=$S($D(^DGPM(+$P(I1,"^",17),0)):^(0),1:""),C=C+1 D ADM

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

 G ^DGRPP

ADM S Z=C D WW^DGRPV W "  Admission Date: " S Y=$P(I1,"^",1) X:Y]"" ^DD("DD") S Z=$S(Y]"":Y,1:DGRPU),Z1=25 D WW1^DGRPV W "Admit Ward: ",$S($D(^DIC(42,+$P(I1,"^",6),0)):$P(^(0),"^",1),1:DGRPU)

 W !?4,"Admit Diagnosis: ",$S($P(I1,"^",10)]"":$P(I1,"^",10),1:DGRPU),!?5,"Discharge Date: " S Y=$S(+I2:+I2,1:"") X:Y ^DD("DD") W $S(Y]"":Y,1:"NOT DISCHARGED")

 W !?5,"Discharge Type: ",$S($D(^DG(405.1,+$P(I2,"^",4),0)):$P(^(0),"^",1),1:$S(+I2>0:DGRPU,1:"NOT DISCHARGED")) I $P(I2,"^",5),$D(^DIC(4,+$P(I2,"^",5),0)) W " TO '",$P(^(0),"^",1),"'"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGRP12   919     printed  Apr 09, 2024@21:50:31                                                                                                                                                                                                       Page 2

DGRP12    ;ALB/MRL - REGISTRATION SCREEN 12/ADMISSION INFORMATION ;06 JUN 88@2300

 +1       ;;5.3;Registration;;Aug 13, 1993

 +2        SET DGRPS=12

           DO H^DGRPU

           SET DGRPW=1

           SET (Z,C)=0

           FOR I=0:0

               SET I=$ORDER(^DGPM("ATID1",DFN,I))

               if 'I!(C=4)

                   QUIT 

               SET I1=$ORDER(^(I,0))

               IF $DATA(^DGPM(I1,0))

                   SET I1=^(0)

                   SET I2=$SELECT($DATA(^DGPM(+$PIECE(I1,"^",17),0)):^(0),1:"")

                   SET C=C+1

                   DO ADM

 +3        IF 'C

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

 +4        GOTO ^DGRPP

ADM        SET Z=C

           DO WW^DGRPV

           WRITE "  Admission Date: "

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

           if Y]""

               XECUTE ^DD("DD")

           SET Z=$SELECT(Y]"":Y,1:DGRPU)

           SET Z1=25

           DO WW1^DGRPV

           WRITE "Admit Ward: ",$SELECT($DATA(^DIC(42,+$PIECE(I1,"^",6),0)):$PIECE(^(0),"^",1),1:DGRPU)

 +1        WRITE !?4,"Admit Diagnosis: ",$SELECT($PIECE(I1,"^",10)]"":$PIECE(I1,"^",10),1:DGRPU),!?5,"Discharge Date: "

           SET Y=$SELECT(+I2:+I2,1:"")

           if Y

               XECUTE ^DD("DD")

           WRITE $SELECT(Y]"":Y,1:"NOT DISCHARGED")

 +2        WRITE !?5,"Discharge Type: ",$SELECT($DATA(^DG(405.1,+$PIECE(I2,"^",4),0)):$PIECE(^(0),"^",1),1:$SELECT(+I2>0:DGRPU,1:"NOT DISCHARGED"))

           IF $PIECE(I2,"^",5)

               IF $DATA(^DIC(4,+$PIECE(I2,"^",5),0))

                   WRITE " TO '",$PIECE(^(0),"^",1),"'"