source: FOIAVistA/trunk/r/MEDICINE-MC/MCARPCS2.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1MCARPCS2 ;WISC/TJK-AUTO TRANSMIT PACEMAKER REPORT-LOAD 2 ;6/29/92 15:15
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 ;
8 S MCLN1=" ATRIAL LEAD",MCLN2="VENTRICULAR LEAD" D STORE
9 S MCLN1=$E(MCBL,1,13)_$E(MCDSH,1,$L("ATRIAL LEAD")),MCLN2=$E(MCDSH,1,$L("VENTRICULAR LEAD")) D STORE
10 S (MCAL(0),MCVL(0))="" I MCAL S:$D(^MCAR(698.2,MCAL,0)) MCAL(0)=^(0)
11 I MCVL S:$D(^MCAR(698.1,MCVL,0)) MCVL(0)=^(0)
12 S (MA,MV)="" S MA=$P(MCAL(0),U,4) I MA,$D(^MCAR(698.6,MA,0)) S MA=$P(^(0),U)
13 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)
14 S MCLN1="MANUFACTURER: "_MA,MCLN2=MV D STORE
15 S (MA,MV)="" S MA=$P(MCAL(0),U,3) I MA,$D(^MCAR(698.4,MA,0)) S MA=$P(^(0),U)
16 S MV=$P(MCVL(0),U,3) I MV,$D(^MCAR(698.4,MV,0)) S MV=$P(^(0),U)
17 S MCLN1="MODEL #: "_MA,MCLN2=MV D STORE
18 K MA,MV S MCLN1="SERIAL #: "_$P(MCAL(0),U,5),MCLN2=$P(MCVL(0),U,5) D STORE
19 S MCLN1="DATE: ",MCLN2=""
20 I MCAL S Y=+MCAL(0) I Y X ^DD("DD") S MCLN1=MCLN1_$P(Y,"@")
21 I MCVL S Y=+MCVL(0) I Y X ^DD("DD") S MCLN2=$P(Y,"@")
22 D STORE
23 S MCLN=MCBL D STORE1 S MCLN=MCDSH D STORE1 S Z="PART 2" D CENTER K Z
24 S MCLN=MCDSH D STORE1
25 S VAOA("A")=1 D OAD^VADPT
26 S MCLN1="ALTERNATE CONTACT",MCLN2="ALTERNATE CONTACT ADDRESS" D STORE
27 S MCLN1=$E(MCDSH,1,$L("ALTERNATE CONTACT")),MCLN2=MCLN1_$E(MCDSH,1,8) D STORE
28 S MCLN1=VAOA(9),MCLN2=VAOA(1) D STORE
29 S MCLN1="RELATIONSHIP: "_VAOA(10),MCLAST=VAOA(4)_" ,"_$P(VAOA(5),U,2)_" "_VAOA(6)
30 S MCLN2=$S(VAOA(2)'="":VAOA(2),1:MCLAST) K:MCLN2=MCLAST MCLAST
31 D STORE
32 S MCLN1="TELEPHONE: "_VAOA(8),MCLN2=$S(VAOA(3)'="":VAOA(3),$D(MCLAST):MCLAST,1:"") I $D(MCLAST),MCLN2=MCLAST K MCLAST
33 D STORE,KVAR^VADPT
34 S MCLN1="",MCLN2=$S($D(MCLAST):MCLAST,1:"") D:MCLN2'="" STORE
35 S MCLN=MCBL D STORE1 S MCLN="TELEPHONE TRANSMITTER:" D STORE1
36 S MCLN1="MANUFACTURER: ",MCLN2="MODEL #: "
37 S MCTR=$P(MCG(1),U,4) I MCTR,$D(^MCAR(698.6,MCTR,0)) S MCTR=^(0),MCLN1=MCLN1_MCTR
38 S MCTR=$P(MCG(1),U,3) I MCTR,$D(^MCAR(698.4,MCTR,0)) S MCTR=$P(^(0),U),MCLN2=MCLN2_MCTR
39 D STORE K MCTR S MCLN=MCBL D STORE1
40 S MCLN1="IMPLANT PARAMETERS: ATRIAL LEAD",MCLN2="VENTRICULAR LEAD" D STORE
41 S MCLN1=$E(MCDSH,1,19)_$E(MCBL,1,3)_$E(MCDSH,1,11),MCLN2=$E(MCDSH,1,16) D STORE
42 S MCLN1="THRESHOLD IN VOLTS "_$P(MCAL(0),U,6),MCLN2=$P(MCVL(0),U,6) D STORE
43 S MCLN="THRESHOLD IN MAs" D STORE1
44 S MCLN1=" AT .5 MS PW "_$P(MCAL(0),U,7),MCLN2=$P(MCVL(0),U,7) D STORE
45 S MCLN1="RESISTANCE AT 5 VOLTS "_$P(MCAL(0),U,8),MCLN2=$P(MCVL(0),U,8) D STORE
46 S MCLN="R-WAVE OR P-WAVE" D STORE1
47 S MCLN1=" AMPLITUDE (MV) "_$P(MCAL(0),U,9),MCLN2=$P(MCVL(0),U,9) D STORE
48 S MCLN1="PSA USED: ",MCLN2=""
49 S M=$P(MCAL(0),U,10) I M,$D(^MCAR(698.4,M,0)) S MCLN1=MCLN1_$P(^(0),U)
50 S M=$P(MCVL(0),U,10) I M,$D(^MCAR(698.4,M,0)) S MCLN2=$P(^(0),U)
51 K M D STORE S MCLN=MCBL D STORE1
52 G ^MCARPCS3
Note: See TracBrowser for help on using the repository browser.