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

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

initial load of WorldVistAEHR

File size: 844 bytes
Line 
1DGOIL3 ;ALB/AAS - CALC LOS BY TRANSFER (CONT), GET ASIH MOVEMENTS ; 23-OCT-90
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4SAVE ;variables needing saving
5 S DGPMIFN(1)=DGPMIFN,DGPMIFN1(1)=DGPMIFN1,A(1)=A,A1(1)=A1,D(1)=D,I(1)=I,B("SAVE")=B
6 K DGS
7 ;
8SET ;set up new variables needed
9 S I=1,DGT=DGT+1,X(DGT)="0^0^0^0^0^0^0"
10 S DGPMIFN=$S('Z:"",'$D(^DGPM(+Z,0)):"",1:$P(^(0),"^",15)) G RESTORE:'DGPMIFN G RESTORE:'$D(^DGPM(DGPMIFN,0)) S B=^DGPM(DGPMIFN,0) S A=$S($L(+B)>7:+B,1:+B_"."),A=$E(A_"000000",1,14)_$P(B,"^",22)
11 D MAX^DGOIL2 ;set d equal to discharge
12 ;
13CALC ;find ASIH movements
14 D ADM^DGOIL2
15 ;
16RESTORE ;set variables back to original
17 S A=D+.0000002 ;start with movement after discharge date
18 S DGPMIFN=DGPMIFN(1),DGPMIFN1=DGPMIFN1(1),A1=A1(1),D=D(1),I=I(1),B=B("SAVE")
19 ;
20END K DGPMIFN(1),DGPMIFN1(1),A(1),A1(1),D(1),I(1),B("SAVE"),DGDONE
21 Q
Note: See TracBrowser for help on using the repository browser.