- 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 Feb 18, 2025@23:48:12 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