| 1 | MCARPCS4 ;WISC/TJK-AUTO TRANSMIT PACEMAKER REPORT LOAD 4 ;8/5/96 09:04
|
|---|
| 2 | ;;2.3;Medicine;;09/13/1996
|
|---|
| 3 | G BEGIN
|
|---|
| 4 | STORE S MCLN=$E($P(MCLN1,U)_" ",1,40)_MCLN2
|
|---|
| 5 | STORE1 S ^TMP("MCAR","PACE",$J,MCLNCT)=MCLN,MCLNCT=MCLNCT+1 Q
|
|---|
| 6 | BEGIN S MCLN=MCBL D STORE1 S MCLN="PACING FAILURE (EKG):" D STORE1 S MCLN=$E(MCDSH,1,21) D STORE1
|
|---|
| 7 | K DIC S DIC="^MCAR(698,",DR(698.093)=".01;1"
|
|---|
| 8 | F K=0:0 S K=$O(^MCAR(698,MCG,2,K)) Q:K'?1N.N S DA=MCG,DR=93,DA(698.093)=K D EN^DIQ1 S MCLN1=M(698.093,K,.01,"E"),MCLN2="DATE OF FAILURE: "_M(698.093,K,1,"E") D STORE
|
|---|
| 9 | K M,DA,DR S MCLN=MCBL D STORE1 S M=$P(MCG(1),U,2) I M,$D(^MCAR(695.8,M,0)) S MCLN="INDICATION FOR GENERATOR CHANGE: "_$P(^(0),U) D STORE1
|
|---|
| 10 | K M S DA=MCG,DR=19 D EN^DIQ1 S MCLN="IMPLANTATION ETIOLOGY: "_$S('$D(M):"",1:M(698,MCG,19,"E")) D STORE1
|
|---|
| 11 | G VLREASON:'MCAL,VLREASON:'$D(^MCAR(698.2,MCAL,1)),VLREASON:'$P(^(1),U,2)
|
|---|
| 12 | K M,DR,DA,DIC S DIC="^MCAR(698.2,",DA=MCAL,DR=57 D EN^DIQ1 S MCLN="INDICATION FOR ELECTRODE CHANGE (A-LEAD): "_$S('$D(M):"",1:M(698.2,MCAL,57,"E")) D STORE1
|
|---|
| 13 | VLREASON G REPRO:'MCVL,REPRO:'$D(^MCAR(698.1,MCVL,1)),REPRO:'$P(^(1),U,2)
|
|---|
| 14 | K M,DR,DA,DIC S DIC="^MCAR(698.1,",DA=MCVL,DR=57 D EN^DIQ1 S MCLN="INDICATION FOR ELECTRODE CHANGE (V-LEAD): "_$S('$D(M):"",1:M(698.1,MCVL,57,"E")) D STORE1
|
|---|
| 15 | REPRO K M,DR,DA,DIC G XMIT:'MCS,XMIT:'$P(MCS(0),U,20) S M=$P(MCS(0),U,20) I $D(^MCAR(695.8,M,0)) S M=$P(^(0),U),MCLN="REASON FOR REPROGRAMMING: "_M D STORE1
|
|---|
| 16 | XMIT S MCLN=MCDSH D STORE1
|
|---|
| 17 | K DIQ,DOB,I,J,K,M,M1,M2,MA,MCAL,MCARNM,MCBL,MCDIC,MCDSH
|
|---|
| 18 | K MCG,MCLAST,MCLN,MCLNCT,MCPHYS,MCR,MCTEL,MCTR,MCV,MCVL,MV
|
|---|
| 19 | K MCLN1,MCLN2,MCS,SEX,SSN,X,Y,Z
|
|---|
| 20 | S XMSUB="PACEMAKER CENTER REPORT",XMTEXT="^TMP(""MCAR"",""PACE"",$J,",XMDUZ=DUZ ;,XMY(DUZ)=""
|
|---|
| 21 | ; set up recipients - TEMPORARILY Eastern Pacemaker Center only
|
|---|
| 22 | S X="G.WASH PACEMAKER@PACE-WASH.VA.GOV" D WHO^XMA21
|
|---|
| 23 | ; I MCT'["E" S X="G.SF PACEMAKER@SANFRANCISCO.VA.GOV" D WHO^XMA21
|
|---|
| 24 | D ^XMD ; transmit the message
|
|---|
| 25 | D NOW^%DTC F I=1:1 Q:'$D(^MCAR(690,DFN,"P4",I))
|
|---|
| 26 | S ^MCAR(690,DFN,"P4",0)="^690.015^"_I_U_I,^(I,0)=%,^MCAR(690,DFN,"P4","B",%,I)=""
|
|---|
| 27 | K DFN,%T,%Y1,C,I,Y,%,%I,%H,^TMP("MCAR","PACE",$J),^UTILITY("DIQ1",$J) S:$D(ZTQUEUED) ZTREQ="@" K ZTSK Q
|
|---|
