HBHCRXMT ; LR VAMC(IRMS)/MJT-HBHC Re-transmit previous MM (100 rec @ 125 chars ea, max) using ^HBHC(634) data, transmit/Austin, & set re-transmit batch initial MM msg no & re-transmit MM date in ^HBHC(631/632) ;9204
;;1.0;HOSPITAL BASED HOME CARE;**2,6**;NOV 01, 1993
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
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,",XMY("XXX@Q-HBH.DOMAIN.EXT")=""
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 2605 printed Apr 07, 2021@15:05:28 Page 2
HBHCRXMT ; LR VAMC(IRMS)/MJT-HBHC Re-transmit previous MM (100 rec @ 125 chars ea, max) using ^HBHC(634) data, transmit/Austin, & set re-transmit batch initial MM msg no & re-transmit MM date in ^HBHC(631/632) ;9204
+1 ;;1.0;HOSPITAL BASED HOME CARE;**2,6**;NOV 01, 1993
+2 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
+3 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 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,"
SET XMY("XXX@Q-HBH.DOMAIN.EXT")=""
+2 DO ^XMD
+3 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
