- 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 Jan 18, 2025@02:59:55 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