HBHCDEM ; LR VAMC(IRMS)/MJT-HBHC Medical Foster Home (MFH) demographic data entry ; May 20, 2021@13:31
;;1.0;HOSPITAL BASED HOME CARE;**24,32**;NOV 01, 1993;Build 58
;
START ; Initialization
;Sites must have at least one parent site defined.
I $O(^HBHC(631.9,1,1,"B",""))="" D Q
. W !!,"No parent sites are defined at this facility."
. W !,"Contact your HBPC Program Manager to define at least one"
. W !,"parent site in option ""System Parameters Edit"".",!
. N DIR
. S DIR("A")="Press any key to continue",DIR(0)="FO"
. D ^DIR
S HBHCFORM=7
PROMPT ; Prompt user for Medical Foster Home (MFH) name
K DIC,HBHCPRCT S DIC="^HBHC(633.2,",DIC(0)="AELMQZ" D ^DIC
G:Y=-1 EXIT
S HBHCDFN=+Y,HBHCXMT7=$P($G(^HBHC(633.2,HBHCDFN,12)),U)
I (HBHCXMT7]"")&(HBHCXMT7'="N") D FORMMSG^HBHCUTL1 G:$D(HBHCNHSP) EXIT G:HBHCPRCT'=1 PROMPT
I $P(Y,U,3) S $P(^HBHC(633.2,HBHCDFN,12),U)="N",^HBHC(633.2,"AC","N",HBHCDFN)=""
K DIE S DIE="^HBHC(633.2,",DA=HBHCDFN,DR="[HBHC MFH DEMOGRAPHIC INPUT]"
L +^HBHC(633.2,HBHCDFN):0 I $T D L -^HBHC(633.2,HBHCDFN) W !! G PROMPT
. D ^DIE
. ;HBH*1.0*32: add PARENT SITE (#91) field
. ;set a default if there is only one parent site defined
. ;at this site
. W !!,"A Parent Site is required for each Medical Foster Home."
. W !,"If you exit without entering a Parent Site, this entry"
. W !,"will not be transmitted to Austin until a Parent Site"
. W !,"is defined. An HBHC Medical Foster Home Error will be"
. W !,"generated by the transmission record verification process.",!
. N HBHCPREV,HBHCPARN
. S HBHCPREV=$P($G(^HBHC(633.2,HBHCDFN,13)),"^")
. S HBHCPARN=$S($P(^HBHC(631.9,1,1,0),"^",4)=1:$O(^HBHC(631.9,1,1,"B","")),1:"")
. I HBHCPARN]"" S HBHCPARN=$P(^DG(40.8,HBHCPARN,0),"^")
. S DR="35//^S X=HBHCPARN"
. S DIE="^HBHC(633.2,",DA=HBHCDFN
. D ^DIE
. ;This MFH has not yet transmitted, so warning message below not necessary.
. Q:$G(HBHCPRCT)'=1
. I HBHCPREV]"",HBHCPREV'=$P($G(^HBHC(633.2,HBHCDFN,13)),"^") D
. . W !!,"This Medical Foster Home has had an AITC transaction built with"
. . W !,"the former Parent Site. All patients in this Medical Foster Home"
. . W !,"need to be reviewed using Option Evaluation/Admission Data Entry."
. . W !!,"If the following message appears, answer ""YES"":"
. . W !!,"Transmit Status Flag must be reset before editing this record is allowed"
. . W !,"Do you wish to reset the Flag?"
. . W !!,"If the message does not display, no further action is needed for this patient.",!
. . N DIR
. . S DIR("A")="Press any key to continue",DIR(0)="FO"
. . D ^DIR
W $C(7),!!,"Another user is editing this entry.",!! G PROMPT
EXIT ; Exit module
K DA,DIC,DIE,DR,HBHCDFN,HBHCFORM,HBHCNHSP,HBHCPRCT,HBHCXMT7,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCDEM 2759 printed Nov 22, 2024@17:08:08 Page 2
HBHCDEM ; LR VAMC(IRMS)/MJT-HBHC Medical Foster Home (MFH) demographic data entry ; May 20, 2021@13:31
+1 ;;1.0;HOSPITAL BASED HOME CARE;**24,32**;NOV 01, 1993;Build 58
+2 ;
START ; Initialization
+1 ;Sites must have at least one parent site defined.
+2 IF $ORDER(^HBHC(631.9,1,1,"B",""))=""
Begin DoDot:1
+3 WRITE !!,"No parent sites are defined at this facility."
+4 WRITE !,"Contact your HBPC Program Manager to define at least one"
+5 WRITE !,"parent site in option ""System Parameters Edit"".",!
+6 NEW DIR
+7 SET DIR("A")="Press any key to continue"
SET DIR(0)="FO"
+8 DO ^DIR
End DoDot:1
QUIT
+9 SET HBHCFORM=7
PROMPT ; Prompt user for Medical Foster Home (MFH) name
+1 KILL DIC,HBHCPRCT
SET DIC="^HBHC(633.2,"
SET DIC(0)="AELMQZ"
DO ^DIC
+2 if Y=-1
GOTO EXIT
+3 SET HBHCDFN=+Y
SET HBHCXMT7=$PIECE($GET(^HBHC(633.2,HBHCDFN,12)),U)
+4 IF (HBHCXMT7]"")&(HBHCXMT7'="N")
DO FORMMSG^HBHCUTL1
if $DATA(HBHCNHSP)
GOTO EXIT
if HBHCPRCT'=1
GOTO PROMPT
+5 IF $PIECE(Y,U,3)
SET $PIECE(^HBHC(633.2,HBHCDFN,12),U)="N"
SET ^HBHC(633.2,"AC","N",HBHCDFN)=""
+6 KILL DIE
SET DIE="^HBHC(633.2,"
SET DA=HBHCDFN
SET DR="[HBHC MFH DEMOGRAPHIC INPUT]"
+7 LOCK +^HBHC(633.2,HBHCDFN):0
IF $TEST
Begin DoDot:1
+8 DO ^DIE
+9 ;HBH*1.0*32: add PARENT SITE (#91) field
+10 ;set a default if there is only one parent site defined
+11 ;at this site
+12 WRITE !!,"A Parent Site is required for each Medical Foster Home."
+13 WRITE !,"If you exit without entering a Parent Site, this entry"
+14 WRITE !,"will not be transmitted to Austin until a Parent Site"
+15 WRITE !,"is defined. An HBHC Medical Foster Home Error will be"
+16 WRITE !,"generated by the transmission record verification process.",!
+17 NEW HBHCPREV,HBHCPARN
+18 SET HBHCPREV=$PIECE($GET(^HBHC(633.2,HBHCDFN,13)),"^")
+19 SET HBHCPARN=$SELECT($PIECE(^HBHC(631.9,1,1,0),"^",4)=1:$ORDER(^HBHC(631.9,1,1,"B","")),1:"")
+20 IF HBHCPARN]""
SET HBHCPARN=$PIECE(^DG(40.8,HBHCPARN,0),"^")
+21 SET DR="35//^S X=HBHCPARN"
+22 SET DIE="^HBHC(633.2,"
SET DA=HBHCDFN
+23 DO ^DIE
+24 ;This MFH has not yet transmitted, so warning message below not necessary.
+25 if $GET(HBHCPRCT)'=1
QUIT
+26 IF HBHCPREV]""
IF HBHCPREV'=$PIECE($GET(^HBHC(633.2,HBHCDFN,13)),"^")
Begin DoDot:2
+27 WRITE !!,"This Medical Foster Home has had an AITC transaction built with"
+28 WRITE !,"the former Parent Site. All patients in this Medical Foster Home"
+29 WRITE !,"need to be reviewed using Option Evaluation/Admission Data Entry."
+30 WRITE !!,"If the following message appears, answer ""YES"":"
+31 WRITE !!,"Transmit Status Flag must be reset before editing this record is allowed"
+32 WRITE !,"Do you wish to reset the Flag?"
+33 WRITE !!,"If the message does not display, no further action is needed for this patient.",!
+34 NEW DIR
+35 SET DIR("A")="Press any key to continue"
SET DIR(0)="FO"
+36 DO ^DIR
End DoDot:2
End DoDot:1
LOCK -^HBHC(633.2,HBHCDFN)
WRITE !!
GOTO PROMPT
+37 WRITE $CHAR(7),!!,"Another user is editing this entry.",!!
GOTO PROMPT
EXIT ; Exit module
+1 KILL DA,DIC,DIE,DR,HBHCDFN,HBHCFORM,HBHCNHSP,HBHCPRCT,HBHCXMT7,X,Y
+2 QUIT
