MCARPCS3.m

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

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">SELECT(I<3:MCS(1),1:MCS(2)),U,$SELECT">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