source: FOIAVistA/tag/r/MEDICINE-MC/MCARPCS1.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 3.3 KB
Line 
1MCARPCS1 ;WISC/TJK-AUTO TRANSMIT PACEMAKER REPORT-LOAD 1 ;5/8/96 14:08
2 ;;2.3;Medicine;**5**;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
7DA F J=0:0 S J=$O(^MCAR(690,"AC",DFN,J)) Q:J="" I $D(^MCAR(690,"AC",DFN,J,MCDIC)) S MCV(I)=$O(^(MCDIC,0)) Q
8 Q
9BEGIN K ^TMP("MCAR","PACE",$J),MCV F I=698:.1:698.3 S MCV(I)="",MCDIC="MCAR("_I D DA
10 S MCG=MCV(698),MCVL=MCV(698.1),MCAL=MCV(698.2),MCS=MCV(698.3) K MCV
11SETDATA K ^TMP("MCAR","PACE",$J)
12 S $P(MCDSH,"-",81)=""
13 S $P(MCBL," ",81)=""
14 S MCLNCT=1,Z="PACEMAKER CENTER REPORT" D CENTER
15 S Z=^DD("SITE") D CENTER
16 K Z S MCLN=MCDSH D STORE1
17 S Z="REGISTRATION FORM DATA" D CENTER
18 K Z S MCLN=MCDSH D STORE1
19 S MCLN=MCBL D STORE1
20 G SETDATA2:'$D(MCR) S X=$O(MCR("")) S MCLN=" REASON(S) FOR REPORT: "_X D STORE1 F J=1:1 S X=$O(MCR(X)) Q:X="" S MCLN=" "_X D STORE1
21 S MCLN=MCBL D STORE1
22SETDATA2 S MCLN="TELEPHONE FOLLOW-UP PROVIDED BY: ",X=""
23 S:$D(^MCAR(690,DFN,"P2")) X=$P(^("P2"),U,2),X=$S(X="E":"EASTERN PACEMAKER SURVEILLANCE CENTER",X="W":"WESTERN PACEMAKER SURVEILLANCE CENTER",X="L":"LOCAL VAMC",1:"")
24 S MCLN=MCLN_X D STORE1
25 S MCLN=MCBL D STORE1
26 ; -------------------
27 ; DOB = External Format of the patients Birthdate.
28 ; SEX = External Format of the patients sex.
29 ; -------------------
30 D DEM^VADPT S MCARNM=VADM(1),SSN=VADM(2),DOB=$P(VADM(3),U,2),SEX=$P(VADM(5),U,2) D KVAR^VADPT
31 F I=0,1,4 S MCG(I)=$S($D(^MCAR(698,MCG,I)):^(I),1:"")
32 S MCLN="SSN: "_$P(SSN,"^",2) D STORE1
33 S MCLN1=" NAME: "_MCARNM,MCLN2="PULSE GENERATOR" D STORE
34 S MCLN1="",MCLN2=$E(MCDSH,1,$L("PULSE GENERATOR")) D STORE
35 D ADD^VADPT S MCLN2=$P(MCG(0),U,4),MCLN2=$P($G(^MCAR(698.6,+MCLN2,0)),U),MCLN2="MFR: "_MCLN2,MCLN1=" "_VAPA(1) D STORE
36 S MCLN1=" "_VAPA(2),MCLN2=$P(MCG(0),U,3),MCLN2=$P($G(^MCAR(698.4,+MCLN2,0)),U),MCLN2="MODEL: "_MCLN2 D STORE
37 S MCLN1=" "_VAPA(3),MCLN2="S/N: "_$P(MCG(0),U,5) D STORE
38 S MCLN1=" "_VAPA(4)_", "_$P(VAPA(5),U,2)_" "_VAPA(6),Y=$P(MCG(0),U) X ^DD("DD") S MCLN2="DATE: "_$P(Y,"@") S MCTEL=VAPA(8) D KVAR^VADPT D STORE
39 S MCLN1=" DOB: "_DOB,MCLN2="BEGINNING OF LIFE MAGNET RATE: "_$P(MCG(4),U,2) D STORE
40 S MCLN1=" SEX: "_SEX,MCLN2="END OF LIFE MAGNET RATE: "_$P(MCG(4),U,6) D STORE
41 S MCLN1="TELEPHONES:",MCLN2="IMPLANTING HOSPITAL:" D STORE
42 ;S MCLN1="HOME: "_MCTEL,MCLN2="" S:$P(MCG(0),U,8) MCLN2=$P(MCG(0),U,8) S:$D(^DIC(4,MCLN2)) MCLN2=$P(^(MCLN2,0),U) D STORE
43 S MCLN1="HOME: "_MCTEL,MCLN2=$P($G(^DIC(4,+$P(MCG(0),U,8),0)),U) D STORE
44 K MCTEL S VAOA("A")=5 D OAD^VADPT S MCTEL=VAOA(8) D KVAR^VADPT
45 S (MCLN2,Y)="" S:$D(^MCAR(690,DFN,"P3")) Y=$P(^("P3"),U,6) I Y X ^DD("DD") S MCLN2=$P(Y,"@",1) K Y
46 S MCLN1="WORK: "_MCTEL,MCLN2="DATE OF INITIAL IMPLANT: "_MCLN2 D STORE
47 S MCLN=MCBL D STORE1
48 S MCLN1="RESPONSIBLE PHYSICIAN:" S Y=$P(MCG(0),U,14) X ^DD("DD") S MCLN2="LAST PREVIOUS IMPLANT: "_Y D STORE
49 N MCPHYS S DIC="^DPT(",DA=DFN,DIQ(0)="IE",DIQ="MCPHYS(",DR=.104 D EN^DIQ1
50 I $D(MCPHYS(2,DFN,.104,"I")) S MCPHYS=MCPHYS(2,DFN,.104,"I")_U_MCPHYS(2,DFN,.104,"E")
51 K DIC,DR,DA,MCPHYS(2),DIQ,^UTILITY("DIQ1",$J)
52 S MCLN1=$P($G(MCPHYS),U,2),MCLN2="PULSE GENERATORS INCLUDING PRESENT: "_$P(MCG(0),U,13) D STORE
53 S MCLN="PHONE: " I $G(MCPHYS) S MCLN=MCLN_$$GETVALUE^MCU(200,+MCPHYS,.131)
54 D STORE1
55 S MCLN=MCBL D STORE1
56 G ^MCARPCS2
Note: See TracBrowser for help on using the repository browser.