source: FOIAVistA/tag/r/MEDICINE-MC/MCARPCS3.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1MCARPCS3 ;WISC/TJK-AUTO TRANSMIT PACEMAKER REPORT LOAD 3 ;5/3/96 15:16
2 ;;2.3;Medicine;;09/13/1996
3 G BEGIN
4STORE S MCLN=$E($P(MCLN1,U)_" ",1,40)_MCLN2
5STORE1 S ^TMP("MCAR","PACE",$J,MCLNCT)=MCLN,MCLNCT=MCLNCT+1 Q
6CENTER S MCLN=$E(MCBL,1,80-$L(Z)/2)_Z D STORE1 Q
7BEGIN F I=0,1,2 S MCS(I)=""
8 I MCS,$D(^MCAR(698.3,MCS,0)) S MCS(0)=^(0) S:$D(^(1)) MCS(1)=^(1) S:$D(^(2)) MCS(2)=^(2)
9 S MCLN1="SURVEILLANCE DATA",MCLN2="DATE: " S Y=$P(MCS(0),U) X ^DD("DD") S MCLN2=MCLN2_Y K Y D STORE
10 S MCLN=MCBL D STORE1 S Z="PROGRAMMED SETTINGS" D CENTER
11 S Z=$E(MCDSH,1,19) D CENTER K Z
12 S MCLN1=$E(MCBL,1,25)_"ATRIAL",MCLN2="VENTRICULAR" D STORE
13 S MCLN1=$E(MCBL,1,25)_$E(MCDSH,1,6),MCLN2=$E(MCDSH,1,11) D STORE
14 S MCLN1="PULSE WIDTH "_$P(MCS(1),U,8),MCLN2=$P(MCS(2),U,8) D STORE
15 S MCLN1="AMPLITUDE "_$P(MCS(1),U,9),MCLN2=$P(MCS(2),U,9) D STORE
16 S MCLN1="SENSITIVITY "_$P(MCS(1),U,10),MCLN2=$P(MCS(2),U,10) D STORE
17 S MCLN1="REFRACTORY PERIOD "_$P(MCS(1),U,11),MCLN2=$P(MCS(2),U,11) D STORE
18 S MCLN=MCBL D STORE1
19 S MCLN=$E(MCBL,1,22)_"LOWER RATE LIMIT: "_$P(MCS(0),U,15) D STORE1
20 S MCLN=$E(MCBL,1,22)_"UPPER RATE LIMIT: "_$P(MCS(0),U,16) D STORE1
21 S MCLN=$E(MCBL,1,29)_"A-V DELAY: "_$P(MCS(0),U,17) D STORE1
22 S MCLN=$E(MCBL,1,28)_"HYSTERESIS: "_$P(MCS(0),U,18) D STORE1
23 K ^UTILITY("DIQ1",$J),M S MCLN=$E(MCBL,1,27)_"PACING MODE: " I MCS S DIC="^MCAR(698.3,",DA=MCS,DR=54,DIQ(0)="E",DIQ="M(" D EN^DIQ1
24 S MCLN=MCLN_$S('$D(M):"",1:M(698.3,DA,54,"E")) K DIC,DR,DIQ,DA,M,^UTILITY("DIQ1",$J)
25 D STORE1 S MCLN=MCBL D STORE1 S Z="CLINIC MEASUREMENTS" D CENTER S Z=$E(MCDSH,1,19) D CENTER K Z
26 S MCLN1=$E(MCBL,1,25)_"ATRIAL",MCLN2="VENTRICULAR" D STORE
27 S MCLN1=$E(MCBL,1,25)_$E(MCDSH,1,6),MCLN2=$E(MCDSH,1,11) D STORE
28 S MCLN1="PULSE WIDTH "_$P(MCS(1),U),MCLN2=$P(MCS(2),U) D STORE
29 S MCLN1="AMPLITUDE "_$P(MCS(1),U,2),MCLN2=$P(MCS(2),U,2) D STORE
30 S MCLN1="RATIO (T/L) "_$P(MCS(1),U,3),MCLN2=$P(MCS(2),U,3) D STORE
31 S MCLN1="THRESHOLD WIDTH "_$P(MCS(1),U,4),MCLN2=$P(MCS(2),U,4) D STORE
32 S MCLN1="THRESHOLD AMPLITUDE "_$P(MCS(1),U,5),MCLN2=$P(MCS(2),U,5) D STORE
33 F I=1:1:4 S X=$P($S(I<3:MCS(1),1:MCS(2)),U,$S(I#2:6,1:7)),X=$S(X="Y":"YES",X="N":"NO",X="I":"INTERMITTENT",X["U":"UNKNOWN",X="NA":"NOT APPLICABLE",1:""),@("M"_I)=X
34 S MCLN1="CAPTURE "_M1,MCLN2=M3 D STORE
35 S MCLN1="SENSE "_M2,MCLN2=M4 D STORE K M1,M2,M3,M4
36 S M1=$P(MCS(0),U,7) I M1 S M1=60000/M1,M1=$J(M1,6,2)
37 S M2=$P(MCS(0),U,8) I M2 S M2=60000/M2,M2=$J(M2,6,2)
38 S MCLN1="RATE NO MAGNET: "_M1,MCLN2="A-V DELAY: "_$P(MCS(0),U,11) D STORE
39 S MCLN1="RATE MAGNET: "_M2,MCLN2="A-V DELAY: "_$P(MCS(0),U,12) D STORE
40 S MCLN1="BATTERY VOLTAGE:"_$P(MCS(0),U,13),MCLN2="RESISTANCE: "_$P(MCS(0),U,14) D STORE
41 S MCLN=MCBL D STORE1 S MCLN=MCDSH D STORE1 S Z="PART 3" D CENTER S MCLN=MCDSH D STORE1
42 S MCLN="PACING INDICATION (EKG)" D STORE1 S MCLN=$E(MCDSH,1,23) D STORE1
43 K M S DIQ="M(",DIC="^MCAR(690,",DR(690.07)=.01,DIQ(0)="E"
44 F K=0:0 S K=$O(^MCAR(690,DFN,"P",K)) Q:K'?1N.N S DA=DFN,DR=7,DA(690.07)=K D EN^DIQ1 S MCLN=M(690.07,K,.01,"E") D STORE1
45 S MCLN=MCBL D STORE1 S MCLN="PREVIOUS HISTORY AND RISK FACTORS:" D STORE1 S MCLN=$E(MCDSH,1,34) D STORE1
46 K DA,DR,M S DR(690.08)=.01 F K=0:0 S K=$O(^MCAR(690,DFN,"P1",K)) Q:K'?1N.N S DA=DFN,DR=8,DA(690.08)=K D EN^DIQ1 S MCLN=M(690.08,K,.01,"E") D STORE1
47 K M,DA,DR G ^MCARPCS4:'$D(^MCAR(690,DFN,"P3"))
48 S MCLN=MCBL D STORE1 S MCLN="INDICATION FOR FILE CLOSURE:" D STORE1 S MCLN=$E(MCDSH,1,28) D STORE1
49 K ^UTILITY("DIQ1",$J),M S DA=DFN,DR="10:14;18" D EN^DIQ1
50 F K=10:1:14,18 Q:'$D(M) I M(690,DFN,K,"E")'="" D SELECT S MCLN=MCLN_" "_M(690,DFN,K,"E") D STORE1
51 K DIC,DR,DA,M G ^MCARPCS4
52SELECT S MCLN=$S(K=10:"INDICATION FOR FILE CLOSURE:",K=11:"CAUSE OF DEATH:",K=12:"SUDDENESS OF DEATH:",K=13:"DATE OF FILE CLOSURE:",K=14:"DISCHARGE (PACEMAKER) REASON:",1:"REASON FOR FILE CLOSURE:") Q
Note: See TracBrowser for help on using the repository browser.