source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPMHST.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1DGPMHST ;ALB/JDS - HISTORICAL INPATIENT OUTPUT- FORMERLY DGIN ;01 JAN 1986
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4 ; NOTE: This used to be named DGIN
5 ; ----
6EN 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
7EN1 S Y=DGT X ^DD("DD") S DHD="INPATIENT LIST FOR "_Y,L=0
8EN2 S DIS(1)="D SET^DGPMHST I DG1 S ^UTILITY($J,""DG"",DFN)=DG1"
9 S DIC("A")="Enter WARD: ",DIC="^DGPM(",FLDS="[DGPM INPATIENT PRINT]",FR=",",TO=DGT_"," K BY
10 I '$D(TD),$D(^DG(43,1,"GL")),$P(^("GL"),U,2) S BY="[DGPM INP HISTORICAL DIVISION]" S FR=FR_"@,",TO=TO_","
11 I '$D(BY) S BY="[DGPM INP HISTORICAL 1 DIVISION]"
12 S FR=FR_"?,",TO=TO_"?,"
13 D EN1^DIP
14Q Q:$D(DGF) K DGT,^UTILITY($J,"DG")
15 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
16SET 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
17 D ^DGPMSTAT
18 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)
19 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)
Note: See TracBrowser for help on using the repository browser.