| 1 | HBHCXMT ; LR VAMC(IRMS)/MJT-HBHC create mail msgs (100 recs/125 char ea, max) from HBHC(634 file, transmit/Austin, set batch initial MM msg # & MM msg date in HBHC(631/632, set Last MM Date in HBHC(631.9, optionally prt rpt ;9803
|
---|
| 2 | ;;1.0;HOSPITAL BASED HOME CARE;**2,3,6,8,10,13**;NOV 01, 1993
|
---|
| 3 | I $P(^HBHC(631.9,1,0),U,8)]"" W *7,!,"File Update in progress. Please try again later." H 3 Q
|
---|
| 4 | 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
|
---|
| 5 | I '$D(^HBHC(634,"B")) W *7,!!,"No data on file to transmit." H 3 Q
|
---|
| 6 | I ('$D(^HBHC(631,"AE","F")))&('$D(^HBHC(631,"AF","F")))&('$D(^HBHC(632,"AC","F")))!($P(^HBHC(631.9,1,0),U,6)]"") W *7,!!,"Data on file has been transmitted to Austin; duplicate transmission not allowed." H 3 Q
|
---|
| 7 | 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
|
---|
| 8 | S ZTRTN="DQ^HBHCXMT",ZTIO="",ZTDTH=$H,ZTDESC="HBPC Transmission",ZTSAVE("HBHC*")="" D ^%ZTLOAD,^%ZISC
|
---|
| 9 | W *7,!!,"Transmission request has been queued. Task number: ",ZTSK,!! H 3
|
---|
| 10 | G EXIT
|
---|
| 11 | DQ ; De-queue
|
---|
| 12 | ; Kill task node to prevent possibility of duplicate transmission
|
---|
| 13 | K ^%ZTSK(ZTSK)
|
---|
| 14 | ; Set Transmission in Progress Flag
|
---|
| 15 | S $P(^HBHC(631.9,1,0),U,6)=1
|
---|
| 16 | K XMZ,%DT,^TMP("HBHC",$J)
|
---|
| 17 | S X="T" D ^%DT S HBHCDT=Y,HBHCDATE=$E(HBHCDT,4,5)_"/"_$E(HBHCDT,6,7)_"/"_$E(HBHCDT,2,3)
|
---|
| 18 | S (HBHCCNT,HBHCFLG,HBHCNODE)=0,HBHCMSG=1
|
---|
| 19 | 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
|
---|
| 20 | CLEANUP ; Cleanup Transmit History (HBHC(634.6)) to maintain maximum of last 12 transmit batches
|
---|
| 21 | 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
|
---|
| 22 | I HBHCTOT>12 S DIK="^HBHC(634.6,",DA="" F S DA=$O(^HBHC(634.6,"C",HBHCDAT,DA)) Q:DA'>0 D ^DIK
|
---|
| 23 | ; Turn Off Transmission in Progress Flag
|
---|
| 24 | S $P(^HBHC(631.9,1,0),U,6)=""
|
---|
| 25 | PRINT ; Print Transmit Report if default printer exists in 631.9
|
---|
| 26 | ; HBHCIOP set in PROMPT2^HBHCR15B
|
---|
| 27 | 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
|
---|
| 28 | EXIT ; Exit module
|
---|
| 29 | K DA,DIC,DIE,DIK,DR,HBHCCNT,HBHCDAT,HBHCDATE,HBHCDT,HBHCFLG,HBHCINFO,HBHCMSG,HBHCNODE,HBHCPRTR,HBHCTOT,HBHCZ,XMSUB,XMTEXT,XMY,XMZ,X,Y,%,%DT,^TMP("HBHC",$J)
|
---|
| 30 | Q
|
---|
| 31 | MAIL ; Send mail message
|
---|
| 32 | 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.VA.GOV")=""
|
---|
| 33 | D ^XMD
|
---|
| 34 | S HBHCMSG=HBHCMSG+1,HBHCCNT=0
|
---|
| 35 | 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)
|
---|
| 36 | Q:HBHCFLG
|
---|
| 37 | S DIE="^HBHC(631,"
|
---|
| 38 | 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
|
---|
| 39 | 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
|
---|
| 40 | 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
|
---|
| 41 | ; Set Last Mail Message Date in System Parameters file
|
---|
| 42 | S $P(^HBHC(631.9,1,0),U,2)=HBHCDT
|
---|
| 43 | S HBHCFLG=1
|
---|
| 44 | Q
|
---|
| 45 | HISTORY ; Update HBHC(634.6 Transmit History file
|
---|
| 46 | K DD,DO S DIC="^HBHC(634.6,",DIC(0)="L",DIC("DR")="1///^S X=HBHCDT",X=HBHCINFO D FILE^DICN
|
---|
| 47 | Q
|
---|