Changeset 636 for FOIAVistA/tag/r/SURGERY-SR/SROACOM.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/SURGERY-SR/SROACOM.m
r628 r636 1 SROACOM ;BIR/MAM - COMPLETE ASSESSMENT ; 12/19/072 ;;3.0; Surgery ;**38,55,63,65,88,93,95,102,100,125,134,142,160 ,166**;24 Jun 93;Build 61 SROACOM ;BIR/MAM - COMPLETE ASSESSMENT ;02/08/07 2 ;;3.0; Surgery ;**38,55,63,65,88,93,95,102,100,125,134,142,160**;24 Jun 93;Build 7 3 3 I '$D(SRTN) Q 4 I $P($G(^SRF(SRTN,"RA")),"^",2)="C" G ^SROACOM15 4 S (SRSFLG,SRSOUT,SROVER)=0,SRA=$G(^SRF(SRTN,"RA")),Y=$P(SRA,"^") I Y'="I" W !!,"This assessment has a "_$S(Y="C":"'COMPLETE'",1:"'TRANSMITTED'")_" status.",!!,"No action taken." G END 6 5 I $P(SRA,"^",2)="N",$P(SRA,"^",6)="Y" D CHK^SROAUTL 7 6 I $P(SRA,"^",2)="N",$P(SRA,"^",6)="N" D CHK^SROAUTL3 7 I $P(SRA,"^",2)="C" D CHK^SROAUTLC 8 8 S SRFLD="" I $O(SRX(SRFLD))'="" D LIST 9 I $P(SRA,"^",2)="C" D CHCK G:SRSOUT END 9 10 YEP I '$P($G(^SRO(136,SRTN,10)),"^")!('$P($G(^SRO(136,SRTN,0)),"^",2))!('$P($G(^SRO(136,SRTN,0)),"^",3)) W !!,?6,"The coding for Procedure and Diagnosis is not complete." 10 11 W ! S SRFLD="" K DIR S DIR("A")="Are you sure you want to complete this assessment ? ",DIR("B")=$S($O(SRX(SRFLD)):"NO",1:"YES"),DIR(0)="YA" … … 28 29 END I 'SRSOUT,$E(IOST)'="P" D RET 29 30 W @IOF I $E(IOST)="P" D ^%ZISC W @IOF 30 D ^SRSKILL K SR MD,SRMD1,SRSFLG31 D ^SRSKILL K SRSFLG 31 32 Q 32 33 LIST W @IOF,!,"This assessment is missing the following items:",! S SRZ="",SRCNT=1 34 ;I '$P($G(^SRO(136,SRTN,10)),"^")!('$P($G(^SRO(136,SRTN,0)),"^",2))!('$P($G(^SRO(136,SRTN,0)),"^",3)) W !,?6,"The coding for Procedure and Diagnosis is",!,?6,"not complete.",! 33 35 F S SRZ=$O(SRX(SRZ)) Q:SRZ="" D:$Y+5>IOSL RET Q:SRSOUT W !,?5,$J(SRCNT,2)_". "_$P(SRX(SRZ),"^") S SRCNT=SRCNT+1 34 36 S SRSOUT=0 W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to enter the missing items at this time",DIR("B")="NO" D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q … … 38 40 .I $E(SRMD,1,10)="ANESTHESIA" D ANES Q 39 41 .I $E(SRMD,1,6)="POSTOP"!($E(SRMD,1,6)="SEPSIS") D POST^SROCMPS Q 42 .I SRMD=240 D FUNCT Q 43 .I SRMD=492 D FUNCTI^SROAPRE Q 44 .I SRMD=485 W @IOF,! D PRIOR^SROACL2 K DR,DIE S DA=SRTN,DR="485///"_$S(X="@":"@",1:$P(Y,"^")),DIE=130 D ^DIE K DR S:$D(Y) SRSFLG=1 Q 40 45 .K DR,DIE S DA=SRTN,DIE=130,DR=$S($G(SRMD1):SRMD1,1:SRMD)_"T" D ^DIE K DR I $D(Y) S SRSFLG=1 41 46 S:'$G(SRSOUT) SRSOUT=0 42 47 Q 48 FUNCT I $P($G(^SRF(SRTN,"RA")),"^",2)="C" D FUNCT^SROACLN Q 49 D FUNCTJ^SROAPRE 50 Q 43 51 ANES K DR,DIE,DA S DA=SRTN,DR=.37,DR(2,130.06)=".01T;.05T;42T",DIE=130 D ^DIE S:$D(Y) SRSFLG=1 K DR 52 Q 53 CHCK ; cardiac checks added by SR*3*93 54 N SRADM,SRDIS,SRISCH,SRCPB,SRRET S SRRET=0,X=$G(^SRF(SRTN,208)),SRADM=$P(X,"^",14),SRDIS=$P(X,"^",15),X=$G(^SRF(SRTN,206)),SRISCH=$P(X,"^",36),SRCPB=$P(X,"^",37) 55 I SRADM,SRDIS,SRADM'<SRDIS W !!," *** NOTE: Discharge Date precedes Admission Date!! Please check. ***" S SRRET=1,SRX(418)="" 56 I SRISCH,SRCPB,SRISCH>SRCPB W !!," *** NOTE: Ischemic Time is greater than CPB Time!! Please check. ***",! S SRRET=1,SRX(450)="" 57 I SRRET W ! K DIR S DIR(0)="E" D ^DIR K DIR S:$D(DTOUT)!$D(DUOUT) SRSOUT=1 W ! 44 58 Q 45 59 RET W !! K DIR S DIR(0)="E" D ^DIR K DIR W @IOF I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
Note:
See TracChangeset
for help on using the changeset viewer.