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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARPCS1 3483 printed Apr 09, 2024@21:17:15 Page 2
MCARPCS1 ;WISC/TJK-AUTO TRANSMIT PACEMAKER REPORT-LOAD 1 ;5/8/96 14:08
+1 ;;2.3;Medicine;**5**;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
DA FOR J=0:0
SET J=$ORDER(^MCAR(690,"AC",DFN,J))
if J=""
QUIT
IF $DATA(^MCAR(690,"AC",DFN,J,MCDIC))
SET MCV(I)=$ORDER(^(MCDIC,0))
QUIT
+1 QUIT
BEGIN KILL ^TMP("MCAR","PACE",$JOB),MCV
FOR I=698:.1:698.3
SET MCV(I)=""
SET MCDIC="MCAR("_I
DO DA
+1 SET MCG=MCV(698)
SET MCVL=MCV(698.1)
SET MCAL=MCV(698.2)
SET MCS=MCV(698.3)
KILL MCV
SETDATA KILL ^TMP("MCAR","PACE",$JOB)
+1 SET $PIECE(MCDSH,"-",81)=""
+2 SET $PIECE(MCBL," ",81)=""
+3 SET MCLNCT=1
SET Z="PACEMAKER CENTER REPORT"
DO CENTER
+4 SET Z=^DD("SITE")
DO CENTER
+5 KILL Z
SET MCLN=MCDSH
DO STORE1
+6 SET Z="REGISTRATION FORM DATA"
DO CENTER
+7 KILL Z
SET MCLN=MCDSH
DO STORE1
+8 SET MCLN=MCBL
DO STORE1
+9 if '$DATA(MCR)
GOTO SETDATA2
SET X=$ORDER(MCR(""))
SET MCLN=" REASON(S) FOR REPORT: "_X
DO STORE1
FOR J=1:1
SET X=$ORDER(MCR(X))
if X=""
QUIT
SET MCLN=" "_X
DO STORE1
+10 SET MCLN=MCBL
DO STORE1
SETDATA2 SET MCLN="TELEPHONE FOLLOW-UP PROVIDED BY: "
SET X=""
+1 if $DATA(^MCAR(690,DFN,"P2"))
SET X=$PIECE(^("P2"),U,2)
SET X=$SELECT(X="E":"EASTERN PACEMAKER SURVEILLANCE CENTER",X="W":"WESTERN PACEMAKER SURVEILLANCE CENTER",X="L":"LOCAL VAMC",1:"")
+2 SET MCLN=MCLN_X
DO STORE1
+3 SET MCLN=MCBL
DO STORE1
+4 ; -------------------
+5 ; DOB = External Format of the patients Birthdate.
+6 ; SEX = External Format of the patients sex.
+7 ; -------------------
+8 DO DEM^VADPT
SET MCARNM=VADM(1)
SET SSN=VADM(2)
SET DOB=$PIECE(VADM(3),U,2)
SET SEX=$PIECE(VADM(5),U,2)
DO KVAR^VADPT
+9 FOR I=0,1,4
SET MCG(I)=$SELECT($DATA(^MCAR(698,MCG,I)):^(I),1:"")
+10 SET MCLN="SSN: "_$PIECE(SSN,"^",2)
DO STORE1
+11 SET MCLN1=" NAME: "_MCARNM
SET MCLN2="PULSE GENERATOR"
DO STORE
+12 SET MCLN1=""
SET MCLN2=$EXTRACT(MCDSH,1,$LENGTH("PULSE GENERATOR"))
DO STORE
+13 DO ADD^VADPT
SET MCLN2=$PIECE(MCG(0),U,4)
SET MCLN2=$PIECE($GET(^MCAR(698.6,+MCLN2,0)),U)
SET MCLN2="MFR: "_MCLN2
SET MCLN1=" "_VAPA(1)
DO STORE
+14 SET MCLN1=" "_VAPA(2)
SET MCLN2=$PIECE(MCG(0),U,3)
SET MCLN2=$PIECE($GET(^MCAR(698.4,+MCLN2,0)),U)
SET MCLN2="MODEL: "_MCLN2
DO STORE
+15 SET MCLN1=" "_VAPA(3)
SET MCLN2="S/N: "_$PIECE(MCG(0),U,5)
DO STORE
+16 SET MCLN1=" "_VAPA(4)_", "_$PIECE(VAPA(5),U,2)_" "_VAPA(6)
SET Y=$PIECE(MCG(0),U)
XECUTE ^DD("DD")
SET MCLN2="DATE: "_$PIECE(Y,"@")
SET MCTEL=VAPA(8)
DO KVAR^VADPT
DO STORE
+17 SET MCLN1=" DOB: "_DOB
SET MCLN2="BEGINNING OF LIFE MAGNET RATE: "_$PIECE(MCG(4),U,2)
DO STORE
+18 SET MCLN1=" SEX: "_SEX
SET MCLN2="END OF LIFE MAGNET RATE: "_$PIECE(MCG(4),U,6)
DO STORE
+19 SET MCLN1="TELEPHONES:"
SET MCLN2="IMPLANTING HOSPITAL:"
DO STORE
+20 ;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
+21 SET MCLN1="HOME: "_MCTEL
SET MCLN2=$PIECE($GET(^DIC(4,+$PIECE(MCG(0),U,8),0)),U)
DO STORE
+22 KILL MCTEL
SET VAOA("A")=5
DO OAD^VADPT
SET MCTEL=VAOA(8)
DO KVAR^VADPT
+23 SET (MCLN2,Y)=""
if $DATA(^MCAR(690,DFN,"P3"))
SET Y=$PIECE(^("P3"),U,6)
IF Y
XECUTE ^DD("DD")
SET MCLN2=$PIECE(Y,"@",1)
KILL Y
+24 SET MCLN1="WORK: "_MCTEL
SET MCLN2="DATE OF INITIAL IMPLANT: "_MCLN2
DO STORE
+25 SET MCLN=MCBL
DO STORE1
+26 SET MCLN1="RESPONSIBLE PHYSICIAN:"
SET Y=$PIECE(MCG(0),U,14)
XECUTE ^DD("DD")
SET MCLN2="LAST PREVIOUS IMPLANT: "_Y
DO STORE
+27 NEW MCPHYS
SET DIC="^DPT("
SET DA=DFN
SET DIQ(0)="IE"
SET DIQ="MCPHYS("
SET DR=.104
DO EN^DIQ1
+28 IF $DATA(MCPHYS(2,DFN,.104,"I"))
SET MCPHYS=MCPHYS(2,DFN,.104,"I")_U_MCPHYS(2,DFN,.104,"E")
+29 KILL DIC,DR,DA,MCPHYS(2),DIQ,^UTILITY("DIQ1",$JOB)
+30 SET MCLN1=$PIECE($GET(MCPHYS),U,2)
SET MCLN2="PULSE GENERATORS INCLUDING PRESENT: "_$PIECE(MCG(0),U,13)
DO STORE
+31 SET MCLN="PHONE: "
IF $GET(MCPHYS)
SET MCLN=MCLN_$$GETVALUE^MCU(200,+MCPHYS,.131)
+32 DO STORE1
+33 SET MCLN=MCBL
DO STORE1
+34 GOTO ^MCARPCS2
