HBHCFILE ; LR VAMC(IRMS)/MJT- HBHC Build/Verify Transmission File; May 05, 2021@14:33
;;1.0;HOSPITAL BASED HOME CARE;**2,5,6,8,9,10,16,21,24,27,32**;NOV 01, 1993;Build 58
;
;
; Reference/ICR
; PATIENT FILE/10035
; REGISTRATION/3744
;
;
I $P(^HBHC(631.9,1,0),U,5)="" W !!,"*** NOTICE: Hospital Number is missing from System Parameter file (#631.9).",!,"Transmission file building CANNOT proceed without this information. Contact"
I $P(^HBHC(631.9,1,0),U,5)="" W !,"IRM to enter this information using FileMan.",! H 10 Q
L +^HBHC(634.5,0):0 I '$T W $C(7),!!,"Another user has the pseudo SSN file locked." H 3 G EXIT
I ($D(^HBHC(634.1,"B")))!($D(^HBHC(634.2,"B")))!($D(^HBHC(634.3,"B")))!($D(^HBHC(634.5,"B")))!($D(^HBHC(634.7,"B"))) W $C(7),!!,"Records containing errors exist and must be corrected before transmit",!,"file can be created or updated.",!! H 3 Q
EN ; Entry point
I $P(^HBHC(631.9,1,0),U,8)]"" W $C(7),!,"File Update in progress. Please try again later." H 3 Q
;HBH*1.0*32: At least one parent site must be 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
W !!,"This option builds the file for transmission to Austin. Do you wish to",!,"continue" S %=2 D YN^DICN
I %=0 W !!,"A 'Yes' response will add records to the file. A 'No' response will return",!,"to the menu without updating the file." G EN
G:%'=1 EXIT
MONTH ; Calculate default month value & last date to be included for transmission
S X="T" D ^%DT S X1=$P(Y,"."),X2=-28 D C^%DTC S DIR("B")=+$E(X,4,5)
S DIR(0)="SX^1:January;2:February;3:March;4:April;5:May;6:June;7:July;8:August;9:September;10:October;11:November;12:December;"
S DIR("A")="Month for which data is to be transmitted"
S DIR("?")="Month entered controls the ending date for data transmitted to Austin. (e.g. An August 5 transmission with July selected as month, will include data thru July 31.)"
D ^DIR Q:$D(DIRUT) S HBHCDIR=Y
S X="T" D ^%DT S HBHCYEAR=$S(HBHCDIR>(+$E(Y,4,5)):($E(Y,1,3))-1,1:$E(Y,1,3))
S Y=1700+HBHCYEAR,HBHCLEAP=$S(Y#400=0:1,Y#4=0&'(Y#100=0):1,1:0)
S HBHCLSDT=HBHCYEAR_$S(HBHCDIR<10:"0"_HBHCDIR,1:HBHCDIR)_$S(((HBHCDIR=2)&('HBHCLEAP)):28,((HBHCDIR=2)&(HBHCLEAP)):29,"^1^3^5^7^8^10^12^"[HBHCDIR:31,1:30)_.9999
S Y=$P(HBHCLSDT,".") D DD^%DT S HBHCCKDT=Y
NUMBER ; Edit Number of Visit Days to Scan system parameter
W !
K DIR S DIR(0)="631.9,3",DIR("A")="Number of Visit Days to Scan",DIR("B")=$P($G(^HBHC(631.9,1,0)),U,4)
S DIR("?",1)="Enter number of days to be included when the system creates records in the",DIR("?",2)="HBHC Visit File from the appointment data entered via the Appointment",DIR("?")="Management [HBHC APPOINTMENT] option."
D ^DIR
G:($D(DTOUT))!($D(DUOUT)) EXIT
S HBHCDIR=Y
I (HBHCDIR'=DIR("B"))&(HBHCDIR?1.3N) K DIE S HBHCDAYS=Y,DIE="^HBHC(631.9,",DA=1,DR="3///^S X=HBHCDAYS" D ^DIE
; Check to ensure Number of Visit Days to Scan date < HBHCLSDT
K %DT S X="T"-($S(HBHCDIR'=DIR("B"):HBHCDIR,1:DIR("B"))) D ^%DT
I (Y_".9999")'<HBHCLSDT D DD^%DT W $C(7),!!,"Date Range is invalid. Transmit Month Ending Date of: ",HBHCCKDT," must",!,"be closer to today than the Number of Days to Scan Date: ",Y,".",! G NUMBER
CLEANUP ; Cleanup ^HBHC(634) if new transmit cycle => all records flagged as transmitted
I ('$D(^HBHC(631,"AE","F")))&('$D(^HBHC(631,"AF","F")))&('$D(^HBHC(632,"AC","F")))&('$D(^HBHC(633.2,"AC","F"))) K ^HBHC(634) S ^HBHC(634,0)="HBHC TRANSMIT^634"
; Flag used to control killing HBHCDAT, HBHCDTE, & HBHCNOW in HBHCAPPT
S HBHCFLAG=1
QUEUE ; Queue
S ZTIO="",ZTDTH=$H,ZTRTN="PLOOP^HBHCFILE",ZTSAVE("HBHC*")="",ZTDESC="HBPC Build Transmit File" D ^%ZTLOAD
W $C(7),!!,"Build Transmit File processing has been queued. Task number: ",ZTSK H 3
G EXIT
PLOOP ; Loop thru ^HBHC(632,"C" Appointment Date cross-ref & flag as 'P' (Record Prior to Package Startup Date) in Form 4 Transmit Status field if date < Package Startup Date
S X1=$P(^HBHC(631.9,1,0),U,3),X2=-1 D C^%DTC S HBHCSTDT=X_.9999
S HBHCAPDT=0,DIE="^HBHC(632,",DR="7///P"
F S HBHCAPDT=$O(^HBHC(632,"C",HBHCAPDT)) Q:(HBHCAPDT'>0)!(HBHCAPDT>HBHCSTDT) S DA="" F S DA=$O(^HBHC(632,"C",HBHCAPDT,DA)) Q:DA'>0 D:'$D(^HBHC(632,"AC","P",DA)) ^DIE
POP ; Populate ^HBHC(634) or ^HBHC(634.1/634.2/634.3/634.5/634.7 Error files
D ^HBHCAPPT,^HBHCXMC,^HBHCXMA,^HBHCXMV,^HBHCXMD,TPATCHK
; MFH Sanction Date must exist for MFH data to be included in Austin transmit
D:$P(^HBHC(631.9,1,0),U,9)]"" ^HBHCXMM
; Cleanup potential scrogged HBHC(632,"AC" cross-ref on Form 4 Transmit Status field (#7) as failsafe
K ^HBHC(632,"AC") S DIK="^HBHC(632,",DIK(1)=7 D ENALL^DIK
; Send mail message
D:('$D(^HBHC(634.1,"B")))&('$D(^HBHC(634.2,"B")))&('$D(^HBHC(634.3,"B")))&('$D(^HBHC(634.5,"B")))&('$D(^HBHC(634.7,"B"))) MAIL
EXIT ; Exit module
L -^HBHC(634.5,0)
K DA,DIE,DIR,DIRUT,DR,DTOUT,DUOUT,HBHCAPDT,HBHCCKDT,HBHCDAT,HBHCDAYS,HBHCDTE,HBHCDIR,HBHCFLAG,HBHCLEAP,HBHCLSDT,HBHCNOW,HBHCSTDT,HBHCYEAR,%,TMP,X,X1,X2,Y
Q
TPATCHK ; HBH*1.0*27 ; Identify and remove test patients from the HBHC TRANSMIT file
N HBHCSSN,HBHCTRDAT,HBHCDFN,HBHCTRIEN
S HBHCTRDAT=0 F S HBHCTRDAT=$O(^HBHC(634,"B",HBHCTRDAT)) Q:HBHCTRDAT'>0 D
.S HBHCSSN=$E(HBHCTRDAT,9,17)
.S HBHCDFN=$O(^DPT("SSN",HBHCSSN,0))
.I $$TESTPAT^VADPT(HBHCDFN) D
..S HBHCTRIEN=$O(^HBHC(634,"B",HBHCTRDAT,0))
..N DIK,DA
..S DIK="^HBHC(634,",DA=HBHCTRIEN D ^DIK
Q
MAIL ; Send completed mail message
S TMP(1)=$P(HBHCDAT,"@")_" HBHC Build Transmit File is complete with no errors found.",TMP(2)="",TMP(3)=" Number of Visit Days to Scan system parameter: "_$P(^HBHC(631.9,1,0),U,4),TMP(4)=""
S Y=$P($P(HBHCDTE,U),"@") X ^DD("DD") S HBHCINFO=Y,Y=$P($P(HBHCDTE,U,2),"@") X ^DD("DD") S TMP(5)=" Date range: "_$P(HBHCINFO,"@")_" thru "_$P(Y,"@"),TMP(6)=""
D NOW^%DTC S Y=% X ^DD("DD")
S TMP(7)=" Start time: "_$P(HBHCDAT,"@",2)_" End time: "_$P(Y,"@",2)_" Elapsed minutes: "_($E(%_"000",9,10)-$E(HBHCNOW_"000",9,10)*60+$E(%_"00000",11,12)-$E(HBHCNOW_"00000",11,12)),TMP(8)=""
S TMP(9)="***** Reminder: Please run Transmit File to Austin option. *****"
S XMDUZ="HBHC Build Transmit File Mail Group",XMSUB=$P(HBHCDAT,"@")_" HBHC Build Transmit File",XMY(DUZ)="",XMTEXT="TMP("
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCFILE 6488 printed Nov 22, 2024@17:08:11 Page 2
HBHCFILE ; LR VAMC(IRMS)/MJT- HBHC Build/Verify Transmission File; May 05, 2021@14:33
+1 ;;1.0;HOSPITAL BASED HOME CARE;**2,5,6,8,9,10,16,21,24,27,32**;NOV 01, 1993;Build 58
+2 ;
+3 ;
+4 ; Reference/ICR
+5 ; PATIENT FILE/10035
+6 ; REGISTRATION/3744
+7 ;
+8 ;
+9 IF $PIECE(^HBHC(631.9,1,0),U,5)=""
WRITE !!,"*** NOTICE: Hospital Number is missing from System Parameter file (#631.9).",!,"Transmission file building CANNOT proceed without this information. Contact"
+10 IF $PIECE(^HBHC(631.9,1,0),U,5)=""
WRITE !,"IRM to enter this information using FileMan.",!
HANG 10
QUIT
+11 LOCK +^HBHC(634.5,0):0
IF '$TEST
WRITE $CHAR(7),!!,"Another user has the pseudo SSN file locked."
HANG 3
GOTO EXIT
+12 IF ($DATA(^HBHC(634.1,"B")))!($DATA(^HBHC(634.2,"B")))!($DATA(^HBHC(634.3,"B")))!($DATA(^HBHC(634.5,"B")))!($DATA(^HBHC(634.7,"B")))
WRITE $CHAR(7),!!,"Records containing errors exist and must be corrected before transmit",!,"file can be created or updated.",!!
HANG 3
QUIT
EN ; Entry point
+1 IF $PIECE(^HBHC(631.9,1,0),U,8)]""
WRITE $CHAR(7),!,"File Update in progress. Please try again later."
HANG 3
QUIT
+2 ;HBH*1.0*32: At least one parent site must be defined.
+3 IF $ORDER(^HBHC(631.9,1,1,"B",""))=""
Begin DoDot:1
+4 WRITE !!,"No parent sites are defined at this facility."
+5 WRITE !,"Contact your HBPC Program Manager to define at least one"
+6 WRITE !,"parent site in option ""System Parameters Edit"".",!
+7 NEW DIR
+8 SET DIR("A")="Press any key to continue"
SET DIR(0)="FO"
+9 DO ^DIR
End DoDot:1
QUIT
+10 WRITE !!,"This option builds the file for transmission to Austin. Do you wish to",!,"continue"
SET %=2
DO YN^DICN
+11 IF %=0
WRITE !!,"A 'Yes' response will add records to the file. A 'No' response will return",!,"to the menu without updating the file."
GOTO EN
+12 if %'=1
GOTO EXIT
MONTH ; Calculate default month value & last date to be included for transmission
+1 SET X="T"
DO ^%DT
SET X1=$PIECE(Y,".")
SET X2=-28
DO C^%DTC
SET DIR("B")=+$EXTRACT(X,4,5)
+2 SET DIR(0)="SX^1:January;2:February;3:March;4:April;5:May;6:June;7:July;8:August;9:September;10:October;11:November;12:December;"
+3 SET DIR("A")="Month for which data is to be transmitted"
+4 SET DIR("?")="Month entered controls the ending date for data transmitted to Austin. (e.g. An August 5 transmission with July selected as month, will include data thru July 31.)"
+5 DO ^DIR
if $DATA(DIRUT)
QUIT
SET HBHCDIR=Y
+6 SET X="T"
DO ^%DT
SET HBHCYEAR=$SELECT(HBHCDIR>(+$EXTRACT(Y,4,5)):($EXTRACT(Y,1,3))-1,1:$EXTRACT(Y,1,3))
+7 SET Y=1700+HBHCYEAR
SET HBHCLEAP=$SELECT(Y#400=0:1,Y#4=0&'(Y#100=0):1,1:0)
+8 SET HBHCLSDT=HBHCYEAR_$SELECT(HBHCDIR<10:"0"_HBHCDIR,1:HBHCDIR)_$SELECT(((HBHCDIR=2)&('HBHCLEAP)):28,((HBHCDIR=2)&(HBHCLEAP)):29,"^1^3^5^7^8^10^12^"[HBHCDIR:31,1:30)_.9999
+9 SET Y=$PIECE(HBHCLSDT,".")
DO DD^%DT
SET HBHCCKDT=Y
NUMBER ; Edit Number of Visit Days to Scan system parameter
+1 WRITE !
+2 KILL DIR
SET DIR(0)="631.9,3"
SET DIR("A")="Number of Visit Days to Scan"
SET DIR("B")=$PIECE($GET(^HBHC(631.9,1,0)),U,4)
+3 SET DIR("?",1)="Enter number of days to be included when the system creates records in the"
SET DIR("?",2)="HBHC Visit File from the appointment data entered via the Appointment"
SET DIR("?")="Management [HBHC APPOINTMENT] option."
+4 DO ^DIR
+5 if ($DATA(DTOUT))!($DATA(DUOUT))
GOTO EXIT
+6 SET HBHCDIR=Y
+7 IF (HBHCDIR'=DIR("B"))&(HBHCDIR?1.3N)
KILL DIE
SET HBHCDAYS=Y
SET DIE="^HBHC(631.9,"
SET DA=1
SET DR="3///^S X=HBHCDAYS"
DO ^DIE
+8 ; Check to ensure Number of Visit Days to Scan date < HBHCLSDT
+9 KILL %DT
SET X="T"-($SELECT(HBHCDIR'=DIR("B"):HBHCDIR,1:DIR("B")))
DO ^%DT
+10 IF (Y_".9999")'<HBHCLSDT
DO DD^%DT
WRITE $CHAR(7),!!,"Date Range is invalid. Transmit Month Ending Date of: ",HBHCCKDT," must",!,"be closer to today than the Number of Days to Scan Date: ",Y,".",!
GOTO NUMBER
CLEANUP ; Cleanup ^HBHC(634) if new transmit cycle => all records flagged as transmitted
+1 IF ('$DATA(^HBHC(631,"AE","F")))&('$DATA(^HBHC(631,"AF","F")))&('$DATA(^HBHC(632,"AC","F")))&('$DATA(^HBHC(633.2,"AC","F")))
KILL ^HBHC(634)
SET ^HBHC(634,0)="HBHC TRANSMIT^634"
+2 ; Flag used to control killing HBHCDAT, HBHCDTE, & HBHCNOW in HBHCAPPT
+3 SET HBHCFLAG=1
QUEUE ; Queue
+1 SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTRTN="PLOOP^HBHCFILE"
SET ZTSAVE("HBHC*")=""
SET ZTDESC="HBPC Build Transmit File"
DO ^%ZTLOAD
+2 WRITE $CHAR(7),!!,"Build Transmit File processing has been queued. Task number: ",ZTSK
HANG 3
+3 GOTO EXIT
PLOOP ; Loop thru ^HBHC(632,"C" Appointment Date cross-ref & flag as 'P' (Record Prior to Package Startup Date) in Form 4 Transmit Status field if date < Package Startup Date
+1 SET X1=$PIECE(^HBHC(631.9,1,0),U,3)
SET X2=-1
DO C^%DTC
SET HBHCSTDT=X_.9999
+2 SET HBHCAPDT=0
SET DIE="^HBHC(632,"
SET DR="7///P"
+3 FOR
SET HBHCAPDT=$ORDER(^HBHC(632,"C",HBHCAPDT))
if (HBHCAPDT'>0)!(HBHCAPDT>HBHCSTDT)
QUIT
SET DA=""
FOR
SET DA=$ORDER(^HBHC(632,"C",HBHCAPDT,DA))
if DA'>0
QUIT
if '$DATA(^HBHC(632,"AC","P",DA))
DO ^DIE
POP ; Populate ^HBHC(634) or ^HBHC(634.1/634.2/634.3/634.5/634.7 Error files
+1 DO ^HBHCAPPT
DO ^HBHCXMC
DO ^HBHCXMA
DO ^HBHCXMV
DO ^HBHCXMD
DO TPATCHK
+2 ; MFH Sanction Date must exist for MFH data to be included in Austin transmit
+3 if $PIECE(^HBHC(631.9,1,0),U,9)]""
DO ^HBHCXMM
+4 ; Cleanup potential scrogged HBHC(632,"AC" cross-ref on Form 4 Transmit Status field (#7) as failsafe
+5 KILL ^HBHC(632,"AC")
SET DIK="^HBHC(632,"
SET DIK(1)=7
DO ENALL^DIK
+6 ; Send mail message
+7 if ('$DATA(^HBHC(634.1,"B")))&('$DATA(^HBHC(634.2,"B")))&('$DATA(^HBHC(634.3,"B")))&('$DATA(^HBHC(634.5,"B")))&('$DATA(^HBHC(634.7,"B")))
DO MAIL
EXIT ; Exit module
+1 LOCK -^HBHC(634.5,0)
+2 KILL DA,DIE,DIR,DIRUT,DR,DTOUT,DUOUT,HBHCAPDT,HBHCCKDT,HBHCDAT,HBHCDAYS,HBHCDTE,HBHCDIR,HBHCFLAG,HBHCLEAP,HBHCLSDT,HBHCNOW,HBHCSTDT,HBHCYEAR,%,TMP,X,X1,X2,Y
+3 QUIT
TPATCHK ; HBH*1.0*27 ; Identify and remove test patients from the HBHC TRANSMIT file
+1 NEW HBHCSSN,HBHCTRDAT,HBHCDFN,HBHCTRIEN
+2 SET HBHCTRDAT=0
FOR
SET HBHCTRDAT=$ORDER(^HBHC(634,"B",HBHCTRDAT))
if HBHCTRDAT'>0
QUIT
Begin DoDot:1
+3 SET HBHCSSN=$EXTRACT(HBHCTRDAT,9,17)
+4 SET HBHCDFN=$ORDER(^DPT("SSN",HBHCSSN,0))
+5 IF $$TESTPAT^VADPT(HBHCDFN)
Begin DoDot:2
+6 SET HBHCTRIEN=$ORDER(^HBHC(634,"B",HBHCTRDAT,0))
+7 NEW DIK,DA
+8 SET DIK="^HBHC(634,"
SET DA=HBHCTRIEN
DO ^DIK
End DoDot:2
End DoDot:1
+9 QUIT
MAIL ; Send completed mail message
+1 SET TMP(1)=$PIECE(HBHCDAT,"@")_" HBHC Build Transmit File is complete with no errors found."
SET TMP(2)=""
SET TMP(3)=" Number of Visit Days to Scan system parameter: "_$PIECE(^HBHC(631.9,1,0),U,4)
SET TMP(4)=""
+2 SET Y=$PIECE($PIECE(HBHCDTE,U),"@")
XECUTE ^DD("DD")
SET HBHCINFO=Y
SET Y=$PIECE($PIECE(HBHCDTE,U,2),"@")
XECUTE ^DD("DD")
SET TMP(5)=" Date range: "_$PIECE(HBHCINFO,"@")_" thru "_$PIECE(Y,"@")
SET TMP(6)=""
+3 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+4 SET TMP(7)=" Start time: "_$PIECE(HBHCDAT,"@",2)_" End time: "_$PIECE(Y,"@",2)_" Elapsed minutes: "_($EXTRACT(%_"000",9,10)-$EXTRACT(HBHCNOW_"000",9,10)*60+$EXTRACT(%_"00000",11,12)-$EXTRACT(HBHCNOW_"00000",11,12))
SET TMP(8)=""
+5 SET TMP(9)="***** Reminder: Please run Transmit File to Austin option. *****"
+6 SET XMDUZ="HBHC Build Transmit File Mail Group"
SET XMSUB=$PIECE(HBHCDAT,"@")_" HBHC Build Transmit File"
SET XMY(DUZ)=""
SET XMTEXT="TMP("
+7 DO ^XMD
+8 QUIT
