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

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

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1DGPMBSG1 ;ALB/LM - BED STATUS GENERATION SET UP; 6 JUNE 90
2 ;;5.3;Registration;**34**;Aug 13, 1993
3 ;
4A S (DV,LDV)=+DIV
5 D LWD,PWD,LTS,PTS
6 Q
7 ;
8LWD ; 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
12LWDQ Q
13 ;
14PWD ; 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
18PWDQ Q
19 ;
20LTS ; 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
25LTSQ Q
26 ;
27PTS ; 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
33PTSQ Q
Note: See TracBrowser for help on using the repository browser.