DGPMHST ;ALB/JDS - HISTORICAL INPATIENT OUTPUT- FORMERLY DGIN ;01 JAN 1986
;;5.3;Registration;;Aug 13, 1993
;
; NOTE: This used to be named DGIN
; ----
EN K TD,DGF S %DT="AEXPT",%DT("A")="Enter date of Stay: " D ^%DT G Q:Y'>0 G EN:+Y>(DT+1) S DGT=+Y,DG2=DGT,L=0,DGT=$S(DGT[".":DGT,1:DGT_".2400"),DG2=DGT
EN1 S Y=DGT X ^DD("DD") S DHD="INPATIENT LIST FOR "_Y,L=0
EN2 S DIS(1)="D SET^DGPMHST I DG1 S ^UTILITY($J,""DG"",DFN)=DG1"
S DIC("A")="Enter WARD: ",DIC="^DGPM(",FLDS="[DGPM INPATIENT PRINT]",FR=",",TO=DGT_"," K BY
I '$D(TD),$D(^DG(43,1,"GL")),$P(^("GL"),U,2) S BY="[DGPM INP HISTORICAL DIVISION]" S FR=FR_"@,",TO=TO_","
I '$D(BY) S BY="[DGPM INP HISTORICAL 1 DIVISION]"
S FR=FR_"?,",TO=TO_"?,"
D EN1^DIP
Q Q:$D(DGF) K DGT,^UTILITY($J,"DG")
K %DT,%X,%H,DFN,DG1,DGA1,DGX,DP,P,DGXFR0,B,%Y,DG2,DNP,FLDS,FR,TO,%,DHD,DIS,K,L,POP,X,X1 Q
SET S DG1=0 Q:'$D(^DGPM(D0,0)) Q:$P(^DGPM(D0,0),"^",3)']"" S DFN=$P(^DGPM(D0,0),U,3) Q:$D(^UTILITY($J,"DG1",DFN)) S ^(DFN)=1
D ^DGPMSTAT
Q:'DG1 S $P(DG1,U,4)=+DG1,$P(DG1,U,1)=+^DGPM(DGA1,0) I $P(^(0),U,17)]"" S $P(DG1,U,6)=+^DGPM($P(^(0),U,17),0)
I $P(DG1,U,3) S $P(DG1,U,5)=+DGXFR0 S A=$P(DG1,U,3),$P(DG1,U,7)=$S(A=1:1,A=2:2,A=3:3,A=25:3,"^43^45^"[(U_A_U):4,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMHST 1268 printed Sep 23, 2025@20:25:37 Page 2
DGPMHST ;ALB/JDS - HISTORICAL INPATIENT OUTPUT- FORMERLY DGIN ;01 JAN 1986
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;
+3 ; NOTE: This used to be named DGIN
+4 ; ----
EN KILL TD,DGF
SET %DT="AEXPT"
SET %DT("A")="Enter date of Stay: "
DO ^%DT
if Y'>0
GOTO Q
if +Y>(DT+1)
GOTO EN
SET DGT=+Y
SET DG2=DGT
SET L=0
SET DGT=$SELECT(DGT[".":DGT,1:DGT_".2400")
SET DG2=DGT
EN1 SET Y=DGT
XECUTE ^DD("DD")
SET DHD="INPATIENT LIST FOR "_Y
SET L=0
EN2 SET DIS(1)="D SET^DGPMHST I DG1 S ^UTILITY($J,""DG"",DFN)=DG1"
+1 SET DIC("A")="Enter WARD: "
SET DIC="^DGPM("
SET FLDS="[DGPM INPATIENT PRINT]"
SET FR=","
SET TO=DGT_","
KILL BY
+2 IF '$DATA(TD)
IF $DATA(^DG(43,1,"GL"))
IF $PIECE(^("GL"),U,2)
SET BY="[DGPM INP HISTORICAL DIVISION]"
SET FR=FR_"@,"
SET TO=TO_","
+3 IF '$DATA(BY)
SET BY="[DGPM INP HISTORICAL 1 DIVISION]"
+4 SET FR=FR_"?,"
SET TO=TO_"?,"
+5 DO EN1^DIP
Q if $DATA(DGF)
QUIT
KILL DGT,^UTILITY($JOB,"DG")
+1 KILL %DT,%X,%H,DFN,DG1,DGA1,DGX,DP,P,DGXFR0,B,%Y,DG2,DNP,FLDS,FR,TO,%,DHD,DIS,K,L,POP,X,X1
QUIT
SET SET DG1=0
if '$DATA(^DGPM(D0,0))
QUIT
if $PIECE(^DGPM(D0,0),"^",3)']""
QUIT
SET DFN=$PIECE(^DGPM(D0,0),U,3)
if $DATA(^UTILITY($JOB,"DG1",DFN))
QUIT
SET ^(DFN)=1
+1 DO ^DGPMSTAT
+2 if 'DG1
QUIT
SET $PIECE(DG1,U,4)=+DG1
SET $PIECE(DG1,U,1)=+^DGPM(DGA1,0)
IF $PIECE(^(0),U,17)]""
SET $PIECE(DG1,U,6)=+^DGPM($PIECE(^(0),U,17),0)
+3 IF $PIECE(DG1,U,3)
SET $PIECE(DG1,U,5)=+DGXFR0
SET A=$PIECE(DG1,U,3)
SET $PIECE(DG1,U,7)=$SELECT(A=1:1,A=2:2,A=3:3,A=25:3,"^43^45^"[(U_A_U):4,1:0)
