source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURSCPLD.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1NURSCPLD ;HIRMFO/RM-DISCHARGE MODULE TO DISCHARGE PATIENT FROM NURSING ;SEPTEMBER 1986
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3 ;MODIFIED BY MD 06/27/87
4EN1 ;
5 Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
6 D QUIT
7LOCATE ; SELECT AND VALIDATE PATIENT
8 W ! S NASK=1,DIC(0)="EQM",NACT=0 D EN5^NURSCUTL
9 G:DFN="" QUIT
10DISCONT ;
11 I '$D(^NURSF(214,DFN,0)) D ERRSTAT G QUIT
12 S NURSDIS=$P(^NURSF(214,DFN,0),"^",6)
13 I NURSDIS="",$P(^NURSF(214,DFN,0),"^",2)="A" G DISQUES1
14DISQUES I NURSDIS'="" W !,"PATIENT HAS ALREADY BEEN DISCHARGED FROM THE NURSING SYSTEM.",!,"DO YOU WANT TO CHANGE THE DISCHARGE DATE? NO//" R X:DTIME
15 G QUIT:(X="^")!('$T),DISEDIT:(X?1"Y".E),NURSCPLD:(X="")!(X?1"N".E)
16 W !,"ANSWER YES OR NO" G DISQUES
17DISQUES1 ;
18 S %DT(0)=$P(^NURSF(214,DFN,0),"^",5),%DT("A")="DATE/TIME DISCHARGED: ",%DT("B")="NOW",%DT="AET" D ^%DT K %DT
19 G:(X="^")!(Y=-1) NURSCPLD
20 S NURSDIS=Y
21 S DA=DFN,DR="1///^S X=""I"";5///^S X=NURSDIS",DIE="^NURSF(214," D ^DIE
22 D DEM^VADPT W !,VADM(1)," is discharged from the Nursing System."
23 G NURSCPLD
24DISEDIT ; EDIT DISCHARGE DATE
25 S DA=DFN,DR="1///^S X=""I"";5",DIE="^NURSF(214," D ^DIE
26 G NURSCPLD
27ERRSTAT ;
28 W !!,*7,"THIS PATIENT IS NOT ADMITTED CURRENTLY IN THE NURSING SYSTEM - CANNOT DISCHARGE"
29QUIT ; KILL LOCAL VARIABLES
30 K DA,DIPGM,DR,%DT,NACT,NASK,DFN,DIC,I,NURSDIS,%Y,D,D0,DI,DIE,VA,VADM,VAERR
31 Q
Note: See TracBrowser for help on using the repository browser.