- 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 Mar 13, 2025@21:02:49 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
