DGPMBSG1.m

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 ---DGPMBSG1   1347     printed  Apr 09, 2024@21:58:33                                                                                                                                                                                                    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