VistA-WorldVistAEHR/r/MEDICINE-MC/MCARPCS1.m

57 lines
3.3 KiB
Mathematica

MCARPCS1 ;WISC/TJK-AUTO TRANSMIT PACEMAKER REPORT-LOAD 1 ;5/8/96 14:08
;;2.3;Medicine;**5**;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
DA 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
Q
BEGIN K ^TMP("MCAR","PACE",$J),MCV F I=698:.1:698.3 S MCV(I)="",MCDIC="MCAR("_I D DA
S MCG=MCV(698),MCVL=MCV(698.1),MCAL=MCV(698.2),MCS=MCV(698.3) K MCV
SETDATA K ^TMP("MCAR","PACE",$J)
S $P(MCDSH,"-",81)=""
S $P(MCBL," ",81)=""
S MCLNCT=1,Z="PACEMAKER CENTER REPORT" D CENTER
S Z=^DD("SITE") D CENTER
K Z S MCLN=MCDSH D STORE1
S Z="REGISTRATION FORM DATA" D CENTER
K Z S MCLN=MCDSH D STORE1
S MCLN=MCBL D STORE1
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
S MCLN=MCBL D STORE1
SETDATA2 S MCLN="TELEPHONE FOLLOW-UP PROVIDED BY: ",X=""
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:"")
S MCLN=MCLN_X D STORE1
S MCLN=MCBL D STORE1
; -------------------
; DOB = External Format of the patients Birthdate.
; SEX = External Format of the patients sex.
; -------------------
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
F I=0,1,4 S MCG(I)=$S($D(^MCAR(698,MCG,I)):^(I),1:"")
S MCLN="SSN: "_$P(SSN,"^",2) D STORE1
S MCLN1=" NAME: "_MCARNM,MCLN2="PULSE GENERATOR" D STORE
S MCLN1="",MCLN2=$E(MCDSH,1,$L("PULSE GENERATOR")) D STORE
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
S MCLN1=" "_VAPA(2),MCLN2=$P(MCG(0),U,3),MCLN2=$P($G(^MCAR(698.4,+MCLN2,0)),U),MCLN2="MODEL: "_MCLN2 D STORE
S MCLN1=" "_VAPA(3),MCLN2="S/N: "_$P(MCG(0),U,5) D STORE
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
S MCLN1=" DOB: "_DOB,MCLN2="BEGINNING OF LIFE MAGNET RATE: "_$P(MCG(4),U,2) D STORE
S MCLN1=" SEX: "_SEX,MCLN2="END OF LIFE MAGNET RATE: "_$P(MCG(4),U,6) D STORE
S MCLN1="TELEPHONES:",MCLN2="IMPLANTING HOSPITAL:" D STORE
;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
S MCLN1="HOME: "_MCTEL,MCLN2=$P($G(^DIC(4,+$P(MCG(0),U,8),0)),U) D STORE
K MCTEL S VAOA("A")=5 D OAD^VADPT S MCTEL=VAOA(8) D KVAR^VADPT
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
S MCLN1="WORK: "_MCTEL,MCLN2="DATE OF INITIAL IMPLANT: "_MCLN2 D STORE
S MCLN=MCBL D STORE1
S MCLN1="RESPONSIBLE PHYSICIAN:" S Y=$P(MCG(0),U,14) X ^DD("DD") S MCLN2="LAST PREVIOUS IMPLANT: "_Y D STORE
N MCPHYS S DIC="^DPT(",DA=DFN,DIQ(0)="IE",DIQ="MCPHYS(",DR=.104 D EN^DIQ1
I $D(MCPHYS(2,DFN,.104,"I")) S MCPHYS=MCPHYS(2,DFN,.104,"I")_U_MCPHYS(2,DFN,.104,"E")
K DIC,DR,DA,MCPHYS(2),DIQ,^UTILITY("DIQ1",$J)
S MCLN1=$P($G(MCPHYS),U,2),MCLN2="PULSE GENERATORS INCLUDING PRESENT: "_$P(MCG(0),U,13) D STORE
S MCLN="PHONE: " I $G(MCPHYS) S MCLN=MCLN_$$GETVALUE^MCU(200,+MCPHYS,.131)
D STORE1
S MCLN=MCBL D STORE1
G ^MCARPCS2