| 1 | DGOIL3 ;ALB/AAS - CALC LOS BY TRANSFER (CONT), GET ASIH MOVEMENTS ; 23-OCT-90
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | SAVE ;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 | ;
|
|---|
| 8 | SET ;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 | ;
|
|---|
| 13 | CALC ;find ASIH movements
|
|---|
| 14 | D ADM^DGOIL2
|
|---|
| 15 | ;
|
|---|
| 16 | RESTORE ;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 | ;
|
|---|
| 20 | END K DGPMIFN(1),DGPMIFN1(1),A(1),A1(1),D(1),I(1),B("SAVE"),DGDONE
|
|---|
| 21 | Q
|
|---|
