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 ---[H[J[2J[HDGRP12 919 printed Sep 23, 2025@20:31:26 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),"'"
