DGOIL3.m

DGOIL3 ;ALB/AAS - CALC LOS BY TRANSFER (CONT), GET ASIH MOVEMENTS ; 23-OCT-90

 ;;5.3;Registration;;Aug 13, 1993

 ;

SAVE ;variables needing saving

 S DGPMIFN(1)=DGPMIFN,DGPMIFN1(1)=DGPMIFN1,A(1)=A,A1(1)=A1,D(1)=D,I(1)=I,B("SAVE")=B

 K DGS

 ;

SET ;set up new variables needed

 S I=1,DGT=DGT+1,X(DGT)="0^0^0^0^0^0^0"

 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)

 D MAX^DGOIL2 ;set d equal to discharge

 ;

CALC ;find ASIH movements

 D ADM^DGOIL2

 ;

RESTORE ;set variables back to original

 S A=D+.0000002 ;start with movement after discharge date

 S DGPMIFN=DGPMIFN(1),DGPMIFN1=DGPMIFN1(1),A1=A1(1),D=D(1),I=I(1),B=B("SAVE")

 ;

END K DGPMIFN(1),DGPMIFN1(1),A(1),A1(1),D(1),I(1),B("SAVE"),DGDONE

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGOIL3   865     printed  Apr 09, 2024@21:38:49                                                                                                                                                                                                       Page 2

DGOIL3    ;ALB/AAS - CALC LOS BY TRANSFER (CONT), GET ASIH MOVEMENTS ; 23-OCT-90

 +1       ;;5.3;Registration;;Aug 13, 1993

 +2       ;

SAVE      ;variables needing saving

 +1        SET DGPMIFN(1)=DGPMIFN

           SET DGPMIFN1(1)=DGPMIFN1

           SET A(1)=A

           SET A1(1)=A1

           SET D(1)=D

           SET I(1)=I

           SET B("SAVE")=B

 +2        KILL DGS

 +3       ;

SET       ;set up new variables needed

 +1        SET I=1

           SET DGT=DGT+1

           SET X(DGT)="0^0^0^0^0^0^0"

 +2        SET DGPMIFN=$SELECT('Z:"",'$DATA(^DGPM(+Z,0)):"",1:$PIECE(^(0),"^",15))

           if 'DGPMIFN

               GOTO RESTORE

           if '$DATA(^DGPM(DGPMIFN,0))

               GOTO RESTORE

           SET B=^DGPM(DGPMIFN,0)

           SET A=$SELECT($LENGTH(+B)>7:+B,1:+B_".")

           SET A=$EXTRACT(A_"000000",1,14)_$PIECE(B,"^",22)

 +3       ;set d equal to discharge

           DO MAX^DGOIL2

 +4       ;

CALC      ;find ASIH movements

 +1        DO ADM^DGOIL2

 +2       ;

RESTORE   ;set variables back to original

 +1       ;start with movement after discharge date

           SET A=D+.0000002

 +2        SET DGPMIFN=DGPMIFN(1)

           SET DGPMIFN1=DGPMIFN1(1)

           SET A1=A1(1)

           SET D=D(1)

           SET I=I(1)

           SET B=B("SAVE")

 +3       ;

END        KILL DGPMIFN(1),DGPMIFN1(1),A(1),A1(1),D(1),I(1),B("SAVE"),DGDONE

 +1        QUIT