NURSCPLD.m

NURSCPLD ;HIRMFO/RM-DISCHARGE MODULE TO DISCHARGE PATIENT FROM NURSING ;SEPTEMBER 1986

 ;;4.0;NURSING SERVICE;;Apr 25, 1997

 ;MODIFIED BY MD 06/27/87

EN1 ;

 Q:'$D(^DIC(213.9,1,"OFF"))  Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1

 D QUIT

LOCATE ; SELECT AND VALIDATE PATIENT

 W ! S NASK=1,DIC(0)="EQM",NACT=0 D EN5^NURSCUTL

 G:DFN="" QUIT

DISCONT ;

 I '$D(^NURSF(214,DFN,0)) D ERRSTAT G QUIT

 S NURSDIS=$P(^NURSF(214,DFN,0),"^",6)

 I NURSDIS="",$P(^NURSF(214,DFN,0),"^",2)="A" G DISQUES1

DISQUES I NURSDIS'="" W !,"PATIENT HAS ALREADY BEEN DISCHARGED FROM THE NURSING SYSTEM.",!,"DO YOU WANT TO CHANGE THE DISCHARGE DATE? NO//" R X:DTIME

 G QUIT:(X="^")!('$T),DISEDIT:(X?1"Y".E),NURSCPLD:(X="")!(X?1"N".E)

 W !,"ANSWER YES OR NO" G DISQUES

DISQUES1 ;

 S %DT(0)=$P(^NURSF(214,DFN,0),"^",5),%DT("A")="DATE/TIME DISCHARGED: ",%DT("B")="NOW",%DT="AET" D ^%DT K %DT

 G:(X="^")!(Y=-1) NURSCPLD

 S NURSDIS=Y

 S DA=DFN,DR="1///^S X=""I"";5///^S X=NURSDIS",DIE="^NURSF(214," D ^DIE

 D DEM^VADPT W !,VADM(1)," is discharged from the Nursing System."

 G NURSCPLD

DISEDIT ; EDIT DISCHARGE DATE

 S DA=DFN,DR="1///^S X=""I"";5",DIE="^NURSF(214," D ^DIE

 G NURSCPLD

ERRSTAT ;

 W !!,*7,"THIS PATIENT IS NOT ADMITTED CURRENTLY IN THE NURSING SYSTEM - CANNOT DISCHARGE"

QUIT ; KILL LOCAL VARIABLES

 K DA,DIPGM,DR,%DT,NACT,NASK,DFN,DIC,I,NURSDIS,%Y,D,D0,DI,DIE,VA,VADM,VAERR

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---NURSCPLD   1379     printed  Apr 09, 2024@21:24:52                                                                                                                                                                                                    Page 2

NURSCPLD  ;HIRMFO/RM-DISCHARGE MODULE TO DISCHARGE PATIENT FROM NURSING ;SEPTEMBER 1986

 +1       ;;4.0;NURSING SERVICE;;Apr 25, 1997

 +2       ;MODIFIED BY MD 06/27/87

EN1       ;

 +1        if '$DATA(^DIC(213.9,1,"OFF"))

               QUIT 

           if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1

               QUIT 

 +2        DO QUIT

LOCATE    ; SELECT AND VALIDATE PATIENT

 +1        WRITE !

           SET NASK=1

           SET DIC(0)="EQM"

           SET NACT=0

           DO EN5^NURSCUTL

 +2        if DFN=""

               GOTO QUIT

DISCONT   ;

 +1        IF '$DATA(^NURSF(214,DFN,0))

               DO ERRSTAT

               GOTO QUIT

 +2        SET NURSDIS=$PIECE(^NURSF(214,DFN,0),"^",6)

 +3        IF NURSDIS=""

               IF $PIECE(^NURSF(214,DFN,0),"^",2)="A"

                   GOTO DISQUES1

DISQUES    IF NURSDIS'=""

               WRITE !,"PATIENT HAS ALREADY BEEN DISCHARGED FROM THE NURSING SYSTEM.",!,"DO YOU WANT TO CHANGE THE DISCHARGE DATE? NO//"

               READ X:DTIME

 +1        if (X="^")!('$TEST)

               GOTO QUIT

           if (X?1"Y".E)

               GOTO DISEDIT

           if (X="")!(X?1"N".E)

               GOTO NURSCPLD

 +2        WRITE !,"ANSWER YES OR NO"

           GOTO DISQUES

DISQUES1  ;

 +1        SET %DT(0)=$PIECE(^NURSF(214,DFN,0),"^",5)

           SET %DT("A")="DATE/TIME DISCHARGED: "

           SET %DT("B")="NOW"

           SET %DT="AET"

           DO ^%DT

           KILL %DT

 +2        if (X="^")!(Y=-1)

               GOTO NURSCPLD

 +3        SET NURSDIS=Y

 +4        SET DA=DFN

           SET DR="1///^S X=""I"";5///^S X=NURSDIS"

           SET DIE="^NURSF(214,"

           DO ^DIE

 +5        DO DEM^VADPT

           WRITE !,VADM(1)," is discharged from the Nursing System."

 +6        GOTO NURSCPLD

DISEDIT   ; EDIT DISCHARGE DATE

 +1        SET DA=DFN

           SET DR="1///^S X=""I"";5"

           SET DIE="^NURSF(214,"

           DO ^DIE

 +2        GOTO NURSCPLD

ERRSTAT   ;

 +1        WRITE !!,*7,"THIS PATIENT IS NOT ADMITTED CURRENTLY IN THE NURSING SYSTEM - CANNOT DISCHARGE"

QUIT      ; KILL LOCAL VARIABLES

 +1        KILL DA,DIPGM,DR,%DT,NACT,NASK,DFN,DIC,I,NURSDIS,%Y,D,D0,DI,DIE,VA,VADM,VAERR

 +2        QUIT