- MCARSRP ;WISC/TJK,RMP-CATH SURGICAL RISK REPORT ;5/10/96 14:36
- ;;2.3;Medicine;;09/13/1996
- LOOK S DIC="^MCAR(694.5,",DIC(0)="AEZMQ",DIC("A")="Select Patient:" D ^DIC G EXIT:Y<0 S MCARGDA=+Y
- DEV K IO("Q") S %ZIS="MQ" D ^%ZIS G EXIT:POP
- I $D(IO("Q")) S ZTRTN="PRINT^MCARSRP",ZTSAVE("MCARGDA")="",ZTDESC="SURGICAL RISK ANALYSIS REPORT" D ^%ZTLOAD K ZTSK G EXIT
- U IO
- PRINT K DXS,DIOT(2),^UTILITY($J),MCOUT S PG=0,D0=MCARGDA
- S ^UTILITY($J,1)="S MCY="""" I $Y>(IOSL-3) R:$E(IOST,1,2)=""C-"" !!,""Press RETURN to continue"",MCY:DTIME S:'$T MCY=U S:MCY=U DN=0,MCOUT=1 D:DN HEAD^MCARSRP K MCY"
- S Y0=^MCAR(694.5,D0,0),DFN=$P(Y0,U,2),MCARHOS=$P(Y0,U,3) K Y0 I $D(^(10)) S MCARGDT=$P(^(10),U),MCARGDT=$E(MCARGDT,4,5)_"/"_$E(MCARGDT,6,7)_"/"_$E(MCARGDT,2,3) K Y0
- I MCARHOS,$D(^DIC(4,MCARHOS,99)) S MCARHOS=$P(^(99),U)
- ; ------------------------
- ; SSN = Enternal Format of the patients SSN.
- ; ------------------------
- D DEM^VADPT S MCARGNM=VADM(1),SSN=$P(VADM(2),U,2) D KVAR^VADPT
- ; ^MCAROS0 below was ^MCAROS; changed to eliminate possibility
- ; of overwrite of compiled routine ^MCAROS1 that shares subnamespace
- D HEAD,^MCAROS0 K DXS G EXIT:$D(MCOUT) D ^MCAROS1 K DXS G EXIT:$D(MCOUT) D ^MCAROS2
- K DXS G EXIT:$D(MCOUT) D ^MCAROS3
- EXIT I IOST'?1"P-".E,'$D(MCOUT) R !!,"PRESS RETURN TO CONTINUE",X:DTIME
- S:$D(ZTQUEUED) ZTREQ="@" K ZTSK,^UTILITY($J),IO("Q"),MCARGDA,MCARGDT,SSN
- K MCARGNM,X,DFN,SSN,MCARHOS,DN,D0,FLDS,M1,M2,M3,M4,II,IJ,PC,ND,MCARLC
- K DIOEND,DIOBEG,DI,DICS,DJ,BY,A,DICSS,MCOUT
- K DIEDT,DIQ,DIWF,DIPZ,DIL,DXS,DALL,DSC,DCL,DPP,DPQ,DIC,DU,DQI,DY,S,DC
- K DL,DV,DE,DA,DK,Y,R,C,D,I,J,Q,M,P,N,D1,DIW,DIWL,DIWR,DIWT,PG,Z,L,VA
- W:IOST?1"P-".E @IOF D ^%ZISC Q
- HEAD S PG=PG+1 W @IOF,!!,?25,"CARDIAC SURGERY RISK ASSESSMENT",?72,"Pg ",PG
- W !,?2,"PATIENT NAME: ",MCARGNM,?45,"HOSPITAL: ",MCARHOS,!,?2,"SSN: ",SSN,?45,"DATE OF SURGERY: ",$S($D(MCARGDT):MCARGDT,1:"NONE ENTERED")
- W ! Q
- MCARSRP ;WISC/TJK,RMP-CATH SURGICAL RISK REPORT ;5/10/96 14:36
- +1 ;;2.3;Medicine;;09/13/1996
- LOOK SET DIC="^MCAR(694.5,"
- SET DIC(0)="AEZMQ"
- SET DIC("A")="Select Patient:"
- DO ^DIC
- IF Y<0
- GOTO EXIT
- SET MCARGDA=+Y
- DEV KILL IO("Q")
- SET %ZIS="MQ"
- DO ^%ZIS
- IF POP
- GOTO EXIT
- +1 IF $DATA(IO("Q"))
- SET ZTRTN="PRINT^MCARSRP"
- SET ZTSAVE("MCARGDA")=""
- SET ZTDESC="SURGICAL RISK ANALYSIS REPORT"
- DO ^%ZTLOAD
- KILL ZTSK
- GOTO EXIT
- +2 USE IO
- PRINT KILL DXS,DIOT(2),^UTILITY($JOB),MCOUT
- SET PG=0
- SET D0=MCARGDA
- +1 SET ^UTILITY($JOB,1)="S MCY="""" I $Y>(IOSL-3) R:$E(IOST,1,2)=""C-"" !!,""Press RETURN to continue"",MCY:DTIME S:'$T MCY=U S:MCY=U DN=0,MCOUT=1 D:DN HEAD^MCARSRP K MCY"
- +2 SET Y0=^MCAR(694.5,D0,0)
- SET DFN=$PIECE(Y0,U,2)
- SET MCARHOS=$PIECE(Y0,U,3)
- KILL Y0
- IF $DATA(^(10))
- SET MCARGDT=$PIECE(^(10),U)
- SET MCARGDT=$EXTRACT(MCARGDT,4,5)_"/"_$EXTRACT(MCARGDT,6,7)_"/"_$EXTRACT(MCARGDT,2,3)
- KILL Y0
- +3 IF MCARHOS
- IF $DATA(^DIC(4,MCARHOS,99))
- SET MCARHOS=$PIECE(^(99),U)
- +4 ; ------------------------
- +5 ; SSN = Enternal Format of the patients SSN.
- +6 ; ------------------------
- +7 DO DEM^VADPT
- SET MCARGNM=VADM(1)
- SET SSN=$PIECE(VADM(2),U,2)
- DO KVAR^VADPT
- +8 ; ^MCAROS0 below was ^MCAROS; changed to eliminate possibility
- +9 ; of overwrite of compiled routine ^MCAROS1 that shares subnamespace
- +10 DO HEAD
- DO ^MCAROS0
- KILL DXS
- IF $DATA(MCOUT)
- GOTO EXIT
- DO ^MCAROS1
- KILL DXS
- IF $DATA(MCOUT)
- GOTO EXIT
- DO ^MCAROS2
- +11 KILL DXS
- IF $DATA(MCOUT)
- GOTO EXIT
- DO ^MCAROS3
- EXIT IF IOST'?1"P-".E
- IF '$DATA(MCOUT)
- READ !!,"PRESS RETURN TO CONTINUE",X:DTIME
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- KILL ZTSK,^UTILITY($JOB),IO("Q"),MCARGDA,MCARGDT,SSN
- +2 KILL MCARGNM,X,DFN,SSN,MCARHOS,DN,D0,FLDS,M1,M2,M3,M4,II,IJ,PC,ND,MCARLC
- +3 KILL DIOEND,DIOBEG,DI,DICS,DJ,BY,A,DICSS,MCOUT
- +4 KILL DIEDT,DIQ,DIWF,DIPZ,DIL,DXS,DALL,DSC,DCL,DPP,DPQ,DIC,DU,DQI,DY,S,DC
- +5 KILL DL,DV,DE,DA,DK,Y,R,C,D,I,J,Q,M,P,N,D1,DIW,DIWL,DIWR,DIWT,PG,Z,L,VA
- +6 IF IOST?1"P-".E
- WRITE @IOF
- DO ^%ZISC
- QUIT
- HEAD SET PG=PG+1
- WRITE @IOF,!!,?25,"CARDIAC SURGERY RISK ASSESSMENT",?72,"Pg ",PG
- +1 WRITE !,?2,"PATIENT NAME: ",MCARGNM,?45,"HOSPITAL: ",MCARHOS,!,?2,"SSN: ",SSN,?45,"DATE OF SURGERY: ",$SELECT($DATA(MCARGDT):MCARGDT,1:"NONE ENTERED")
- +2 WRITE !
- QUIT
