- HBHCXMT ; LR VAMC(IRMS)/MJT-HBHC TRANSMIT TO AUSTIN; Feb 22, 2021@07:22
- ;;1.0;HOSPITAL BASED HOME CARE;**2,3,6,8,10,13,24,32**;NOV 01, 1993;Build 58
- ;
- ;$$PROD^XUPROD - IA #4440 (Supported)
- ;
- ; routine calls HOSP^HBHCUTL1
- I $P(^HBHC(631.9,1,0),U,8)]"" W $C(7),!,"File Update in progress. Please try again later." H 3 Q
- 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 file can",!,"be transmitted.",!! H 3 Q
- I '$D(^HBHC(634,"B")) W $C(7),!!,"No data on file to transmit." H 3 Q
- I ('$D(^HBHC(631,"AE","F")))&('$D(^HBHC(631,"AF","F")))&('$D(^HBHC(632,"AC","F")))&('$D(^HBHC(633.2,"AC","F")))!($P(^HBHC(631.9,1,0),U,6)]"") W $C(7),!!,"Data on file has been transmitted to Austin; duplicate transmission not allowed." H 3 Q
- I $P(^HBHC(631.9,1,0),U,7)]"" S HBHCPRTR=$P($G(^%ZIS(1,$P(^HBHC(631.9,1,0),U,7),0)),U) I HBHCPRTR]"" W !,"Transmit Report will be printed on device: ",HBHCPRTR W "." D PROMPT2^HBHCR15B
- S ZTRTN="DQ^HBHCXMT",ZTIO="",ZTDTH=$H,ZTDESC="HBPC Transmission",ZTSAVE("HBHC*")="" D ^%ZTLOAD,^%ZISC
- W $C(7),!!,"Transmission request has been queued. Task number: ",ZTSK,!! H 3
- G EXIT
- DQ ; De-queue
- ; Set Transmission in Progress Flag
- S $P(^HBHC(631.9,1,0),U,6)=1
- K XMZ,%DT,^TMP("HBHC",$J)
- D HOSP^HBHCUTL1
- S X="T" D ^%DT S HBHCDT=Y,HBHCDATE=$E(HBHCDT,4,5)_"/"_$E(HBHCDT,6,7)_"/"_$E(HBHCDT,2,3)
- S (HBHCCNT,HBHCFLG,HBHCNODE)=0,HBHCMSG=1
- F S HBHCNODE=$O(^HBHC(634,HBHCNODE)) D:(HBHCCNT>99)!(HBHCNODE'>0) MAIL Q:HBHCNODE'>0 S HBHCCNT=HBHCCNT+1,HBHCINFO=^HBHC(634,HBHCNODE,0),^TMP("HBHC",$J,HBHCMSG,HBHCNODE,0)=HBHCINFO D HISTORY
- CLEANUP ; Cleanup Transmit History (HBHC(634.6)) to maintain maximum of last 12 transmit batches
- S (HBHCTOT,HBHCDATE)=0 F S HBHCDATE=$O(^HBHC(634.6,"C",HBHCDATE)) Q:HBHCDATE'>0 S HBHCTOT=HBHCTOT+1 S:HBHCTOT=1 HBHCDAT=HBHCDATE
- I HBHCTOT>12 S DIK="^HBHC(634.6,",DA="" F S DA=$O(^HBHC(634.6,"C",HBHCDAT,DA)) Q:DA'>0 D ^DIK
- ; Turn Off Transmission in Progress Flag
- S $P(^HBHC(631.9,1,0),U,6)=""
- PRINT ; Print Transmit Report if default printer exists in 631.9
- ; HBHCIOP set in PROMPT2^HBHCR15B
- I ($D(HBHCIOP))&($D(HBHCHEAD)) N IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH,ZTQUEUED S ZTRTN="DQ^HBHCR15A",ZTIO=HBHCIOP,ZTDESC="HBPC Transmit Report",ZTSAVE("HBHC*")="",ZTDTH=$H D ^%ZTLOAD,^%ZISC
- EXIT ; Exit module
- K DA,DIC,DIE,DIK,DR,HBHCCNT,HBHCDAT,HBHCDATE,HBHCDT,HBHCFLG,HBHCHOSP,HBHCINFO,HBHCMSG,HBHCNODE,HBHCPRTR,HBHCTOT,HBHCZ,XMSUB,XMTEXT,XMY,XMZ,X,Y,%,%DT,^TMP("HBHC",$J)
- Q
- MAIL ; Send mail message
- ;HBH*1.0*32: Determine recipient based on whether test or production environment
- N HBHCXMY
- S HBHCXMY=$S($$PROD^XUPROD:"XXX@Q-HBH.DOMAIN.EXT",1:"XXX@Q-HBX.DOMAIN.EXT")
- S XMY(HBHCXMY)=""
- S XMSUB="HBHC Site: "_$S($P(^HBHC(631.9,1,0),U,5)]"":$E(HBHCHOSP,1,3),1:"")_" Message: "_HBHCMSG_" "_HBHCDATE_" Transmission",XMTEXT="^TMP(""HBHC"",$J,HBHCMSG,"
- D ^XMD
- S HBHCMSG=HBHCMSG+1,HBHCCNT=0
- LOOP ; Loop thru ^HBHC(631,"AE") (Form 3 Transmit Flag), ^HBHC(631,"AF") (Form 5 Transmit Flag), & ^HBHC(632,"AC") (Form 4 Transmit Flag) cross-refs to set batch initial MM message number & mailman message date fields in ^HBHC(631/632)
- ; also loop thru ^HBHC(633.2,"AC") (Form 7 Transmit Flag)
- Q:HBHCFLG
- S DIE="^HBHC(631,"
- S DR="71///T;74///^S X=XMZ;75///^S X=HBHCDT",DA="" F S DA=$O(^HBHC(631,"AE","F",DA)) Q:DA="" D ^DIE
- S DR="72///T;77///^S X=XMZ;78///^S X=HBHCDT",DA="" F S DA=$O(^HBHC(631,"AF","F",DA)) Q:DA="" D ^DIE
- S DIE="^HBHC(632,",DR="7///T;9///^S X=XMZ;10///^S X=HBHCDT",DA="" F S DA=$O(^HBHC(632,"AC","F",DA)) Q:DA="" D ^DIE
- ; Only update if Sanctioned MFH site
- I $P($G(^HBHC(631.9,1,0)),U,9)]"" S DIE="^HBHC(633.2,",DR="27///T;29///^S X=XMZ;30///^S X=HBHCDT",DA="" F S DA=$O(^HBHC(633.2,"AC","F",DA)) Q:DA="" D ^DIE
- ; Set Last Mail Message Date in System Parameters file
- S $P(^HBHC(631.9,1,0),U,2)=HBHCDT
- S HBHCFLG=1
- Q
- HISTORY ; Update HBHC(634.6 Transmit History file
- K DD,DO S DIC="^HBHC(634.6,",DIC(0)="L",DIC("DR")="1///^S X=HBHCDT",X=HBHCINFO D FILE^DICN K DO
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCXMT 4162 printed Mar 13, 2025@21:03:49 Page 2
- HBHCXMT ; LR VAMC(IRMS)/MJT-HBHC TRANSMIT TO AUSTIN; Feb 22, 2021@07:22
- +1 ;;1.0;HOSPITAL BASED HOME CARE;**2,3,6,8,10,13,24,32**;NOV 01, 1993;Build 58
- +2 ;
- +3 ;$$PROD^XUPROD - IA #4440 (Supported)
- +4 ;
- +5 ; routine calls HOSP^HBHCUTL1
- +6 IF $PIECE(^HBHC(631.9,1,0),U,8)]""
- WRITE $CHAR(7),!,"File Update in progress. Please try again later."
- HANG 3
- QUIT
- +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")))
- WRITE $CHAR(7),!!,"Records containing errors exist and must be corrected before file can",!,"be transmitted.",!!
- HANG 3
- QUIT
- +8 IF '$DATA(^HBHC(634,"B"))
- WRITE $CHAR(7),!!,"No data on file to transmit."
- HANG 3
- QUIT
- +9 IF ('$DATA(^HBHC(631,"AE","F")))&('$DATA(^HBHC(631,"AF","F")))&('$DATA(^HBHC(632,"AC","F")))&('$DATA(^HBHC(633.2,"AC","F")))!($PIECE(^HBHC(631.9,1,0),U,6)]"")
- WRITE $CHAR(7),!!,"Data on file has been transmitted to Austin; duplicate transmission not allowed."
- HANG 3
- QUIT
- +10 IF $PIECE(^HBHC(631.9,1,0),U,7)]""
- SET HBHCPRTR=$PIECE($GET(^%ZIS(1,$PIECE(^HBHC(631.9,1,0),U,7),0)),U)
- IF HBHCPRTR]""
- WRITE !,"Transmit Report will be printed on device: ",HBHCPRTR
- WRITE "."
- DO PROMPT2^HBHCR15B
- +11 SET ZTRTN="DQ^HBHCXMT"
- SET ZTIO=""
- SET ZTDTH=$HOROLOG
- SET ZTDESC="HBPC Transmission"
- SET ZTSAVE("HBHC*")=""
- DO ^%ZTLOAD
- DO ^%ZISC
- +12 WRITE $CHAR(7),!!,"Transmission request has been queued. Task number: ",ZTSK,!!
- HANG 3
- +13 GOTO EXIT
- DQ ; De-queue
- +1 ; Set Transmission in Progress Flag
- +2 SET $PIECE(^HBHC(631.9,1,0),U,6)=1
- +3 KILL XMZ,%DT,^TMP("HBHC",$JOB)
- +4 DO HOSP^HBHCUTL1
- +5 SET X="T"
- DO ^%DT
- SET HBHCDT=Y
- SET HBHCDATE=$EXTRACT(HBHCDT,4,5)_"/"_$EXTRACT(HBHCDT,6,7)_"/"_$EXTRACT(HBHCDT,2,3)
- +6 SET (HBHCCNT,HBHCFLG,HBHCNODE)=0
- SET HBHCMSG=1
- +7 FOR
- SET HBHCNODE=$ORDER(^HBHC(634,HBHCNODE))
- if (HBHCCNT>99)!(HBHCNODE'>0)
- DO MAIL
- if HBHCNODE'>0
- QUIT
- SET HBHCCNT=HBHCCNT+1
- SET HBHCINFO=^HBHC(634,HBHCNODE,0)
- SET ^TMP("HBHC",$JOB,HBHCMSG,HBHCNODE,0)=HBHCINFO
- DO HISTORY
- CLEANUP ; Cleanup Transmit History (HBHC(634.6)) to maintain maximum of last 12 transmit batches
- +1 SET (HBHCTOT,HBHCDATE)=0
- FOR
- SET HBHCDATE=$ORDER(^HBHC(634.6,"C",HBHCDATE))
- if HBHCDATE'>0
- QUIT
- SET HBHCTOT=HBHCTOT+1
- if HBHCTOT=1
- SET HBHCDAT=HBHCDATE
- +2 IF HBHCTOT>12
- SET DIK="^HBHC(634.6,"
- SET DA=""
- FOR
- SET DA=$ORDER(^HBHC(634.6,"C",HBHCDAT,DA))
- if DA'>0
- QUIT
- DO ^DIK
- +3 ; Turn Off Transmission in Progress Flag
- +4 SET $PIECE(^HBHC(631.9,1,0),U,6)=""
- PRINT ; Print Transmit Report if default printer exists in 631.9
- +1 ; HBHCIOP set in PROMPT2^HBHCR15B
- +2 IF ($DATA(HBHCIOP))&($DATA(HBHCHEAD))
- NEW IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH,ZTQUEUED
- SET ZTRTN="DQ^HBHCR15A"
- SET ZTIO=HBHCIOP
- SET ZTDESC="HBPC Transmit Report"
- SET ZTSAVE("HBHC*")=""
- SET ZTDTH=$HOROLOG
- DO ^%ZTLOAD
- DO ^%ZISC
- EXIT ; Exit module
- +1 KILL DA,DIC,DIE,DIK,DR,HBHCCNT,HBHCDAT,HBHCDATE,HBHCDT,HBHCFLG,HBHCHOSP,HBHCINFO,HBHCMSG,HBHCNODE,HBHCPRTR,HBHCTOT,HBHCZ,XMSUB,XMTEXT,XMY,XMZ,X,Y,%,%DT,^TMP("HBHC",$JOB)
- +2 QUIT
- MAIL ; Send mail message
- +1 ;HBH*1.0*32: Determine recipient based on whether test or production environment
- +2 NEW HBHCXMY
- +3 SET HBHCXMY=$SELECT($$PROD^XUPROD:"XXX@Q-HBH.DOMAIN.EXT",1:"XXX@Q-HBX.DOMAIN.EXT")
- +4 SET XMY(HBHCXMY)=""
- +5 SET XMSUB="HBHC Site: "_$SELECT($PIECE(^HBHC(631.9,1,0),U,5)]"":$EXTRACT(HBHCHOSP,1,3),1:"")_" Message: "_HBHCMSG_" "_HBHCDATE_" Transmission"
- SET XMTEXT="^TMP(""HBHC"",$J,HBHCMSG,"
- +6 DO ^XMD
- +7 SET HBHCMSG=HBHCMSG+1
- SET HBHCCNT=0
- LOOP ; Loop thru ^HBHC(631,"AE") (Form 3 Transmit Flag), ^HBHC(631,"AF") (Form 5 Transmit Flag), & ^HBHC(632,"AC") (Form 4 Transmit Flag) cross-refs to set batch initial MM message number & mailman message date fields in ^HBHC(631/632)
- +1 ; also loop thru ^HBHC(633.2,"AC") (Form 7 Transmit Flag)
- +2 if HBHCFLG
- QUIT
- +3 SET DIE="^HBHC(631,"
- +4 SET DR="71///T;74///^S X=XMZ;75///^S X=HBHCDT"
- SET DA=""
- FOR
- SET DA=$ORDER(^HBHC(631,"AE","F",DA))
- if DA=""
- QUIT
- DO ^DIE
- +5 SET DR="72///T;77///^S X=XMZ;78///^S X=HBHCDT"
- SET DA=""
- FOR
- SET DA=$ORDER(^HBHC(631,"AF","F",DA))
- if DA=""
- QUIT
- DO ^DIE
- +6 SET DIE="^HBHC(632,"
- SET DR="7///T;9///^S X=XMZ;10///^S X=HBHCDT"
- SET DA=""
- FOR
- SET DA=$ORDER(^HBHC(632,"AC","F",DA))
- if DA=""
- QUIT
- DO ^DIE
- +7 ; Only update if Sanctioned MFH site
- +8 IF $PIECE($GET(^HBHC(631.9,1,0)),U,9)]""
- SET DIE="^HBHC(633.2,"
- SET DR="27///T;29///^S X=XMZ;30///^S X=HBHCDT"
- SET DA=""
- FOR
- SET DA=$ORDER(^HBHC(633.2,"AC","F",DA))
- if DA=""
- QUIT
- DO ^DIE
- +9 ; Set Last Mail Message Date in System Parameters file
- +10 SET $PIECE(^HBHC(631.9,1,0),U,2)=HBHCDT
- +11 SET HBHCFLG=1
- +12 QUIT
- HISTORY ; Update HBHC(634.6 Transmit History file
- +1 KILL DD,DO
- SET DIC="^HBHC(634.6,"
- SET DIC(0)="L"
- SET DIC("DR")="1///^S X=HBHCDT"
- SET X=HBHCINFO
- DO FILE^DICN
- KILL DO
- +2 QUIT
