- 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
- 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
