HBHCDIS ;LR VAMC(IRMS)/MJT - HBHC Discharge data entry, calls STATUS^HBHCUTL from [HBHC DISCHARGE] template ;3/18/14
;;1.0;HOSPITAL BASED HOME CARE;**2,25**;NOV 01, 1993;Build 45
;
; Reference to $$SINFO^ICDEX supported by ICR #5747
; $$SINFO^ICDEX is called from the [HBHC DISCHARGE] input template
;
START ; Initialization
S HBHCFORM=5
PROMPT ; Prompt user for patient name
K DIC,HBHCPRCT S DIC="^HBHC(631,",DIC(0)="AEMQZ" D ^DIC
G:Y=-1 EXIT
I $P(Y(0),U,15)'=1 W *7,!!,"Record indicates patient has not been admitted to HBHC. Discharge not allowed",!,"without admission.",! H 3 G PROMPT
S HBHCDFN=+Y,HBHCDPT=$P(Y,U,2),HBHCXMT5=$P($G(^HBHC(631,HBHCDFN,1)),U,18)
I (HBHCXMT5]"")&(HBHCXMT5'="N") D FORMMSG^HBHCUTL1 G:$D(HBHCNHSP) EXIT G:HBHCPRCT'=1 PROMPT
K DIE S DIE="^HBHC(631,",DA=HBHCDFN,DR="[HBHC DISCHARGE]"
L +^HBHC(631,HBHCDFN):0 I $T D ^DIE L -^HBHC(631,HBHCDFN) G PROMPT
W *7,!!,"Another user is editing this entry.",!! G PROMPT
EXIT ; Exit module
K DA,DIC,DIE,DR,HBHC12,HBHC359,HBHCDFLG,HBHCDFN,HBHCDIED,HBHCDPT,HBHCFORM,HBHCI,HBHCJ,HBHCL,HBHCM,HBHCNHSP,HBHCNOD1,HBHCPRCT,HBHCQ,HBHCQ1,HBHCTFLG,HBHCXMT5,HBHCWRD1,HBHCWRD2,HBHCWRD3,HBHCY0,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCDIS 1190 printed Dec 13, 2024@01:58:01 Page 2
HBHCDIS ;LR VAMC(IRMS)/MJT - HBHC Discharge data entry, calls STATUS^HBHCUTL from [HBHC DISCHARGE] template ;3/18/14
+1 ;;1.0;HOSPITAL BASED HOME CARE;**2,25**;NOV 01, 1993;Build 45
+2 ;
+3 ; Reference to $$SINFO^ICDEX supported by ICR #5747
+4 ; $$SINFO^ICDEX is called from the [HBHC DISCHARGE] input template
+5 ;
START ; Initialization
+1 SET HBHCFORM=5
PROMPT ; Prompt user for patient name
+1 KILL DIC,HBHCPRCT
SET DIC="^HBHC(631,"
SET DIC(0)="AEMQZ"
DO ^DIC
+2 if Y=-1
GOTO EXIT
+3 IF $PIECE(Y(0),U,15)'=1
WRITE *7,!!,"Record indicates patient has not been admitted to HBHC. Discharge not allowed",!,"without admission.",!
HANG 3
GOTO PROMPT
+4 SET HBHCDFN=+Y
SET HBHCDPT=$PIECE(Y,U,2)
SET HBHCXMT5=$PIECE($GET(^HBHC(631,HBHCDFN,1)),U,18)
+5 IF (HBHCXMT5]"")&(HBHCXMT5'="N")
DO FORMMSG^HBHCUTL1
if $DATA(HBHCNHSP)
GOTO EXIT
if HBHCPRCT'=1
GOTO PROMPT
+6 KILL DIE
SET DIE="^HBHC(631,"
SET DA=HBHCDFN
SET DR="[HBHC DISCHARGE]"
+7 LOCK +^HBHC(631,HBHCDFN):0
IF $TEST
DO ^DIE
LOCK -^HBHC(631,HBHCDFN)
GOTO PROMPT
+8 WRITE *7,!!,"Another user is editing this entry.",!!
GOTO PROMPT
EXIT ; Exit module
+1 KILL DA,DIC,DIE,DR,HBHC12,HBHC359,HBHCDFLG,HBHCDFN,HBHCDIED,HBHCDPT,HBHCFORM,HBHCI,HBHCJ,HBHCL,HBHCM,HBHCNHSP,HBHCNOD1,HBHCPRCT,HBHCQ,HBHCQ1,HBHCTFLG,HBHCXMT5,HBHCWRD1,HBHCWRD2,HBHCWRD3,HBHCY0,X,Y
+2 QUIT
