Routine: SROAPCA

SROAPCA ;BIR/MAM - PRINT CLINICAL DATA ;09/27/04

 ;;3.0; Surgery ;**38,47,71,95,125,134,153,160**;24 Jun 93;Build 7

 F I=0,206,207,208,200.1 S SRA(I)=$G(^SRF(SRTN,I)),$P(LN,"-",79)=""

 S X=$P(SRA(0),"^",9),SRADATE=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)

 W:$Y @IOF W !,?5,"VA CONTINUOUS IMPROVEMENT IN CARDIAC SURGERY PROGRAM (CICSP/CICSP-X)",!

 W ! F MOE=1:1:80 W "="

 W !,"I. IDENTIFYING DATA",?60,"Case #: "_SRTN

 N SRSPH1,SRZIP S (SRSPH1,SRZIP)=""

 S STATNUM=+$P($$SITE^SROVAR,"^",3) D ADD^VADPT

 W !,"Patient: "_SRANM,?60,"Fac./Div. #: "_STATNUM

 W !,"Surgery Date: "_SRADATE,?25,"Address: "_VAPA(1)

 S SRSPH1=VAPA(8) S:SRSPH1="" SRSPH1="NS/Unknown" S SRZIP=$S(VAPA(11)'="":$P(VAPA(11),"^",2),1:VAPA(6)) S:SRZIP="" SRZIP="NS/Unknown"

 W !,"Phone: "_SRSPH1,?25,"Zip Code: "_SRZIP

 S X=VADM(3) W ?53,"Date of Birth: ",$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)

 S SRAO(1)=SRADATE,NYUK=$P(SRA(0),"^",4),SRAO(2)=$P(VADM(5),"^",2)

 S SRAO(3)=AGE,NYUK=$P(SRA(206),"^") S:NYUK'="" NYUK=$S(NYUK["C"!(NYUK["c"):+NYUK_" cm",1:+NYUK_" in") S SRAO(4)=NYUK_"^236"

 S NYUK=$P(SRA(206),"^",2) S:NYUK'="" NYUK=$S(NYUK["K"!(NYUK["k"):+NYUK_" kg",1:+NYUK_" lb") S SRAO(5)=NYUK_"^237"

 S SRA(200)=$G(^SRF(SRTN,200)),SRA(209)=$G(^SRF(SRTN,209))

 S NYUK=$P(SRA(209),"^",3),SRAO(6)=$S(NYUK="N":"NO",NYUK="O":"ORAL",NYUK="D":"DIET",NYUK="I":"INSULIN",1:"")_"^475",NYUK=$P(SRA(200),"^",11) D YN S SRAO(7)=SHEMP_"^203"

 S SRAO(8)=$P(SRA(206),"^",5)_"^347",NYUK=$P(SRA(206),"^",6) D YN S SRAO(9)=SHEMP_"^209",NYUK=$P(SRA(206),"^",7) D YN S SRAO(10)=SHEMP_"^348"

 S Y=$P(SRA(200.1),"^",5),C=$P(^DD(130,510,0),"^",2) D Y^DIQ S SRAO(11)=$S(Y["-":$E($P(Y,"-",2),1,22),1:$E(Y,1,22))_"^510"

 S NYUK=$P(SRA(206),"^",11) D YN S SRAO(14)=SHEMP_"^350",NYUK=$P(SRA(200),"^",8),SRAO(15)=$S(NYUK=1:"INDEPENDENT",NYUK=2:"PARTIAL DEPENDENT",NYUK=3:"TOTALLY DEPENDENT",NYUK="NS":"NS",1:"")_"^240"

 S NYUK=$P(SRA(206),"^",13),SRAO(16)=$S(NYUK=0:"None",NYUK=1:"NONE RECENT",NYUK=2:"12-72 HRS",NYUK=3:"<12 hrs",NYUK=12:"12 - 72 hrs",NYUK=72:">72 hrs - 7 days",NYUK=7:">7 days",NYUK="NS":"NO STUDY",1:"")_"^351"

 S NYUK=$P(SRA(206),"^",14),SRAO(17)=$S(NYUK=0:"NONE",NYUK=1:"< OR = 7 DAYS OF SURG",NYUK=2:"> 7 DAYS OF SURG",NYUK="NS":"NS",1:"")_"^205"

 S NYUK=$P(SRA(206),"^",15) S SHEMP=$S(NYUK=0:"NONE",NYUK=">":">3",NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:NYUK) S SRAO(18)=SHEMP_"^352"

 S NYUK=$P(SRA(206),"^",42)

 S NYUK=$P(SRA(206),"^",16) D YN S SRAO(19)=SHEMP_"^265",NYUK=$P(SRA(206),"^",17) D YN S SRAO(20)=SHEMP_"^264"

 S SRAO(21)=$P(SRA(206),"^",18)_"^267",SRAO(22)=$P(SRA(206),"^",19)_"^207",NYUK=$P(SRA(206),"^",20) D YN S SRAO(23)=SHEMP_"^353",NYUK=$P(SRA(206),"^",21) D YN S SRAO(24)=SHEMP_"^354"

 S NYUK=$P(SRA(206),"^",22) D YN S SRAO(25)=SHEMP_"^355"

 S NYUK=$P(SRA(209),"^",2),SRAO(26)=$S(NYUK="N":"NONE",NYUK="I":"IABP",NYUK="V":"VAD",NYUK="A":"ARTI",NYUK="O":"OTHER",1:NYUK)_"^474"

 S NYUK=$P(SRA(206),"^",38) D YN S SRAO(27)=SHEMP_"^463"

 S NYUK=$P(SRA(206),"^",10) D YN S SRAO(29)=SHEMP_"^349"

DISP ; display fields

 W ! F MOE=1:1:80 W "="

 W !,"II. CLINICAL DATA"

 W !,"Gender:",?26,$P(SRAO(2),"^"),?40,"PCI: ",$J($P(SRAO(16),"^"),34)

 W !,"Age:",?26,SRAO(3),?40,"Prior MI:",$J($P(SRAO(17),"^"),30)

 W !,"Height:",?26,$P(SRAO(4),"^"),?40,"# of prior heart surgeries:",?75,$P(SRAO(18),"^")

 W !,"Weight:",?26,$P(SRAO(5),"^"),?40,"Prior heart surgeries: " D H485

 W !,"Diabetes:",?26,$P(SRAO(6),"^"),?40,"Peripheral Vascular Disease:",?75,$P(SRAO(19),"^")

 W !,"COPD:",?26,$P(SRAO(7),"^"),?40,"Cerebral Vascular Disease:",?75,$P(SRAO(20),"^")

 W !,"FEV1:",?26,$P(SRAO(8),"^")_$S($P(SRAO(8),"^")="":"",$P(SRAO(8),"^")="NS":"",1:" liters"),?40,"Angina (use CCS Class):",?75,$P(SRAO(21),"^")

 W !,"Cardiomegaly (X-ray): ",?26,$P(SRAO(9),"^"),?40,"CHF (use NYHA Class):",?75,$P(SRAO(22),"^")

 W !,"Pulmonary Rales:",?26,$P(SRAO(10),"^"),?40,"Current Diuretic Use:",?75,$P(SRAO(23),"^")

 W !,"Current Smoker: ",$J($P(SRAO(11),"^"),22),?40,"Current Digoxin Use:",?75,$P(SRAO(24),"^")

 W !,"Active Endocarditis:",?26,$P(SRAO(29),"^"),?40,"IV NTG 48 Hours Preceding Surgery:",?75,$P(SRAO(25),"^")

 W !,"Resting ST Depression:",?26,$P(SRAO(14),"^"),?40,"Preop circulatory Device:",?74,$P(SRAO(26),"^")

 W !,"Functional Status: ",$J($P(SRAO(15),"^"),18),?40,"Hypertension:",?75,$P(SRAO(27),"^")

 K SRA,SRAO D ^SROAPCA1

YN ; store answer

 S SHEMP=$S(NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:"")

PAGE I $E(IOST)'="P" W !!,"Press <RET> to continue, or '^' to quit  " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q

 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q

 W @IOF,!,SRANM,! F MOE=1:1:80 W "="

H485 S SHEMP="",X=$P(SRA(206),"^",42) F I=1:1:$L(X,",") D

 .S C=$P(X,",",I) S:I>1 SHEMP=SHEMP_", " S SHEMP=SHEMP_$S(C=0:"None",C=1:"CABG-only",C=2:"Valve-only",C=3:"CABG/valve",C=4:"Other",C=5:"CABG/Other",1:"")

 S X=SHEMP I $L(X)<17 W $J(X,16) Q

 W $J($P(X,",")_",",16) I $L($P(X,", ",2,9))<40 W !,?41,$P(X,", ",2,9) Q

 W !,?41,$P(X,", ",2,4)_",",!,?41,$P(X,", ",5,9)

SROAPCA   ;BIR/MAM - PRINT CLINICAL DATA ;09/27/04

 +1       ;;3.0; Surgery ;**38,47,71,95,125,134,153,160**;24 Jun 93;Build 7

 +2        FOR I=0,206,207,208,200.1

               SET SRA(I)=$GET(^SRF(SRTN,I))

               SET $PIECE(LN,"-",79)=""

 +3        SET X=$PIECE(SRA(0),"^",9)

           SET SRADATE=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)

 +4        IF $Y

               WRITE @IOF

           WRITE !,?5,"VA CONTINUOUS IMPROVEMENT IN CARDIAC SURGERY PROGRAM (CICSP/CICSP-X)",!

 +5        WRITE !

           FOR MOE=1:1:80

               WRITE "="

 +6        WRITE !,"I. IDENTIFYING DATA",?60,"Case #: "_SRTN

 +7        NEW SRSPH1,SRZIP

           SET (SRSPH1,SRZIP)=""

 +8        SET STATNUM=+$PIECE($$SITE^SROVAR,"^",3)

           DO ADD^VADPT

 +9        WRITE !,"Patient: "_SRANM,?60,"Fac./Div. #: "_STATNUM

 +10       WRITE !,"Surgery Date: "_SRADATE,?25,"Address: "_VAPA(1)

 +11       SET SRSPH1=VAPA(8)

           IF SRSPH1=""

               SET SRSPH1="NS/Unknown"

           SET SRZIP=$SELECT(VAPA(11)'="":$PIECE(VAPA(11),"^",2),1:VAPA(6))

           IF SRZIP=""

               SET SRZIP="NS/Unknown"

 +12       WRITE !,"Phone: "_SRSPH1,?25,"Zip Code: "_SRZIP

 +13       SET X=VADM(3)

           WRITE ?53,"Date of Birth: ",$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)

 +14       SET SRAO(1)=SRADATE

           SET NYUK=$PIECE(SRA(0),"^",4)

           SET SRAO(2)=$PIECE(VADM(5),"^",2)

 +15       SET SRAO(3)=AGE

           SET NYUK=$PIECE(SRA(206),"^")

           IF NYUK'=""

               SET NYUK=$SELECT(NYUK["C"!(NYUK["c"):+NYUK_" cm",1:+NYUK_" in")

           SET SRAO(4)=NYUK_"^236"

 +16       SET NYUK=$PIECE(SRA(206),"^",2)

           IF NYUK'=""

               SET NYUK=$SELECT(NYUK["K"!(NYUK["k"):+NYUK_" kg",1:+NYUK_" lb")

           SET SRAO(5)=NYUK_"^237"

 +17       SET SRA(200)=$GET(^SRF(SRTN,200))

           SET SRA(209)=$GET(^SRF(SRTN,209))

 +18       SET NYUK=$PIECE(SRA(209),"^",3)

           SET SRAO(6)=$SELECT(NYUK="N":"NO",NYUK="O":"ORAL",NYUK="D":"DIET",NYUK="I":"INSULIN",1:"")_"^475"

           SET NYUK=$PIECE(SRA(200),"^",11)

           DO YN

           SET SRAO(7)=SHEMP_"^203"

 +19       SET SRAO(8)=$PIECE(SRA(206),"^",5)_"^347"

           SET NYUK=$PIECE(SRA(206),"^",6)

           DO YN

           SET SRAO(9)=SHEMP_"^209"

           SET NYUK=$PIECE(SRA(206),"^",7)

           DO YN

           SET SRAO(10)=SHEMP_"^348"

 +20       SET Y=$PIECE(SRA(200.1),"^",5)

           SET C=$PIECE(^DD(130,510,0),"^",2)

           DO Y^DIQ

           SET SRAO(11)=$SELECT(Y["-":$EXTRACT($PIECE(Y,"-",2),1,22),1:$EXTRACT(Y,1,22))_"^510"

 +21       SET NYUK=$PIECE(SRA(206),"^",11)

           DO YN

           SET SRAO(14)=SHEMP_"^350"

           SET NYUK=$PIECE(SRA(200),"^",8)

           SET SRAO(15)=$SELECT(NYUK=1:"INDEPENDENT",NYUK=2:"PARTIAL DEPENDENT",NYUK=3:"TOTALLY DEPENDENT",NYUK="NS":"NS",1:"")_"^240"

 +22       SET NYUK=$PIECE(SRA(206),"^",13)

           SET SRAO(16)=$SELECT(NYUK=0:"None",NYUK=1:"NONE RECENT",NYUK=2:"12-72 HRS",NYUK=3:"<12 hrs",NYUK=12:"12 - 72 hrs",NYUK=72:">72 hrs - 7 days",NYUK=7:">7 days",NYUK="NS":"NO STUDY",1:"")_"^351"

 +23       SET NYUK=$PIECE(SRA(206),"^",14)

           SET SRAO(17)=$SELECT(NYUK=0:"NONE",NYUK=1:"< OR = 7 DAYS OF SURG",NYUK=2:"> 7 DAYS OF SURG",NYUK="NS":"NS",1:"")_"^205"

 +24       SET NYUK=$PIECE(SRA(206),"^",15)

           SET SHEMP=$SELECT(NYUK=0:"NONE",NYUK=">":">3",NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:NYUK)

           SET SRAO(18)=SHEMP_"^352"

 +25       SET NYUK=$PIECE(SRA(206),"^",42)

 +26       SET NYUK=$PIECE(SRA(206),"^",16)

           DO YN

           SET SRAO(19)=SHEMP_"^265"

           SET NYUK=$PIECE(SRA(206),"^",17)

           DO YN

           SET SRAO(20)=SHEMP_"^264"

 +27       SET SRAO(21)=$PIECE(SRA(206),"^",18)_"^267"

           SET SRAO(22)=$PIECE(SRA(206),"^",19)_"^207"

           SET NYUK=$PIECE(SRA(206),"^",20)

           DO YN

           SET SRAO(23)=SHEMP_"^353"

           SET NYUK=$PIECE(SRA(206),"^",21)

           DO YN

           SET SRAO(24)=SHEMP_"^354"

 +28       SET NYUK=$PIECE(SRA(206),"^",22)

           DO YN

           SET SRAO(25)=SHEMP_"^355"

 +29       SET NYUK=$PIECE(SRA(209),"^",2)

           SET SRAO(26)=$SELECT(NYUK="N":"NONE",NYUK="I":"IABP",NYUK="V":"VAD",NYUK="A":"ARTI",NYUK="O":"OTHER",1:NYUK)_"^474"

 +30       SET NYUK=$PIECE(SRA(206),"^",38)

           DO YN

           SET SRAO(27)=SHEMP_"^463"

 +31       SET NYUK=$PIECE(SRA(206),"^",10)

           DO YN

           SET SRAO(29)=SHEMP_"^349"

DISP      ; display fields

 +1        WRITE !

           FOR MOE=1:1:80

               WRITE "="

 +2        WRITE !,"II. CLINICAL DATA"

 +3        WRITE !,"Gender:",?26,$PIECE(SRAO(2),"^"),?40,"PCI: ",$JUSTIFY($PIECE(SRAO(16),"^"),34)

 +4        WRITE !,"Age:",?26,SRAO(3),?40,"Prior MI:",$JUSTIFY($PIECE(SRAO(17),"^"),30)

 +5        WRITE !,"Height:",?26,$PIECE(SRAO(4),"^"),?40,"# of prior heart surgeries:",?75,$PIECE(SRAO(18),"^")

 +6        WRITE !,"Weight:",?26,$PIECE(SRAO(5),"^"),?40,"Prior heart surgeries: "

           DO H485

 +7        WRITE !,"Diabetes:",?26,$PIECE(SRAO(6),"^"),?40,"Peripheral Vascular Disease:",?75,$PIECE(SRAO(19),"^")

 +8        WRITE !,"COPD:",?26,$PIECE(SRAO(7),"^"),?40,"Cerebral Vascular Disease:",?75,$PIECE(SRAO(20),"^")

 +9        WRITE !,"FEV1:",?26,$PIECE(SRAO(8),"^")_$SELECT($PIECE(SRAO(8),"^")="":"",$PIECE(SRAO(8),"^")="NS":"",1:" liters"),?40,"Angina (use CCS Class):",?75,$PIECE(SRAO(21),"^")

 +10       WRITE !,"Cardiomegaly (X-ray): ",?26,$PIECE(SRAO(9),"^"),?40,"CHF (use NYHA Class):",?75,$PIECE(SRAO(22),"^")

 +11       WRITE !,"Pulmonary Rales:",?26,$PIECE(SRAO(10),"^"),?40,"Current Diuretic Use:",?75,$PIECE(SRAO(23),"^")

 +12       WRITE !,"Current Smoker: ",$JUSTIFY($PIECE(SRAO(11),"^"),22),?40,"Current Digoxin Use:",?75,$PIECE(SRAO(24),"^")

 +13       WRITE !,"Active Endocarditis:",?26,$PIECE(SRAO(29),"^"),?40,"IV NTG 48 Hours Preceding Surgery:",?75,$PIECE(SRAO(25),"^")

 +14       WRITE !,"Resting ST Depression:",?26,$PIECE(SRAO(14),"^"),?40,"Preop circulatory Device:",?74,$PIECE(SRAO(26),"^")

 +15       WRITE !,"Functional Status: ",$JUSTIFY($PIECE(SRAO(15),"^"),18),?40,"Hypertension:",?75,$PIECE(SRAO(27),"^")

 +16       KILL SRA,SRAO

           DO ^SROAPCA1

 +17       QUIT

YN        ; store answer

 +1        SET SHEMP=$SELECT(NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:"")

 +2        QUIT

PAGE       IF $EXTRACT(IOST)'="P"

               WRITE !!,"Press <RET> to continue, or '^' to quit  "

               READ X:DTIME

               IF '$TEST!(X["^")

                   SET SRSOUT=1

                   QUIT

 +1        IF $DATA(ZTQUEUED)

               DO ^SROSTOP

               IF SRHALT

                   SET SRSOUT=1

                   QUIT

 +2        WRITE @IOF,!,SRANM,!

           FOR MOE=1:1:80

               WRITE "="

 +3        QUIT

H485       SET SHEMP=""

           SET X=$PIECE(SRA(206),"^",42)

           FOR I=1:1:$LENGTH(X,",")

               Begin DoDot:1

 +1                SET C=$PIECE(X,",",I)

                   IF I>1

                       SET SHEMP=SHEMP_", "

                   SET SHEMP=SHEMP_$SELECT(C=0:"None",C=1:"CABG-only",C=2:"Valve-only",C=3:"CABG/valve",C=4:"Other",C=5:"CABG/Other",1:"")

               End DoDot:1

 +2        SET X=SHEMP

           IF $LENGTH(X)<17

               WRITE $JUSTIFY(X,16)

               QUIT

 +3        WRITE $JUSTIFY($PIECE(X,",")_",",16)

           IF $LENGTH($PIECE(X,", ",2,9))<40

               WRITE !,?41,$PIECE(X,", ",2,9)

               QUIT

 +4        WRITE !,?41,$PIECE(X,", ",2,4)_",",!,?41,$PIECE(X,", ",5,9)

 +5        QUIT

SROAPCA.m