MCARPCS3 ;WISC/TJK-AUTO TRANSMIT PACEMAKER REPORT LOAD 3 ;5/3/96 15:16
;;2.3;Medicine;;09/13/1996
G BEGIN
STORE S MCLN=$E($P(MCLN1,U)_" ",1,40)_MCLN2
STORE1 S ^TMP("MCAR","PACE",$J,MCLNCT)=MCLN,MCLNCT=MCLNCT+1 Q
CENTER S MCLN=$E(MCBL,1,80-$L(Z)/2)_Z D STORE1 Q
BEGIN F I=0,1,2 S MCS(I)=""
I MCS,$D(^MCAR(698.3,MCS,0)) S MCS(0)=^(0) S:$D(^(1)) MCS(1)=^(1) S:$D(^(2)) MCS(2)=^(2)
S MCLN1="SURVEILLANCE DATA",MCLN2="DATE: " S Y=$P(MCS(0),U) X ^DD("DD") S MCLN2=MCLN2_Y K Y D STORE
S MCLN=MCBL D STORE1 S Z="PROGRAMMED SETTINGS" D CENTER
S Z=$E(MCDSH,1,19) D CENTER K Z
S MCLN1=$E(MCBL,1,25)_"ATRIAL",MCLN2="VENTRICULAR" D STORE
S MCLN1=$E(MCBL,1,25)_$E(MCDSH,1,6),MCLN2=$E(MCDSH,1,11) D STORE
S MCLN1="PULSE WIDTH "_$P(MCS(1),U,8),MCLN2=$P(MCS(2),U,8) D STORE
S MCLN1="AMPLITUDE "_$P(MCS(1),U,9),MCLN2=$P(MCS(2),U,9) D STORE
S MCLN1="SENSITIVITY "_$P(MCS(1),U,10),MCLN2=$P(MCS(2),U,10) D STORE
S MCLN1="REFRACTORY PERIOD "_$P(MCS(1),U,11),MCLN2=$P(MCS(2),U,11) D STORE
S MCLN=MCBL D STORE1
S MCLN=$E(MCBL,1,22)_"LOWER RATE LIMIT: "_$P(MCS(0),U,15) D STORE1
S MCLN=$E(MCBL,1,22)_"UPPER RATE LIMIT: "_$P(MCS(0),U,16) D STORE1
S MCLN=$E(MCBL,1,29)_"A-V DELAY: "_$P(MCS(0),U,17) D STORE1
S MCLN=$E(MCBL,1,28)_"HYSTERESIS: "_$P(MCS(0),U,18) D STORE1
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
S MCLN=MCLN_$S('$D(M):"",1:M(698.3,DA,54,"E")) K DIC,DR,DIQ,DA,M,^UTILITY("DIQ1",$J)
D STORE1 S MCLN=MCBL D STORE1 S Z="CLINIC MEASUREMENTS" D CENTER S Z=$E(MCDSH,1,19) D CENTER K Z
S MCLN1=$E(MCBL,1,25)_"ATRIAL",MCLN2="VENTRICULAR" D STORE
S MCLN1=$E(MCBL,1,25)_$E(MCDSH,1,6),MCLN2=$E(MCDSH,1,11) D STORE
S MCLN1="PULSE WIDTH "_$P(MCS(1),U),MCLN2=$P(MCS(2),U) D STORE
S MCLN1="AMPLITUDE "_$P(MCS(1),U,2),MCLN2=$P(MCS(2),U,2) D STORE
S MCLN1="RATIO (T/L) "_$P(MCS(1),U,3),MCLN2=$P(MCS(2),U,3) D STORE
S MCLN1="THRESHOLD WIDTH "_$P(MCS(1),U,4),MCLN2=$P(MCS(2),U,4) D STORE
S MCLN1="THRESHOLD AMPLITUDE "_$P(MCS(1),U,5),MCLN2=$P(MCS(2),U,5) D STORE
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
S MCLN1="CAPTURE "_M1,MCLN2=M3 D STORE
S MCLN1="SENSE "_M2,MCLN2=M4 D STORE K M1,M2,M3,M4
S M1=$P(MCS(0),U,7) I M1 S M1=60000/M1,M1=$J(M1,6,2)
S M2=$P(MCS(0),U,8) I M2 S M2=60000/M2,M2=$J(M2,6,2)
S MCLN1="RATE NO MAGNET: "_M1,MCLN2="A-V DELAY: "_$P(MCS(0),U,11) D STORE
S MCLN1="RATE MAGNET: "_M2,MCLN2="A-V DELAY: "_$P(MCS(0),U,12) D STORE
S MCLN1="BATTERY VOLTAGE:"_$P(MCS(0),U,13),MCLN2="RESISTANCE: "_$P(MCS(0),U,14) D STORE
S MCLN=MCBL D STORE1 S MCLN=MCDSH D STORE1 S Z="PART 3" D CENTER S MCLN=MCDSH D STORE1
S MCLN="PACING INDICATION (EKG)" D STORE1 S MCLN=$E(MCDSH,1,23) D STORE1
K M S DIQ="M(",DIC="^MCAR(690,",DR(690.07)=.01,DIQ(0)="E"
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
S MCLN=MCBL D STORE1 S MCLN="PREVIOUS HISTORY AND RISK FACTORS:" D STORE1 S MCLN=$E(MCDSH,1,34) D STORE1
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
K M,DA,DR G ^MCARPCS4:'$D(^MCAR(690,DFN,"P3"))
S MCLN=MCBL D STORE1 S MCLN="INDICATION FOR FILE CLOSURE:" D STORE1 S MCLN=$E(MCDSH,1,28) D STORE1
K ^UTILITY("DIQ1",$J),M S DA=DFN,DR="10:14;18" D EN^DIQ1
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
K DIC,DR,DA,M G ^MCARPCS4
SELECT 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARPCS3 4000 printed Dec 13, 2024@02:14:25 Page 2
MCARPCS3 ;WISC/TJK-AUTO TRANSMIT PACEMAKER REPORT LOAD 3 ;5/3/96 15:16
+1 ;;2.3;Medicine;;09/13/1996
+2 GOTO BEGIN
STORE SET MCLN=$EXTRACT($PIECE(MCLN1,U)_" ",1,40)_MCLN2
STORE1 SET ^TMP("MCAR","PACE",$JOB,MCLNCT)=MCLN
SET MCLNCT=MCLNCT+1
QUIT
CENTER SET MCLN=$EXTRACT(MCBL,1,80-$LENGTH(Z)/2)_Z
DO STORE1
QUIT
BEGIN FOR I=0,1,2
SET MCS(I)=""
+1 IF MCS
IF $DATA(^MCAR(698.3,MCS,0))
SET MCS(0)=^(0)
if $DATA(^(1))
SET MCS(1)=^(1)
if $DATA(^(2))
SET MCS(2)=^(2)
+2 SET MCLN1="SURVEILLANCE DATA"
SET MCLN2="DATE: "
SET Y=$PIECE(MCS(0),U)
XECUTE ^DD("DD")
SET MCLN2=MCLN2_Y
KILL Y
DO STORE
+3 SET MCLN=MCBL
DO STORE1
SET Z="PROGRAMMED SETTINGS"
DO CENTER
+4 SET Z=$EXTRACT(MCDSH,1,19)
DO CENTER
KILL Z
+5 SET MCLN1=$EXTRACT(MCBL,1,25)_"ATRIAL"
SET MCLN2="VENTRICULAR"
DO STORE
+6 SET MCLN1=$EXTRACT(MCBL,1,25)_$EXTRACT(MCDSH,1,6)
SET MCLN2=$EXTRACT(MCDSH,1,11)
DO STORE
+7 SET MCLN1="PULSE WIDTH "_$PIECE(MCS(1),U,8)
SET MCLN2=$PIECE(MCS(2),U,8)
DO STORE
+8 SET MCLN1="AMPLITUDE "_$PIECE(MCS(1),U,9)
SET MCLN2=$PIECE(MCS(2),U,9)
DO STORE
+9 SET MCLN1="SENSITIVITY "_$PIECE(MCS(1),U,10)
SET MCLN2=$PIECE(MCS(2),U,10)
DO STORE
+10 SET MCLN1="REFRACTORY PERIOD "_$PIECE(MCS(1),U,11)
SET MCLN2=$PIECE(MCS(2),U,11)
DO STORE
+11 SET MCLN=MCBL
DO STORE1
+12 SET MCLN=$EXTRACT(MCBL,1,22)_"LOWER RATE LIMIT: "_$PIECE(MCS(0),U,15)
DO STORE1
+13 SET MCLN=$EXTRACT(MCBL,1,22)_"UPPER RATE LIMIT: "_$PIECE(MCS(0),U,16)
DO STORE1
+14 SET MCLN=$EXTRACT(MCBL,1,29)_"A-V DELAY: "_$PIECE(MCS(0),U,17)
DO STORE1
+15 SET MCLN=$EXTRACT(MCBL,1,28)_"HYSTERESIS: "_$PIECE(MCS(0),U,18)
DO STORE1
+16 KILL ^UTILITY("DIQ1",$JOB),M
SET MCLN=$EXTRACT(MCBL,1,27)_"PACING MODE: "
IF MCS
SET DIC="^MCAR(698.3,"
SET DA=MCS
SET DR=54
SET DIQ(0)="E"
SET DIQ="M("
DO EN^DIQ1
+17 SET MCLN=MCLN_$SELECT('$DATA(M):"",1:M(698.3,DA,54,"E"))
KILL DIC,DR,DIQ,DA,M,^UTILITY("DIQ1",$JOB)
+18 DO STORE1
SET MCLN=MCBL
DO STORE1
SET Z="CLINIC MEASUREMENTS"
DO CENTER
SET Z=$EXTRACT(MCDSH,1,19)
DO CENTER
KILL Z
+19 SET MCLN1=$EXTRACT(MCBL,1,25)_"ATRIAL"
SET MCLN2="VENTRICULAR"
DO STORE
+20 SET MCLN1=$EXTRACT(MCBL,1,25)_$EXTRACT(MCDSH,1,6)
SET MCLN2=$EXTRACT(MCDSH,1,11)
DO STORE
+21 SET MCLN1="PULSE WIDTH "_$PIECE(MCS(1),U)
SET MCLN2=$PIECE(MCS(2),U)
DO STORE
+22 SET MCLN1="AMPLITUDE "_$PIECE(MCS(1),U,2)
SET MCLN2=$PIECE(MCS(2),U,2)
DO STORE
+23 SET MCLN1="RATIO (T/L) "_$PIECE(MCS(1),U,3)
SET MCLN2=$PIECE(MCS(2),U,3)
DO STORE
+24 SET MCLN1="THRESHOLD WIDTH "_$PIECE(MCS(1),U,4)
SET MCLN2=$PIECE(MCS(2),U,4)
DO STORE
+25 SET MCLN1="THRESHOLD AMPLITUDE "_$PIECE(MCS(1),U,5)
SET MCLN2=$PIECE(MCS(2),U,5)
DO STORE
+26 FOR I=1:1:4
SET X=$PIECE($SELECT(I<3:MCS(1),1:MCS(2)),U,$SELECT(I#2:6,1:7))
SET X=$SELECT(X="Y":"YES",X="N":"NO",X="I":"INTERMITTENT",X["U":"UNKNOWN",X="NA":"NOT APPLICABLE",1:"")
SET @("M"_I)=X
+27 SET MCLN1="CAPTURE "_M1
SET MCLN2=M3
DO STORE
+28 SET MCLN1="SENSE "_M2
SET MCLN2=M4
DO STORE
KILL M1,M2,M3,M4
+29 SET M1=$PIECE(MCS(0),U,7)
IF M1
SET M1=60000/M1
SET M1=$JUSTIFY(M1,6,2)
+30 SET M2=$PIECE(MCS(0),U,8)
IF M2
SET M2=60000/M2
SET M2=$JUSTIFY(M2,6,2)
+31 SET MCLN1="RATE NO MAGNET: "_M1
SET MCLN2="A-V DELAY: "_$PIECE(MCS(0),U,11)
DO STORE
+32 SET MCLN1="RATE MAGNET: "_M2
SET MCLN2="A-V DELAY: "_$PIECE(MCS(0),U,12)
DO STORE
+33 SET MCLN1="BATTERY VOLTAGE:"_$PIECE(MCS(0),U,13)
SET MCLN2="RESISTANCE: "_$PIECE(MCS(0),U,14)
DO STORE
+34 SET MCLN=MCBL
DO STORE1
SET MCLN=MCDSH
DO STORE1
SET Z="PART 3"
DO CENTER
SET MCLN=MCDSH
DO STORE1
+35 SET MCLN="PACING INDICATION (EKG)"
DO STORE1
SET MCLN=$EXTRACT(MCDSH,1,23)
DO STORE1
+36 KILL M
SET DIQ="M("
SET DIC="^MCAR(690,"
SET DR(690.07)=.01
SET DIQ(0)="E"
+37 FOR K=0:0
SET K=$ORDER(^MCAR(690,DFN,"P",K))
if K'?1N.N
QUIT
SET DA=DFN
SET DR=7
SET DA(690.07)=K
DO EN^DIQ1
SET MCLN=M(690.07,K,.01,"E")
DO STORE1
+38 SET MCLN=MCBL
DO STORE1
SET MCLN="PREVIOUS HISTORY AND RISK FACTORS:"
DO STORE1
SET MCLN=$EXTRACT(MCDSH,1,34)
DO STORE1
+39 KILL DA,DR,M
SET DR(690.08)=.01
FOR K=0:0
SET K=$ORDER(^MCAR(690,DFN,"P1",K))
if K'?1N.N
QUIT
SET DA=DFN
SET DR=8
SET DA(690.08)=K
DO EN^DIQ1
SET MCLN=M(690.08,K,.01,"E")
DO STORE1
+40 KILL M,DA,DR
if '$DATA(^MCAR(690,DFN,"P3"))
GOTO ^MCARPCS4
+41 SET MCLN=MCBL
DO STORE1
SET MCLN="INDICATION FOR FILE CLOSURE:"
DO STORE1
SET MCLN=$EXTRACT(MCDSH,1,28)
DO STORE1
+42 KILL ^UTILITY("DIQ1",$JOB),M
SET DA=DFN
SET DR="10:14;18"
DO EN^DIQ1
+43 FOR K=10:1:14,18
if '$DATA(M)
QUIT
IF M(690,DFN,K,"E")'=""
DO SELECT
SET MCLN=MCLN_" "_M(690,DFN,K,"E")
DO STORE1
+44 KILL DIC,DR,DA,M
GOTO ^MCARPCS4
SELECT SET MCLN=$SELECT(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:")
QUIT
