- SROACOM ;BIR/MAM - COMPLETE ASSESSMENT ;12/19/07
- ;;3.0; Surgery ;**38,55,63,65,88,93,95,102,100,125,134,142,160,166**;24 Jun 93;Build 6
- I '$D(SRTN) Q
- I $P($G(^SRF(SRTN,"RA")),"^",2)="C" G ^SROACOM1
- 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
- I $P(SRA,"^",2)="N",$P(SRA,"^",6)="Y" D CHK^SROAUTL
- I $P(SRA,"^",2)="N",$P(SRA,"^",6)="N" D CHK^SROAUTL3
- S SRFLD="" I $O(SRX(SRFLD))'="" D LIST
- 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."
- 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"
- S DIR("?",1)="Enter YES to complete this assessment, or enter NO to leave the status",DIR("?")="unchanged." D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 G END
- I 'Y W !!,"No action taken." G END
- I $$LOCK^SROUTL(SRTN) D COMPLT Q
- E W !!,"No action taken." G END
- Q
- COMPLT W !!,"Updating the current status to 'COMPLETE'..." K DR,DIE S DA=SRTN,DIE=130,DR="235///C" D ^DIE K STATUS
- I $P(SRA,"^",5)="" K DR,DIE S DA=SRTN,DIE=130,DR="272///"_DT D ^DIE K STATUS
- I $P(SRA,"^",2)="C" K DA,DIE,DIK,DR S DIK="^SRF(",DIK(1)=".232^AQ",DA=SRTN D EN1^DIK K DA,DIK
- D UNLOCK^SROUTL(SRTN)
- PRINT W !!,"Do you want to print the completed assessment ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
- S SRYN=$E(SRYN) S:SRYN="" SRYN="Y" I "Nn"[SRYN S SRSOUT=1 Q
- I "Yy"'[SRYN W !!,"Enter <RET> to print the completed assessment, or 'NO' to return to the menu." G PRINT
- W ! K %ZIS,IO("Q"),POP S %ZIS("A")="Print the Completed Assessment on which Device: ",%ZIS="Q" D ^%ZIS I POP S SRSOUT=1 Q
- I $D(IO("Q")) K IO("Q") S ZTDESC="Completed Surgery Risk Assessment",(ZTSAVE("SRSITE*"),ZTSAVE("SRTN"))="",ZTRTN="EN^SROACOM" D ^%ZTLOAD S SRSOUT=1 G END
- D EN,END
- Q
- EN U IO S SRABATCH=1 D ^SROAPAS Q
- END I 'SRSOUT,$E(IOST)'="P" D RET
- W @IOF I $E(IOST)="P" D ^%ZISC W @IOF
- D ^SRSKILL K SRMD,SRMD1,SRSFLG
- Q
- LIST W @IOF,!,"This assessment is missing the following items:",! S SRZ="",SRCNT=1
- 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
- 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
- Q:'Y I $$LOCK^SROUTL(SRTN) D PRT,UNLOCK^SROUTL(SRTN)
- Q
- PRT S SRSOUT=0,(SRMD,SRMD1)="",SRCNT=0 F S SRMD=$O(SRX(SRMD)) Q:SRMD="" S SRMD1=$P(SRX(SRMD),"^",2) D Q:$G(SRSFLG)
- .I $E(SRMD,1,10)="ANESTHESIA" D ANES Q
- .I $E(SRMD,1,6)="POSTOP"!($E(SRMD,1,6)="SEPSIS") D POST^SROCMPS Q
- .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
- S:'$G(SRSOUT) SRSOUT=0
- Q
- 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
- Q
- RET W !! K DIR S DIR(0)="E" D ^DIR K DIR W @IOF I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
- Q
- PAGE I $E(IOST)'="P" D RET Q
- W @IOF,!!!
- Q
- SROACOM ;BIR/MAM - COMPLETE ASSESSMENT ;12/19/07
- +1 ;;3.0; Surgery ;**38,55,63,65,88,93,95,102,100,125,134,142,160,166**;24 Jun 93;Build 6
- +2 IF '$DATA(SRTN)
- QUIT
- +3 IF $PIECE($GET(^SRF(SRTN,"RA")),"^",2)="C"
- GOTO ^SROACOM1
- +4 SET (SRSFLG,SRSOUT,SROVER)=0
- SET SRA=$GET(^SRF(SRTN,"RA"))
- SET Y=$PIECE(SRA,"^")
- IF Y'="I"
- WRITE !!,"This assessment has a "_$SELECT(Y="C":"'COMPLETE'",1:"'TRANSMITTED'")_" status.",!!,"No action taken."
- GOTO END
- +5 IF $PIECE(SRA,"^",2)="N"
- IF $PIECE(SRA,"^",6)="Y"
- DO CHK^SROAUTL
- +6 IF $PIECE(SRA,"^",2)="N"
- IF $PIECE(SRA,"^",6)="N"
- DO CHK^SROAUTL3
- +7 SET SRFLD=""
- IF $ORDER(SRX(SRFLD))'=""
- DO LIST
- YEP IF '$PIECE($GET(^SRO(136,SRTN,10)),"^")!('$PIECE($GET(^SRO(136,SRTN,0)),"^",2))!('$PIECE($GET(^SRO(136,SRTN,0)),"^",3))
- WRITE !!,?6,"The coding for Procedure and Diagnosis is not complete."
- +1 WRITE !
- SET SRFLD=""
- KILL DIR
- SET DIR("A")="Are you sure you want to complete this assessment ? "
- SET DIR("B")=$SELECT($ORDER(SRX(SRFLD)):"NO",1:"YES")
- SET DIR(0)="YA"
- +2 SET DIR("?",1)="Enter YES to complete this assessment, or enter NO to leave the status"
- SET DIR("?")="unchanged."
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!$DATA(DUOUT)
- SET SRSOUT=1
- GOTO END
- +3 IF 'Y
- WRITE !!,"No action taken."
- GOTO END
- +4 IF $$LOCK^SROUTL(SRTN)
- DO COMPLT
- QUIT
- +5 IF '$TEST
- WRITE !!,"No action taken."
- GOTO END
- +6 QUIT
- COMPLT WRITE !!,"Updating the current status to 'COMPLETE'..."
- KILL DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="235///C"
- DO ^DIE
- KILL STATUS
- +1 IF $PIECE(SRA,"^",5)=""
- KILL DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="272///"_DT
- DO ^DIE
- KILL STATUS
- +2 IF $PIECE(SRA,"^",2)="C"
- KILL DA,DIE,DIK,DR
- SET DIK="^SRF("
- SET DIK(1)=".232^AQ"
- SET DA=SRTN
- DO EN1^DIK
- KILL DA,DIK
- +3 DO UNLOCK^SROUTL(SRTN)
- PRINT WRITE !!,"Do you want to print the completed assessment ? YES// "
- READ SRYN:DTIME
- IF '$TEST!(SRYN["^")
- SET SRSOUT=1
- QUIT
- +1 SET SRYN=$EXTRACT(SRYN)
- IF SRYN=""
- SET SRYN="Y"
- IF "Nn"[SRYN
- SET SRSOUT=1
- QUIT
- +2 IF "Yy"'[SRYN
- WRITE !!,"Enter <RET> to print the completed assessment, or 'NO' to return to the menu."
- GOTO PRINT
- +3 WRITE !
- KILL %ZIS,IO("Q"),POP
- SET %ZIS("A")="Print the Completed Assessment on which Device: "
- SET %ZIS="Q"
- DO ^%ZIS
- IF POP
- SET SRSOUT=1
- QUIT
- +4 IF $DATA(IO("Q"))
- KILL IO("Q")
- SET ZTDESC="Completed Surgery Risk Assessment"
- SET (ZTSAVE("SRSITE*"),ZTSAVE("SRTN"))=""
- SET ZTRTN="EN^SROACOM"
- DO ^%ZTLOAD
- SET SRSOUT=1
- GOTO END
- +5 DO EN
- DO END
- +6 QUIT
- EN USE IO
- SET SRABATCH=1
- DO ^SROAPAS
- QUIT
- END IF 'SRSOUT
- IF $EXTRACT(IOST)'="P"
- DO RET
- +1 WRITE @IOF
- IF $EXTRACT(IOST)="P"
- DO ^%ZISC
- WRITE @IOF
- +2 DO ^SRSKILL
- KILL SRMD,SRMD1,SRSFLG
- +3 QUIT
- LIST WRITE @IOF,!,"This assessment is missing the following items:",!
- SET SRZ=""
- SET SRCNT=1
- +1 FOR
- SET SRZ=$ORDER(SRX(SRZ))
- IF SRZ=""
- QUIT
- IF $Y+5>IOSL
- DO RET
- IF SRSOUT
- QUIT
- WRITE !,?5,$JUSTIFY(SRCNT,2)_". "_$PIECE(SRX(SRZ),"^")
- SET SRCNT=SRCNT+1
- +2 SET SRSOUT=0
- WRITE !
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you want to enter the missing items at this time"
- SET DIR("B")="NO"
- DO ^DIR
- IF $DATA(DTOUT)!$DATA(DUOUT)
- SET SRSOUT=1
- QUIT
- +3 IF 'Y
- QUIT
- IF $$LOCK^SROUTL(SRTN)
- DO PRT
- DO UNLOCK^SROUTL(SRTN)
- +4 QUIT
- PRT SET SRSOUT=0
- SET (SRMD,SRMD1)=""
- SET SRCNT=0
- FOR
- SET SRMD=$ORDER(SRX(SRMD))
- IF SRMD=""
- QUIT
- SET SRMD1=$PIECE(SRX(SRMD),"^",2)
- Begin DoDot:1
- +1 IF $EXTRACT(SRMD,1,10)="ANESTHESIA"
- DO ANES
- QUIT
- +2 IF $EXTRACT(SRMD,1,6)="POSTOP"!($EXTRACT(SRMD,1,6)="SEPSIS")
- DO POST^SROCMPS
- QUIT
- +3 KILL DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR=$SELECT($GET(SRMD1):SRMD1,1:SRMD)_"T"
- DO ^DIE
- KILL DR
- IF $DATA(Y)
- SET SRSFLG=1
- End DoDot:1
- IF $GET(SRSFLG)
- QUIT
- +4 IF '$GET(SRSOUT)
- SET SRSOUT=0
- +5 QUIT
- ANES KILL DR,DIE,DA
- SET DA=SRTN
- SET DR=.37
- SET DR(2,130.06)=".01T;.05T;42T"
- SET DIE=130
- DO ^DIE
- IF $DATA(Y)
- SET SRSFLG=1
- KILL DR
- +1 QUIT
- RET WRITE !!
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- WRITE @IOF
- IF $DATA(DTOUT)!$DATA(DUOUT)
- SET SRSOUT=1
- +1 QUIT
- PAGE IF $EXTRACT(IOST)'="P"
- DO RET
- QUIT
- +1 WRITE @IOF,!!!
- +2 QUIT
