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