MCARPCS2 ;WISC/TJK-AUTO TRANSMIT PACEMAKER REPORT-LOAD 2 ;6/29/92 15:15
;;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 ;
S MCLN1=" ATRIAL LEAD",MCLN2="VENTRICULAR LEAD" D STORE
S MCLN1=$E(MCBL,1,13)_$E(MCDSH,1,$L("ATRIAL LEAD")),MCLN2=$E(MCDSH,1,$L("VENTRICULAR LEAD")) D STORE
S (MCAL(0),MCVL(0))="" I MCAL S:$D(^MCAR(698.2,MCAL,0)) MCAL(0)=^(0)
I MCVL S:$D(^MCAR(698.1,MCVL,0)) MCVL(0)=^(0)
S (MA,MV)="" S MA=$P(MCAL(0),U,4) I MA,$D(^MCAR(698.6,MA,0)) S MA=$P(^(0),U)
S MV=$P(MCVL(0),U,4) S MV=$P(MCVL(0),U,4) I MV,$D(^MCAR(698.6,MV,0)) S MV=$P(^(0),U)
S MCLN1="MANUFACTURER: "_MA,MCLN2=MV D STORE
S (MA,MV)="" S MA=$P(MCAL(0),U,3) I MA,$D(^MCAR(698.4,MA,0)) S MA=$P(^(0),U)
S MV=$P(MCVL(0),U,3) I MV,$D(^MCAR(698.4,MV,0)) S MV=$P(^(0),U)
S MCLN1="MODEL #: "_MA,MCLN2=MV D STORE
K MA,MV S MCLN1="SERIAL #: "_$P(MCAL(0),U,5),MCLN2=$P(MCVL(0),U,5) D STORE
S MCLN1="DATE: ",MCLN2=""
I MCAL S Y=+MCAL(0) I Y X ^DD("DD") S MCLN1=MCLN1_$P(Y,"@")
I MCVL S Y=+MCVL(0) I Y X ^DD("DD") S MCLN2=$P(Y,"@")
D STORE
S MCLN=MCBL D STORE1 S MCLN=MCDSH D STORE1 S Z="PART 2" D CENTER K Z
S MCLN=MCDSH D STORE1
S VAOA("A")=1 D OAD^VADPT
S MCLN1="ALTERNATE CONTACT",MCLN2="ALTERNATE CONTACT ADDRESS" D STORE
S MCLN1=$E(MCDSH,1,$L("ALTERNATE CONTACT")),MCLN2=MCLN1_$E(MCDSH,1,8) D STORE
S MCLN1=VAOA(9),MCLN2=VAOA(1) D STORE
S MCLN1="RELATIONSHIP: "_VAOA(10),MCLAST=VAOA(4)_" ,"_$P(VAOA(5),U,2)_" "_VAOA(6)
S MCLN2=$S(VAOA(2)'="":VAOA(2),1:MCLAST) K:MCLN2=MCLAST MCLAST
D STORE
S MCLN1="TELEPHONE: "_VAOA(8),MCLN2=$S(VAOA(3)'="":VAOA(3),$D(MCLAST):MCLAST,1:"") I $D(MCLAST),MCLN2=MCLAST K MCLAST
D STORE,KVAR^VADPT
S MCLN1="",MCLN2=$S($D(MCLAST):MCLAST,1:"") D:MCLN2'="" STORE
S MCLN=MCBL D STORE1 S MCLN="TELEPHONE TRANSMITTER:" D STORE1
S MCLN1="MANUFACTURER: ",MCLN2="MODEL #: "
S MCTR=$P(MCG(1),U,4) I MCTR,$D(^MCAR(698.6,MCTR,0)) S MCTR=^(0),MCLN1=MCLN1_MCTR
S MCTR=$P(MCG(1),U,3) I MCTR,$D(^MCAR(698.4,MCTR,0)) S MCTR=$P(^(0),U),MCLN2=MCLN2_MCTR
D STORE K MCTR S MCLN=MCBL D STORE1
S MCLN1="IMPLANT PARAMETERS: ATRIAL LEAD",MCLN2="VENTRICULAR LEAD" D STORE
S MCLN1=$E(MCDSH,1,19)_$E(MCBL,1,3)_$E(MCDSH,1,11),MCLN2=$E(MCDSH,1,16) D STORE
S MCLN1="THRESHOLD IN VOLTS "_$P(MCAL(0),U,6),MCLN2=$P(MCVL(0),U,6) D STORE
S MCLN="THRESHOLD IN MAs" D STORE1
S MCLN1=" AT .5 MS PW "_$P(MCAL(0),U,7),MCLN2=$P(MCVL(0),U,7) D STORE
S MCLN1="RESISTANCE AT 5 VOLTS "_$P(MCAL(0),U,8),MCLN2=$P(MCVL(0),U,8) D STORE
S MCLN="R-WAVE OR P-WAVE" D STORE1
S MCLN1=" AMPLITUDE (MV) "_$P(MCAL(0),U,9),MCLN2=$P(MCVL(0),U,9) D STORE
S MCLN1="PSA USED: ",MCLN2=""
S M=$P(MCAL(0),U,10) I M,$D(^MCAR(698.4,M,0)) S MCLN1=MCLN1_$P(^(0),U)
S M=$P(MCVL(0),U,10) I M,$D(^MCAR(698.4,M,0)) S MCLN2=$P(^(0),U)
K M D STORE S MCLN=MCBL D STORE1
G ^MCARPCS3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARPCS2 3065 printed Nov 22, 2024@17:24:25 Page 2
MCARPCS2 ;WISC/TJK-AUTO TRANSMIT PACEMAKER REPORT-LOAD 2 ;6/29/92 15:15
+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 ;
+1 SET MCLN1=" ATRIAL LEAD"
SET MCLN2="VENTRICULAR LEAD"
DO STORE
+2 SET MCLN1=$EXTRACT(MCBL,1,13)_$EXTRACT(MCDSH,1,$LENGTH("ATRIAL LEAD"))
SET MCLN2=$EXTRACT(MCDSH,1,$LENGTH("VENTRICULAR LEAD"))
DO STORE
+3 SET (MCAL(0),MCVL(0))=""
IF MCAL
if $DATA(^MCAR(698.2,MCAL,0))
SET MCAL(0)=^(0)
+4 IF MCVL
if $DATA(^MCAR(698.1,MCVL,0))
SET MCVL(0)=^(0)
+5 SET (MA,MV)=""
SET MA=$PIECE(MCAL(0),U,4)
IF MA
IF $DATA(^MCAR(698.6,MA,0))
SET MA=$PIECE(^(0),U)
+6 SET MV=$PIECE(MCVL(0),U,4)
SET MV=$PIECE(MCVL(0),U,4)
IF MV
IF $DATA(^MCAR(698.6,MV,0))
SET MV=$PIECE(^(0),U)
+7 SET MCLN1="MANUFACTURER: "_MA
SET MCLN2=MV
DO STORE
+8 SET (MA,MV)=""
SET MA=$PIECE(MCAL(0),U,3)
IF MA
IF $DATA(^MCAR(698.4,MA,0))
SET MA=$PIECE(^(0),U)
+9 SET MV=$PIECE(MCVL(0),U,3)
IF MV
IF $DATA(^MCAR(698.4,MV,0))
SET MV=$PIECE(^(0),U)
+10 SET MCLN1="MODEL #: "_MA
SET MCLN2=MV
DO STORE
+11 KILL MA,MV
SET MCLN1="SERIAL #: "_$PIECE(MCAL(0),U,5)
SET MCLN2=$PIECE(MCVL(0),U,5)
DO STORE
+12 SET MCLN1="DATE: "
SET MCLN2=""
+13 IF MCAL
SET Y=+MCAL(0)
IF Y
XECUTE ^DD("DD")
SET MCLN1=MCLN1_$PIECE(Y,"@")
+14 IF MCVL
SET Y=+MCVL(0)
IF Y
XECUTE ^DD("DD")
SET MCLN2=$PIECE(Y,"@")
+15 DO STORE
+16 SET MCLN=MCBL
DO STORE1
SET MCLN=MCDSH
DO STORE1
SET Z="PART 2"
DO CENTER
KILL Z
+17 SET MCLN=MCDSH
DO STORE1
+18 SET VAOA("A")=1
DO OAD^VADPT
+19 SET MCLN1="ALTERNATE CONTACT"
SET MCLN2="ALTERNATE CONTACT ADDRESS"
DO STORE
+20 SET MCLN1=$EXTRACT(MCDSH,1,$LENGTH("ALTERNATE CONTACT"))
SET MCLN2=MCLN1_$EXTRACT(MCDSH,1,8)
DO STORE
+21 SET MCLN1=VAOA(9)
SET MCLN2=VAOA(1)
DO STORE
+22 SET MCLN1="RELATIONSHIP: "_VAOA(10)
SET MCLAST=VAOA(4)_" ,"_$PIECE(VAOA(5),U,2)_" "_VAOA(6)
+23 SET MCLN2=$SELECT(VAOA(2)'="":VAOA(2),1:MCLAST)
if MCLN2=MCLAST
KILL MCLAST
+24 DO STORE
+25 SET MCLN1="TELEPHONE: "_VAOA(8)
SET MCLN2=$SELECT(VAOA(3)'="":VAOA(3),$DATA(MCLAST):MCLAST,1:"")
IF $DATA(MCLAST)
IF MCLN2=MCLAST
KILL MCLAST
+26 DO STORE
DO KVAR^VADPT
+27 SET MCLN1=""
SET MCLN2=$SELECT($DATA(MCLAST):MCLAST,1:"")
if MCLN2'=""
DO STORE
+28 SET MCLN=MCBL
DO STORE1
SET MCLN="TELEPHONE TRANSMITTER:"
DO STORE1
+29 SET MCLN1="MANUFACTURER: "
SET MCLN2="MODEL #: "
+30 SET MCTR=$PIECE(MCG(1),U,4)
IF MCTR
IF $DATA(^MCAR(698.6,MCTR,0))
SET MCTR=^(0)
SET MCLN1=MCLN1_MCTR
+31 SET MCTR=$PIECE(MCG(1),U,3)
IF MCTR
IF $DATA(^MCAR(698.4,MCTR,0))
SET MCTR=$PIECE(^(0),U)
SET MCLN2=MCLN2_MCTR
+32 DO STORE
KILL MCTR
SET MCLN=MCBL
DO STORE1
+33 SET MCLN1="IMPLANT PARAMETERS: ATRIAL LEAD"
SET MCLN2="VENTRICULAR LEAD"
DO STORE
+34 SET MCLN1=$EXTRACT(MCDSH,1,19)_$EXTRACT(MCBL,1,3)_$EXTRACT(MCDSH,1,11)
SET MCLN2=$EXTRACT(MCDSH,1,16)
DO STORE
+35 SET MCLN1="THRESHOLD IN VOLTS "_$PIECE(MCAL(0),U,6)
SET MCLN2=$PIECE(MCVL(0),U,6)
DO STORE
+36 SET MCLN="THRESHOLD IN MAs"
DO STORE1
+37 SET MCLN1=" AT .5 MS PW "_$PIECE(MCAL(0),U,7)
SET MCLN2=$PIECE(MCVL(0),U,7)
DO STORE
+38 SET MCLN1="RESISTANCE AT 5 VOLTS "_$PIECE(MCAL(0),U,8)
SET MCLN2=$PIECE(MCVL(0),U,8)
DO STORE
+39 SET MCLN="R-WAVE OR P-WAVE"
DO STORE1
+40 SET MCLN1=" AMPLITUDE (MV) "_$PIECE(MCAL(0),U,9)
SET MCLN2=$PIECE(MCVL(0),U,9)
DO STORE
+41 SET MCLN1="PSA USED: "
SET MCLN2=""
+42 SET M=$PIECE(MCAL(0),U,10)
IF M
IF $DATA(^MCAR(698.4,M,0))
SET MCLN1=MCLN1_$PIECE(^(0),U)
+43 SET M=$PIECE(MCVL(0),U,10)
IF M
IF $DATA(^MCAR(698.4,M,0))
SET MCLN2=$PIECE(^(0),U)
+44 KILL M
DO STORE
SET MCLN=MCBL
DO STORE1
+45 GOTO ^MCARPCS3
