| [613] | 1 | DGPMBSG ;ALB/LM - BED STATUS GENERATION; 6 JUNE 90
|
|---|
| 2 | ;;5.3;Registration;**34**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | 1 D ^DGPMBSG1
|
|---|
| 5 | S M=MV("MT") ; Movement type
|
|---|
| 6 | S T=MV("TT") ; Transaction type
|
|---|
| 7 | 2 I T'=1,'REM D ^DGPMBSG2
|
|---|
| 8 | 3 D ^DGPMBSG3
|
|---|
| 9 | I T=2 D TRF ; if Transfer
|
|---|
| 10 | I '$D(E("LW")) S ^UTILITY("DGCN",$J,+MV("LWD"))=LW
|
|---|
| 11 | I '$D(E("PW")) S ^UTILITY("DGCN",$J,+MV("PWD"))=PW
|
|---|
| 12 | I '$D(E("LT")) S ^UTILITY("DGSN",$J,LTSDV,+MV("LTS"))=LT
|
|---|
| 13 | I '$D(E("PT")) S ^UTILITY("DGSN",$J,PTSDV,+MV("PTS"))=PT
|
|---|
| 14 | K K E,II,JJ,LDV,LT,LW,M,MP,PT,PW,X,X1,Z
|
|---|
| 15 | Q K E Q
|
|---|
| 16 | ;
|
|---|
| 17 | TRF ; T=2 (Transfer)
|
|---|
| 18 | ; M=44 (resume ASIH in parent facility) M=45 (change ASIH other facility)
|
|---|
| 19 | I "^44^45^"[("^"_M_"^") S (E("LW"),E("LT"),E("PW"),E("PT"))="" Q
|
|---|
| 20 | ;
|
|---|
| 21 | ; M=13 (to ASIH) 43=TO ASIH (OTHER FAC) 20=To ASIH 24=Cum Losses
|
|---|
| 22 | I "^13^43^"[("^"_M_"^") S $P(LW,"^",20)=$P(LW,"^",20)+1,$P(LW,"^",24)=$P(LW,"^",24)+1,$P(LT,"^",20)=$P(LT,"^",20)+1,$P(LT,"^",24)=$P(LT,"^",24)+1 K E S (E("PW"),E("PT"))="" Q
|
|---|
| 23 | ;
|
|---|
| 24 | ; M=14 (From ASIH) 19=From ASIH 28=Gains Total
|
|---|
| 25 | I M=14 S $P(LW,"^",19)=$P(LW,"^",19)+1,$P(LW,"^",28)=$P(LW,"^",28)+1,$P(LT,"^",19)=$P(LT,"^",19)+1,$P(PT,"^",28)=$P(PT,"^",28)+1 K E S E("PW")="" Q
|
|---|
| 26 | ;
|
|---|
| 27 | ; M=2 (AA) M=3 (UA) 24=Cum Losses 26=Cum AA 27=Cum UA
|
|---|
| 28 | I "^2^3^"[("^"_M_"^") S $P(LW,"^",24)=$P(LW,"^",24)+1,$P(LW,"^",(M+24))=$P(LW,"^",(M+24))+1,$P(LT,"^",24)=$P(LT,"^",24)+1,$P(LT,"^",(M+24))=$P(LT,"^",(M+24))+1 K E S (E("PW"),E("PT"))="" Q
|
|---|
| 29 | ;
|
|---|
| 30 | ; M=22 (From UA) 28=Gain Cum
|
|---|
| 31 | I M=22 S $P(LW,"^",28)=$P(LW,"^",28)+1,$P(PT,"^",28)=$P(PT,"^",28)+1 K E S (E("PW"),E("LT"))="" Q
|
|---|
| 32 | ;
|
|---|
| 33 | ; M=24 (From AA) 28=Gain Cum
|
|---|
| 34 | I M=24 S $P(LW,"^",28)=$P(LW,"^",28)+1,$P(PT,"^",28)=$P(PT,"^",28)+1 K E S (E("PW"),E("LT"))="" Q
|
|---|
| 35 | ;
|
|---|
| 36 | ; M=25 (From AA to UA) 26=Cum AA
|
|---|
| 37 | I M=25 S $P(LW,"^",26)=$P(LW,"^",26)+1,$P(PT,"^",26)=$P(PT,"^",26)+1 K E S (E("PW"),E("LT"))="" Q
|
|---|
| 38 | ;
|
|---|
| 39 | ; M=26 (From UA to AA) 27=Cum UA
|
|---|
| 40 | I M=26 S $P(LW,"^",27)=$P(LW,"^",27)+1,$P(PT,"^",27)=$P(PT,"^",27)+1 K E S (E("PW"),E("LT"))="" Q
|
|---|
| 41 | ;
|
|---|
| 42 | WDC Q:'WDC ; Ward Change
|
|---|
| 43 | ; 28=Gain Cum, 23=Cum InterServ Xfer In, 8=Cum InterServ Xfer Out, 6=Cum Inter Xfer, 24=Cum Losses, 29=Cum IWT
|
|---|
| 44 | S $P(LW,"^",28)=$P(LW,"^",28)+1,X=$S($D(^DIC(42,+MV("LWD"),0)):$P(^(0),"^",3),1:0),X1=$S($D(^DIC(42,+MV("PWD"),0)):$P(^(0),"^",3),1:0) I X'=X1 S $P(LW,"^",23)=$P(LW,"^",23)+1,$P(PW,"^",8)=$P(PW,"^",8)+1
|
|---|
| 45 | S $P(PW,"^",6)=$P(PW,"^",6)+1,$P(PW,"^",24)=$P(PW,"^",24)+1,$P(LW,"^",29)=$P(LW,"^",29)+1
|
|---|
| 46 | Q
|
|---|
