| 1 | DGPMBSG1 ;ALB/LM - BED STATUS GENERATION SET UP; 6 JUNE 90
|
|---|
| 2 | ;;5.3;Registration;**34**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | A S (DV,LDV)=+DIV
|
|---|
| 5 | D LWD,PWD,LTS,PTS
|
|---|
| 6 | Q
|
|---|
| 7 | ;
|
|---|
| 8 | LWD ; Last Ward
|
|---|
| 9 | I $D(^DIC(42,+MV("LWD"),0)) S LW=$S($D(^UTILITY("DGCN",$J,+MV("LWD"))):^(+MV("LWD")),1:RD) G LWDQ
|
|---|
| 10 | S X="^DIC(42,+MV(""LWD""),0)"
|
|---|
| 11 | S ^UTILITY("DGNG",$J,X)="",LW=0,E("LW")="" K X
|
|---|
| 12 | LWDQ Q
|
|---|
| 13 | ;
|
|---|
| 14 | PWD ; Previous Ward
|
|---|
| 15 | I $D(^DIC(42,+MV("PWD"),0)) S PW=$S($D(^UTILITY("DGCN",$J,+MV("PWD"))):^(+MV("PWD")),1:RD) G PWDQ
|
|---|
| 16 | S X="^DIC(42,+MV(""PWD""),0)"
|
|---|
| 17 | S ^UTILITY("DGNG",$J,X)="",PW=0,E("PW")="" K X
|
|---|
| 18 | PWDQ Q
|
|---|
| 19 | ;
|
|---|
| 20 | LTS ; Last Treating Speciality
|
|---|
| 21 | I $D(^DIC(45.7,+MV("LTS"),0)) D TSDIV^DGPMGLG4 S LT=$S($D(^UTILITY("DGSN",$J,LTSDV,+MV("LTS"))):^(+MV("LTS")),1:RD) G LTSQ
|
|---|
| 22 | I TSD,$D(^DIC(45.7,+TSD,0)) S MV("LTS")=TSD D TSDIV^DGPMGLG4 S LT=$S($D(^UTILITY("DGSN",$J,LTSDV,+MV("LTS"))):^(+MV("LTS")),1:RD) G LTSQ
|
|---|
| 23 | S X="^DIC(45.7,+MV(""LTS""),0)"
|
|---|
| 24 | S ^UTILITY("DGNGTS",$J,X)="",LT=0,E("LT")="" K X
|
|---|
| 25 | LTSQ Q
|
|---|
| 26 | ;
|
|---|
| 27 | PTS ; Previous Treating Speciality
|
|---|
| 28 | S Z="PTS"
|
|---|
| 29 | I $D(^DIC(45.7,+MV("PTS"),0)) S PT=$S($D(^UTILITY("DGSN",$J,PTSDV,+MV("PTS"))):^(+MV("PTS")),1:RD) G PTSQ
|
|---|
| 30 | I TSD,$D(^DIC(45.7,+TSD,0)) D TSDIVP^DGPMGLG4 S PT=$S($D(^UTILITY("DGSN",$J,PTSDV,+MV("PTS"))):^(+MV("PTS")),1:RD) G PTSQ
|
|---|
| 31 | S X="^DIC(45.7,+MV(""PTS""),0)"
|
|---|
| 32 | S ^UTILITY("DGNGTS",$J,X)="",PT=0,E("PT")="" K X
|
|---|
| 33 | PTSQ Q
|
|---|
