DGPMBSG1 ;ALB/LM - BED STATUS GENERATION SET UP; 6 JUNE 90
;;5.3;Registration;**34**;Aug 13, 1993
;
A S (DV,LDV)=+DIV
D LWD,PWD,LTS,PTS
Q
;
LWD ; Last Ward
I $D(^DIC(42,+MV("LWD"),0)) S LW=$S($D(^UTILITY("DGCN",$J,+MV("LWD"))):^(+MV("LWD")),1:RD) G LWDQ
S X="^DIC(42,+MV(""LWD""),0)"
S ^UTILITY("DGNG",$J,X)="",LW=0,E("LW")="" K X
LWDQ Q
;
PWD ; Previous Ward
I $D(^DIC(42,+MV("PWD"),0)) S PW=$S($D(^UTILITY("DGCN",$J,+MV("PWD"))):^(+MV("PWD")),1:RD) G PWDQ
S X="^DIC(42,+MV(""PWD""),0)"
S ^UTILITY("DGNG",$J,X)="",PW=0,E("PW")="" K X
PWDQ Q
;
LTS ; Last Treating Speciality
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
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
S X="^DIC(45.7,+MV(""LTS""),0)"
S ^UTILITY("DGNGTS",$J,X)="",LT=0,E("LT")="" K X
LTSQ Q
;
PTS ; Previous Treating Speciality
S Z="PTS"
I $D(^DIC(45.7,+MV("PTS"),0)) S PT=$S($D(^UTILITY("DGSN",$J,PTSDV,+MV("PTS"))):^(+MV("PTS")),1:RD) G PTSQ
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
S X="^DIC(45.7,+MV(""PTS""),0)"
S ^UTILITY("DGNGTS",$J,X)="",PT=0,E("PT")="" K X
PTSQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMBSG1 1347 printed Dec 13, 2024@02:49:07 Page 2
DGPMBSG1 ;ALB/LM - BED STATUS GENERATION SET UP; 6 JUNE 90
+1 ;;5.3;Registration;**34**;Aug 13, 1993
+2 ;
A SET (DV,LDV)=+DIV
+1 DO LWD
DO PWD
DO LTS
DO PTS
+2 QUIT
+3 ;
LWD ; Last Ward
+1 IF $DATA(^DIC(42,+MV("LWD"),0))
SET LW=$SELECT($DATA(^UTILITY("DGCN",$JOB,+MV("LWD"))):^(+MV("LWD")),1:RD)
GOTO LWDQ
+2 SET X="^DIC(42,+MV(""LWD""),0)"
+3 SET ^UTILITY("DGNG",$JOB,X)=""
SET LW=0
SET E("LW")=""
KILL X
LWDQ QUIT
+1 ;
PWD ; Previous Ward
+1 IF $DATA(^DIC(42,+MV("PWD"),0))
SET PW=$SELECT($DATA(^UTILITY("DGCN",$JOB,+MV("PWD"))):^(+MV("PWD")),1:RD)
GOTO PWDQ
+2 SET X="^DIC(42,+MV(""PWD""),0)"
+3 SET ^UTILITY("DGNG",$JOB,X)=""
SET PW=0
SET E("PW")=""
KILL X
PWDQ QUIT
+1 ;
LTS ; Last Treating Speciality
+1 IF $DATA(^DIC(45.7,+MV("LTS"),0))
DO TSDIV^DGPMGLG4
SET LT=$SELECT($DATA(^UTILITY("DGSN",$JOB,LTSDV,+MV("LTS"))):^(+MV("LTS")),1:RD)
GOTO LTSQ
+2 IF TSD
IF $DATA(^DIC(45.7,+TSD,0))
SET MV("LTS")=TSD
DO TSDIV^DGPMGLG4
SET LT=$SELECT($DATA(^UTILITY("DGSN",$JOB,LTSDV,+MV("LTS"))):^(+MV("LTS")),1:RD)
GOTO LTSQ
+3 SET X="^DIC(45.7,+MV(""LTS""),0)"
+4 SET ^UTILITY("DGNGTS",$JOB,X)=""
SET LT=0
SET E("LT")=""
KILL X
LTSQ QUIT
+1 ;
PTS ; Previous Treating Speciality
+1 SET Z="PTS"
+2 IF $DATA(^DIC(45.7,+MV("PTS"),0))
SET PT=$SELECT($DATA(^UTILITY("DGSN",$JOB,PTSDV,+MV("PTS"))):^(+MV("PTS")),1:RD)
GOTO PTSQ
+3 IF TSD
IF $DATA(^DIC(45.7,+TSD,0))
DO TSDIVP^DGPMGLG4
SET PT=$SELECT($DATA(^UTILITY("DGSN",$JOB,PTSDV,+MV("PTS"))):^(+MV("PTS")),1:RD)
GOTO PTSQ
+4 SET X="^DIC(45.7,+MV(""PTS""),0)"
+5 SET ^UTILITY("DGNGTS",$JOB,X)=""
SET PT=0
SET E("PT")=""
KILL X
PTSQ QUIT
