HBHCRXMT ; LR VAMC(IRMS)/MJT - RETRANSMIT TO AUSTIN; Feb 22, 2021@07:22
;;1.0;HOSPITAL BASED HOME CARE;**2,6,32**;NOV 01, 1993;Build 58
;
;$$PROD^XUPROD - IA #4440 (Supported)
;
I ($D(^HBHC(634.1,"B")))!($D(^HBHC(634.2,"B")))!($D(^HBHC(634.3,"B")))!($D(^HBHC(634.5,"B"))) W *7,!!,"Records containing errors exist and must be corrected before file can",!,"be transmitted.",!! H 3 Q
I '$D(^HBHC(634,"B")) W *7,!!,"No data on file to transmit." H 3 Q
EN ; Entry point
W !!,"This option re-transmits the same data included in the last file created for",!,"transmission to Austin. It should only be run under special circumstances and",!,"should be coordinated with Austin. Do you wish to continue"
S %=2 D YN^DICN
I %=0 W !!,"A 'Yes' response will re-transmit the file to Austin. A 'No' response will",!,"return to the menu without any data being transmitted." G EN
G:%'=1 EXIT
W *7,!!,"Re-transmission request has been queued.",!! H 3
S ZTRTN="DQ^HBHCRXMT",ZTIO="",ZTDTH=$H,ZTDESC="HBPC Re-Transmit" D ^%ZTLOAD,^%ZISC Q
DQ ; De-queue
K XMZ,%DT,^TMP("HBHC",$J)
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,^TMP("HBHC",$J,HBHCMSG,HBHCNODE,0)=^HBHC(634,HBHCNODE,0)
EXIT ; Exit module
K DA,DIE,DR,HBHCCNT,HBHCDAT,HBHCDATE,HBHCDT,HBHCFLG,HBHCMSG,HBHCNODE,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($P($G(^DIC(4,$P(^HBHC(631.9,1,0),U,5),99)),U),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,"AG") (Form 3 Mail Message Date), ^HBHC(631,"AH") (Form 5 Mail Message Date), & ^HBHC(632,"AD") (Form 4 Mail Message Date) cross-refs
; set re-transmit batch initial MM msg no & re-transmit mailman date fields in ^HBHC(631/632)
Q:HBHCFLG
S HBHCDAT=$P($G(^HBHC(631.9,1,0)),U,2)
Q:HBHCDAT=""
S DIE="^HBHC(631,"
S DR="83///^S X=XMZ;84///^S X=HBHCDT",DA="" F S DA=$O(^HBHC(631,"AG",HBHCDAT,DA)) Q:DA="" D ^DIE
S DR="85///^S X=XMZ;86///^S X=HBHCDT",DA="" F S DA=$O(^HBHC(631,"AH",HBHCDAT,DA)) Q:DA="" D ^DIE
S DIE="^HBHC(632,",DR="13///^S X=XMZ;14///^S X=HBHCDT",DA="" F S DA=$O(^HBHC(632,"AD",HBHCDAT,DA)) Q:DA="" D ^DIE
S HBHCFLG=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCRXMT 2684 printed Nov 22, 2024@17:08:51 Page 2
HBHCRXMT ; LR VAMC(IRMS)/MJT - RETRANSMIT TO AUSTIN; Feb 22, 2021@07:22
+1 ;;1.0;HOSPITAL BASED HOME CARE;**2,6,32**;NOV 01, 1993;Build 58
+2 ;
+3 ;$$PROD^XUPROD - IA #4440 (Supported)
+4 ;
+5 IF ($DATA(^HBHC(634.1,"B")))!($DATA(^HBHC(634.2,"B")))!($DATA(^HBHC(634.3,"B")))!($DATA(^HBHC(634.5,"B")))
WRITE *7,!!,"Records containing errors exist and must be corrected before file can",!,"be transmitted.",!!
HANG 3
QUIT
+6 IF '$DATA(^HBHC(634,"B"))
WRITE *7,!!,"No data on file to transmit."
HANG 3
QUIT
EN ; Entry point
+1 WRITE !!,"This option re-transmits the same data included in the last file created for",!,"transmission to Austin. It should only be run under special circumstances and",!,"should be coordinated with Austin. Do you wish to continue"
+2 SET %=2
DO YN^DICN
+3 IF %=0
WRITE !!,"A 'Yes' response will re-transmit the file to Austin. A 'No' response will",!,"return to the menu without any data being transmitted."
GOTO EN
+4 if %'=1
GOTO EXIT
+5 WRITE *7,!!,"Re-transmission request has been queued.",!!
HANG 3
+6 SET ZTRTN="DQ^HBHCRXMT"
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTDESC="HBPC Re-Transmit"
DO ^%ZTLOAD
DO ^%ZISC
QUIT
DQ ; De-queue
+1 KILL XMZ,%DT,^TMP("HBHC",$JOB)
+2 SET X="T"
DO ^%DT
SET HBHCDT=Y
SET HBHCDATE=$EXTRACT(HBHCDT,4,5)_"/"_$EXTRACT(HBHCDT,6,7)_"/"_$EXTRACT(HBHCDT,2,3)
+3 SET (HBHCCNT,HBHCFLG,HBHCNODE)=0
SET HBHCMSG=1
+4 FOR
SET HBHCNODE=$ORDER(^HBHC(634,HBHCNODE))
if (HBHCCNT>99)!(HBHCNODE'>0)
DO MAIL
if HBHCNODE'>0
QUIT
SET HBHCCNT=HBHCCNT+1
SET ^TMP("HBHC",$JOB,HBHCMSG,HBHCNODE,0)=^HBHC(634,HBHCNODE,0)
EXIT ; Exit module
+1 KILL DA,DIE,DR,HBHCCNT,HBHCDAT,HBHCDATE,HBHCDT,HBHCFLG,HBHCMSG,HBHCNODE,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($PIECE($GET(^DIC(4,$PIECE(^HBHC(631.9,1,0),U,5),99)),U),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,"AG") (Form 3 Mail Message Date), ^HBHC(631,"AH") (Form 5 Mail Message Date), & ^HBHC(632,"AD") (Form 4 Mail Message Date) cross-refs
+1 ; set re-transmit batch initial MM msg no & re-transmit mailman date fields in ^HBHC(631/632)
+2 if HBHCFLG
QUIT
+3 SET HBHCDAT=$PIECE($GET(^HBHC(631.9,1,0)),U,2)
+4 if HBHCDAT=""
QUIT
+5 SET DIE="^HBHC(631,"
+6 SET DR="83///^S X=XMZ;84///^S X=HBHCDT"
SET DA=""
FOR
SET DA=$ORDER(^HBHC(631,"AG",HBHCDAT,DA))
if DA=""
QUIT
DO ^DIE
+7 SET DR="85///^S X=XMZ;86///^S X=HBHCDT"
SET DA=""
FOR
SET DA=$ORDER(^HBHC(631,"AH",HBHCDAT,DA))
if DA=""
QUIT
DO ^DIE
+8 SET DIE="^HBHC(632,"
SET DR="13///^S X=XMZ;14///^S X=HBHCDT"
SET DA=""
FOR
SET DA=$ORDER(^HBHC(632,"AD",HBHCDAT,DA))
if DA=""
QUIT
DO ^DIE
+9 SET HBHCFLG=1
+10 QUIT
