- SRONOP1 ;BIR/MAM - NON-O.R. PROCEDURES ;06/15/05
- ;;3.0;Surgery;**44,56,58,48,67,70,88,100,142,177**;24 Jun 93;Build 89
- S X=$P($G(VADM(6)),"^") I X D I SRSOUT D ^SRSKILL G ^SRONOP
- .S SRDEATH=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) W @IOF,!,?1,VADM(1)_" "_VA("PID")_" * Died "_SRDEATH_" *"
- .W !!,$C(7) K DIR S DIR("A",1)=">>> The patient you have selected died on "_SRDEATH_"."
- .S DIR("A")=" Are you sure this is the correct patient ? ",DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR
- .I 'Y!$D(DTOUT)!$D(DUOUT) S SRSOUT=1
- W @IOF,!,"Entering a new non-O.R. procedure for "_SRNM_".",!!
- OP ; principal procedure
- W ! K DIR S DIR(0)="130,26A",DIR("A")="Enter the Procedure: " D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G END
- S SROPER=Y
- DATE W ! K %DT S %DT="AEX",%DT("A")="Select the Date of the Procedure: " D ^%DT I X="" W !!,"The Date of the Procedure MUST be entered." G DATE
- I Y<0!$D(DTOUT) S SRSOUT=1 G END
- S SRSDATE=+Y
- DOC W ! K DIR S DIR("A")="Provider",DIR(0)="130,123" D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 G END
- S SRSDOC=+Y
- SPEC W ! K DIR S DIR("A")="Medical Specialty",DIR(0)="130,125" D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 G END
- S SRSPEC=+Y
- SUMM ; dictated summary expected?
- N SREXPT W ! K DIR S DIR("A")="Will a summary of this procedure be dictated? (Y/N)"
- S DIR("?",1)="This field indicates if the provider will dictate a summary of this",DIR("?",2)="procedure to be electronically signed. Enter YES if a dictated summary"
- S DIR("?")="is expected. Enter NO or leave blank if no summary is expected.",DIR(0)="Y" D ^DIR K DIR
- I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 G END
- S SREXPT=Y
- K DIC,DO,DA,DD,DINUM,SRTN S X=DFN,DIC="^SRF(",DIC(0)="L",DLAYGO=130 D FILE^DICN K DD,DO,DIC,DLAYGO S SRTN=+Y
- N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK S Q3("VIEW")=""
- K DR S DIE=130,DR="120///"_SRSDATE_";26///"_SROPER_";118///Y;123////"_SRSDOC_";125////"_SRSPEC_";1004////"_SREXPT,DA=SRTN D ^DIE K DR,DA,DIE S ^SRF(SRTN,8)=SRSITE("DIV")
- D RT S SRSOUT=1,SRN=$E(SRNM,1,20),Q3(1)="** NON-O.R. PROCEDURE ** CASE #"_SRTN_" "_SRN_" "
- N SRICDV S SRICDV=$$ICDSTR^SROICD(SRTN)
- S SRDTIME=DTIME,DTIME=3600,ST="NON-O.R. PROCEDURE",DIE=130,DR="[SRNON-OR]",DA=SRTN D ^SRCUSS S DTIME=SRDTIME D ^SROPCE1 S SRSOUT=0
- S SRSOP=SROPER,SRL=$P(^SRF(SRTN,"NON"),"^",2) S ORL=$S(SRL:SRL_";SC(",1:"") D ^SROERR
- D ^SRSKILL I $G(SRLCK) D UNLOCK^SROUTL(SRTN)
- Q
- END I SRSOUT W !!,"No action taken.",!!,"Press RETURN to continue " R X:DTIME
- D ^SRSKILL K SRTN W @IOF
- Q
- RT ; start RT logging
- I $D(XRTL) S ZRTN="SRONOP1" D T0^%ZOSV
- Q
- DEL ; delete procedure
- W !!,"Are you sure that you want to remove this procedure from your ",!,"records ? NO// " R X:DTIME I '$T!(X="^") W !!,"No action taken..." Q
- S X=$E(X) S:X="" X="N" I "YyNn"'[X W !!,"Enter RETURN or 'NO' if this procedure should remain on file. Enter 'YES'",!,"to delete this procedure."
- I "Nn"[X W !!,"No action taken." Q
- I $P($G(^SRF(SRTN,"TIU")),"^",3) D EN^DDIOL("This case can't be deleted, there is a Procedure Report (Non-O.R.) associated with it.",,"!!,?2,$C(7)") Q
- W !!,"Deleting procedure..."
- S SRX=$P($G(^SRF(SRTN,0)),"^",15) I SRX S SRVSIT=SRX D DEL^SROPCEP ; delete visit
- I $D(^SRO(136,SRTN,0)) S DA=SRTN,DIK="^SRO(136," D ^DIK K DA,DIK ; remove entry in file 136
- D DEL^SROERR S DA=SRTN,DIK="^SRF(" D ^DIK
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRONOP1 3331 printed Jan 18, 2025@03:45:30 Page 2
- SRONOP1 ;BIR/MAM - NON-O.R. PROCEDURES ;06/15/05
- +1 ;;3.0;Surgery;**44,56,58,48,67,70,88,100,142,177**;24 Jun 93;Build 89
- +2 SET X=$PIECE($GET(VADM(6)),"^")
- IF X
- Begin DoDot:1
- +3 SET SRDEATH=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
- WRITE @IOF,!,?1,VADM(1)_" "_VA("PID")_" * Died "_SRDEATH_" *"
- +4 WRITE !!,$CHAR(7)
- KILL DIR
- SET DIR("A",1)=">>> The patient you have selected died on "_SRDEATH_"."
- +5 SET DIR("A")=" Are you sure this is the correct patient ? "
- SET DIR("B")="NO"
- SET DIR(0)="YA"
- DO ^DIR
- KILL DIR
- +6 IF 'Y!$DATA(DTOUT)!$DATA(DUOUT)
- SET SRSOUT=1
- End DoDot:1
- IF SRSOUT
- DO ^SRSKILL
- GOTO ^SRONOP
- +7 WRITE @IOF,!,"Entering a new non-O.R. procedure for "_SRNM_".",!!
- OP ; principal procedure
- +1 WRITE !
- KILL DIR
- SET DIR(0)="130,26A"
- SET DIR("A")="Enter the Procedure: "
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!(X="^")
- SET SRSOUT=1
- GOTO END
- +2 SET SROPER=Y
- DATE WRITE !
- KILL %DT
- SET %DT="AEX"
- SET %DT("A")="Select the Date of the Procedure: "
- DO ^%DT
- IF X=""
- WRITE !!,"The Date of the Procedure MUST be entered."
- GOTO DATE
- +1 IF Y<0!$DATA(DTOUT)
- SET SRSOUT=1
- GOTO END
- +2 SET SRSDATE=+Y
- DOC WRITE !
- KILL DIR
- SET DIR("A")="Provider"
- SET DIR(0)="130,123"
- DO ^DIR
- IF $DATA(DTOUT)!$DATA(DUOUT)
- SET SRSOUT=1
- GOTO END
- +1 SET SRSDOC=+Y
- SPEC WRITE !
- KILL DIR
- SET DIR("A")="Medical Specialty"
- SET DIR(0)="130,125"
- DO ^DIR
- IF $DATA(DTOUT)!$DATA(DUOUT)
- SET SRSOUT=1
- GOTO END
- +1 SET SRSPEC=+Y
- SUMM ; dictated summary expected?
- +1 NEW SREXPT
- WRITE !
- KILL DIR
- SET DIR("A")="Will a summary of this procedure be dictated? (Y/N)"
- +2 SET DIR("?",1)="This field indicates if the provider will dictate a summary of this"
- SET DIR("?",2)="procedure to be electronically signed. Enter YES if a dictated summary"
- +3 SET DIR("?")="is expected. Enter NO or leave blank if no summary is expected."
- SET DIR(0)="Y"
- DO ^DIR
- KILL DIR
- +4 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET SRSOUT=1
- GOTO END
- +5 SET SREXPT=Y
- +6 KILL DIC,DO,DA,DD,DINUM,SRTN
- SET X=DFN
- SET DIC="^SRF("
- SET DIC(0)="L"
- SET DLAYGO=130
- DO FILE^DICN
- KILL DD,DO,DIC,DLAYGO
- SET SRTN=+Y
- +7 NEW SRLCK
- SET SRLCK=$$LOCK^SROUTL(SRTN)
- IF 'SRLCK
- SET Q3("VIEW")=""
- +8 KILL DR
- SET DIE=130
- SET DR="120///"_SRSDATE_";26///"_SROPER_";118///Y;123////"_SRSDOC_";125////"_SRSPEC_";1004////"_SREXPT
- SET DA=SRTN
- DO ^DIE
- KILL DR,DA,DIE
- SET ^SRF(SRTN,8)=SRSITE("DIV")
- +9 DO RT
- SET SRSOUT=1
- SET SRN=$EXTRACT(SRNM,1,20)
- SET Q3(1)="** NON-O.R. PROCEDURE ** CASE #"_SRTN_" "_SRN_" "
- +10 NEW SRICDV
- SET SRICDV=$$ICDSTR^SROICD(SRTN)
- +11 SET SRDTIME=DTIME
- SET DTIME=3600
- SET ST="NON-O.R. PROCEDURE"
- SET DIE=130
- SET DR="[SRNON-OR]"
- SET DA=SRTN
- DO ^SRCUSS
- SET DTIME=SRDTIME
- DO ^SROPCE1
- SET SRSOUT=0
- +12 SET SRSOP=SROPER
- SET SRL=$PIECE(^SRF(SRTN,"NON"),"^",2)
- SET ORL=$SELECT(SRL:SRL_";SC(",1:"")
- DO ^SROERR
- +13 DO ^SRSKILL
- IF $GET(SRLCK)
- DO UNLOCK^SROUTL(SRTN)
- +14 QUIT
- END IF SRSOUT
- WRITE !!,"No action taken.",!!,"Press RETURN to continue "
- READ X:DTIME
- +1 DO ^SRSKILL
- KILL SRTN
- WRITE @IOF
- +2 QUIT
- RT ; start RT logging
- +1 IF $DATA(XRTL)
- SET ZRTN="SRONOP1"
- DO T0^%ZOSV
- +2 QUIT
- DEL ; delete procedure
- +1 WRITE !!,"Are you sure that you want to remove this procedure from your ",!,"records ? NO// "
- READ X:DTIME
- IF '$TEST!(X="^")
- WRITE !!,"No action taken..."
- QUIT
- +2 SET X=$EXTRACT(X)
- if X=""
- SET X="N"
- IF "YyNn"'[X
- WRITE !!,"Enter RETURN or 'NO' if this procedure should remain on file. Enter 'YES'",!,"to delete this procedure."
- +3 IF "Nn"[X
- WRITE !!,"No action taken."
- QUIT
- +4 IF $PIECE($GET(^SRF(SRTN,"TIU")),"^",3)
- DO EN^DDIOL("This case can't be deleted, there is a Procedure Report (Non-O.R.) associated with it.",,"!!,?2,$C(7)")
- QUIT
- +5 WRITE !!,"Deleting procedure..."
- +6 ; delete visit
- SET SRX=$PIECE($GET(^SRF(SRTN,0)),"^",15)
- IF SRX
- SET SRVSIT=SRX
- DO DEL^SROPCEP
- +7 ; remove entry in file 136
- IF $DATA(^SRO(136,SRTN,0))
- SET DA=SRTN
- SET DIK="^SRO(136,"
- DO ^DIK
- KILL DA,DIK
- +8 DO DEL^SROERR
- SET DA=SRTN
- SET DIK="^SRF("
- DO ^DIK
- +9 QUIT