HBHCUPDM ; LR VAMC(IRMS)/MJT-HBHC update missing data in ^HBHC(633.2) using ^HBHC(634.7) as input for which records/fields to update, HBHC(634.7 errors must be corrected using this MFH option, 634.7 data killed @ end of processing;9804
;;1.0;HOSPITAL BASED HOME CARE;**24**;NOV 01, 1993;Build 201
PROMPT ; Prompt user for Medical Foster Home (MFH) name
W ! K DIC S DIC="^HBHC(633.2,",DIC(0)="AEMQ" D ^DIC
G:Y=-1 EXIT
S DA=+Y,HBHCMFHN=$P(Y,U)
I '$D(^HBHC(634.7,"B",HBHCMFHN)) W $C(7),!!,"This Medical Foster Home (MFH) has no records containing errors on file.",! H 3 G PROMPT
S HBHCIEN="" F S HBHCIEN=$O(^HBHC(634.7,"B",HBHCMFHN,HBHCIEN)) Q:HBHCIEN="" D PROCESS
G PROMPT
EXIT ; Exit module
; HBHC(634.7 MFH errors must be corrected using this MFH option, 634.7 killed here so validity processing can occur again
K ^HBHC(634.7) S ^HBHC(634.7,0)="HBHC MEDICAL FOSTER HOME ERROR(S)^634.7P"
K DIC,DIE,DR,HBHCMFHP,Y
Q
PROCESS ; Process errors via DIE
L +^HBHC(633.2,DA):0 I '$T W $C(7),!!,"Another user is editing this Medical Foster Home (MFH) entry.",! H 3 Q
K DR S DR=^HBHC(634.7,HBHCIEN,1)
K DIE S DIE="^HBHC(633.2,",DIE("NO^")="OUTOK"
W !!!?10,"=== Editing Medical Foster Home (MFH) Demographic data ===",!
D ^DIE K DR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCUPDM 1263 printed Dec 13, 2024@01:58:47 Page 2
HBHCUPDM ; LR VAMC(IRMS)/MJT-HBHC update missing data in ^HBHC(633.2) using ^HBHC(634.7) as input for which records/fields to update, HBHC(634.7 errors must be corrected using this MFH option, 634.7 data killed @ end of processing;9804
+1 ;;1.0;HOSPITAL BASED HOME CARE;**24**;NOV 01, 1993;Build 201
PROMPT ; Prompt user for Medical Foster Home (MFH) name
+1 WRITE !
KILL DIC
SET DIC="^HBHC(633.2,"
SET DIC(0)="AEMQ"
DO ^DIC
+2 if Y=-1
GOTO EXIT
+3 SET DA=+Y
SET HBHCMFHN=$PIECE(Y,U)
+4 IF '$DATA(^HBHC(634.7,"B",HBHCMFHN))
WRITE $CHAR(7),!!,"This Medical Foster Home (MFH) has no records containing errors on file.",!
HANG 3
GOTO PROMPT
+5 SET HBHCIEN=""
FOR
SET HBHCIEN=$ORDER(^HBHC(634.7,"B",HBHCMFHN,HBHCIEN))
if HBHCIEN=""
QUIT
DO PROCESS
+6 GOTO PROMPT
EXIT ; Exit module
+1 ; HBHC(634.7 MFH errors must be corrected using this MFH option, 634.7 killed here so validity processing can occur again
+2 KILL ^HBHC(634.7)
SET ^HBHC(634.7,0)="HBHC MEDICAL FOSTER HOME ERROR(S)^634.7P"
+3 KILL DIC,DIE,DR,HBHCMFHP,Y
+4 QUIT
PROCESS ; Process errors via DIE
+1 LOCK +^HBHC(633.2,DA):0
IF '$TEST
WRITE $CHAR(7),!!,"Another user is editing this Medical Foster Home (MFH) entry.",!
HANG 3
QUIT
+2 KILL DR
SET DR=^HBHC(634.7,HBHCIEN,1)
+3 KILL DIE
SET DIE="^HBHC(633.2,"
SET DIE("NO^")="OUTOK"
+4 WRITE !!!?10,"=== Editing Medical Foster Home (MFH) Demographic data ===",!
+5 DO ^DIE
KILL DR
+6 QUIT
