| [613] | 1 | MCARPAL ;WISC/TJK-PACEMAKER ACTIVE PATIENT LIST ;5/7/96 13:35
|
|---|
| 2 | ;;2.3;Medicine;**16**;09/13/1996
|
|---|
| 3 | W @IOF,!!,"ACTIVE PATIENT LIST"
|
|---|
| 4 | W !! F I=1:1:80 W "*"
|
|---|
| 5 | W !,"*",?37,"NOTICE",?79,"*"
|
|---|
| 6 | W !,"*",?79,"*",!,"*",?10,"This report has been set up to print with a line length of 132",?79,"*",!,"*",?10,"characters. Select a device that uses a 132 character line length.",?79,"*"
|
|---|
| 7 | W !,"*",?79,"*",! F I=1:1:80 W "*"
|
|---|
| 8 | W !!,"<RETURN> to continue " R X:DTIME G EXIT:'$T,EXIT:X=U
|
|---|
| 9 | K IO("Q") S %ZIS="QM" D ^%ZIS G EXIT:POP
|
|---|
| 10 | I $D(IO("Q")) K IO("Q") S ZTRTN="CALC^MCARPAL",ZTDESC="PACEMAKER ACTIVE PATIENT LIST" D ^%ZTLOAD K ZTSK G EXIT
|
|---|
| 11 | U IO
|
|---|
| 12 | CALC K ^TMP($J) S DFN=""
|
|---|
| 13 | CALC1 S DFN=$O(^MCAR(698,"C",DFN)) G PRINT:DFN=""
|
|---|
| 14 | S MCAREG="" S:$D(^MCAR(690,DFN,"P2")) MCAREG=$P(^("P2"),U) G CALC1:'MCAREG
|
|---|
| 15 | G CALC1:(MCAREG=2)!(MCAREG=3)!(MCAREG=5)!(MCAREG=6)!(MCAREG=8)
|
|---|
| 16 | D DEM^VADPT S MCARNM=VADM(1),DOB=$P(VADM(3),U,2),SSN=VADM(2)
|
|---|
| 17 | F DIC=698,698.1,698.2 S:DIC'=698.2 CT=0 S MCARCD=$S(DIC=698:"G",1:"L") D LEAD
|
|---|
| 18 | S ^TMP($J,MCARNM,0)=MCAREG_U_DOB_U_SSN G CALC1
|
|---|
| 19 | PRINT S PG=0,LN="-------------------------------------" D HEAD S MCARNM=""
|
|---|
| 20 | PRINT1 S MCARNM=$O(^TMP($J,MCARNM)) G EXIT:MCARNM="" S X=^(MCARNM,0)
|
|---|
| 21 | S A="" I $Y>(IOSL-3) R:IOST'?1"P-".E !,"<RETURN> to Continue",A:DTIME G EXIT:A=U D HEAD
|
|---|
| 22 | W !!,MCARNM S Y=$P(X,U,3) W !,$E(Y,1,3),"-",$E(Y,4,5),"-",$E(Y,6,9)
|
|---|
| 23 | W ?17 S Y=$P(X,U,2) W Y
|
|---|
| 24 | S Y=$P(X,U) W ?29,$S(Y=1:"EAST PSC FOLLOW-UP",Y=4:"REGISTRY ONLY",Y=7:"WEST PSC FOLLOW-UP",1:"")
|
|---|
| 25 | S A="" F I=1:1 Q:'$D(^TMP($J,MCARNM,"G",I))&('$D(^TMP($J,MCARNM,"L",I))) D PR I $Y>(IOSL-3) R:IOST'?1"P-".E !,"<RETURN> to Continue",A:DTIME Q:A=U D HEAD
|
|---|
| 26 | G EXIT:A=U,PRINT1
|
|---|
| 27 | EXIT ;
|
|---|
| 28 | I IOST'?1"P-".E R !!,"PRESS RETURN TO CONTINUE",X:DTIME
|
|---|
| 29 | K A,CT,DFN,DIC,DOB,I,LN,MCARCD,MCAREG,MCARNM,PG,POP,SSN,X,Y,Z,VA,VADM
|
|---|
| 30 | W:IOST?1"P-".E @IOF D ^%ZISC Q
|
|---|
| 31 | LEAD F I=0:0 S I=$O(^MCAR(DIC,"C",DFN,I)) Q:I="" S CT=CT+1,Y=^MCAR(DIC,I,0),^TMP($J,MCARNM,MCARCD,CT)=$P(Y,U,1)_U_$P(Y,U,3)_U_$P(Y,U,4)_U_$P(Y,U,5)_$S(MCARCD="G":"",1:U_DIC)
|
|---|
| 32 | Q
|
|---|
| 33 | PR W:I>1 !
|
|---|
| 34 | I $D(^TMP($J,MCARNM,"G",I)) S X=^(I),Y=$P(X,U,1) W ?51,$E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3) D MANUF W ?60,Y,?64,Z,?77,$P(X,U,4)
|
|---|
| 35 | I $D(^TMP($J,MCARNM,"L",I)) S X=^(I),Y=$P(X,U,1) W ?90,$S($P(X,U,5)=698.1:"V: ",1:"A: "),$E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3) D MANUF W ?102,Y,?106,Z,?119,$P(X,U,4)
|
|---|
| 36 | Q
|
|---|
| 37 | MANUF S Y=$P(X,U,3) I Y,$D(^MCAR(698.6,Y,0)) S Y=$P(^(0),U,2)
|
|---|
| 38 | S Z=$P(X,U,2) I Z,$D(^MCAR(698.4,Z,0)) S Z=$P(^(0),U)
|
|---|
| 39 | Q
|
|---|
| 40 | HEAD S PG=PG+1 W @IOF,!!,?47,"VETERANS ADMINISTRATION MEDICAL CENTER",?120,"Pg.",PG
|
|---|
| 41 | ;W !,?132-$L(^DD("SITE"))/2,^DD("SITE")
|
|---|
| 42 | W !,?132-$L($$GET1^DIQ(4.3,1,217))/2,$$GET1^DIQ(4.3,1,217)
|
|---|
| 43 | W !,?52,"PACEMAKER ACTIVE PATIENT LIST"
|
|---|
| 44 | W !!,"PATIENT",?51,"GENERATOR IMPLANT DATA",?93,"V AND A LEAD IMPLANT DATA"
|
|---|
| 45 | W !,"SSN",?17,"DOB",?29,"STATUS",?51,"DATE",?60,"MFR MODEL",?77,"SER. NO.",?93,"DATE",?102,"MFR MODEL",?119,"SER. NO."
|
|---|
| 46 | W !,?51,LN,?93,LN
|
|---|
| 47 | Q
|
|---|
