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 ---[H[J[2J[HNURSCPLD 1379 printed Dec 13, 2024@02:21:47 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