SROCMPED ;BIR/MAM - ENTER/EDIT OCCURRENCES ;05/01/09
;;3.0; Surgery ;**26,38,47,125,153,170**;24 Jun 93;Build 3
I '$P(^SRF(SRTN,SRTYPE,SRENTRY,0),"^",2) D NOCAT I SRSOUT S SRSOUT=0 Q
I '$D(^SRF(SRTN,SRTYPE,SRENTRY,0)) K SRENTRY S SRSOUT=0 Q
START I '$D(^SRF(SRTN,SRTYPE,SRENTRY)) K SRENTRY S SRSOUT=0 Q
S SRSOUT=0,SR=^SRF(SRTN,SRTYPE,SRENTRY,0)
I $G(SRNEW),$P(SR,"^",2)=3,SRTYPE=16 D SEPSIS G:SRSOUT END G START
I $G(SRNEW),$P(SR,"^",2)=27,SRTYPE=16,$P($G(^SRF(SRTN,"RA")),"^",2)="C" D RCP G:SRSOUT END G START
D HDR^SROAUTL W !
S SRO(1)=$P(SR,"^")_"^.01",X=$P(SR,"^",2),SRO(2)=X_"^"_$S(SRTYPE=10:3,1:5) I X S $P(SRO(2),"^")=$P(^SRO(136.5,X,0),"^")
I $P(SR,"^",2)=3 S Y=$P(SR,"^",4),C=$P(^DD(130.22,7,0),"^",2) D:Y'="" Y^DIQ S SRO(3)=Y_"^7"
I $P(SR,"^",2)'=3 D
.S SRSDATE=$E($P(SR,"^",7),1,7) I 'SRSDATE S SRSDATE=$E($P(^SRF(SRTN,0),"^",9),1,7)
.I $P(SR,"^",2)=27,$P($G(^SRF(SRTN,"RA")),"^",2)="C" S Y=$P(SR,"^",5),C=$P(^DD(130.22,8,0),"^",2) D:Y'="" Y^DIQ S SRO(3)=Y_"^8" Q
.S X=$P(SR,"^",3) D:X ICDSTR S SRO(3)=X_"^"_$S(SRTYPE=10:4,1:6)
S SR(2)=$G(^SRF(SRTN,SRTYPE,SRENTRY,2)),SRO(4)=$P(SR(2),"^")_"^"_$S(SRTYPE=10:2,1:3)
S X=$P(SR,"^",6),SHEMP=$S(X="U":"UNRESOLVED",X="I":"IMPROVED",X="D":"DEATH",X="W":"WORSE",1:""),SRO(5)=SHEMP_"^.05"
K SRO(6) I SRTYPE=16 S X=$P(SR,"^",7) S:X X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) S SRO(6)=X_"^2"
DISP W !,"1. Occurrence: ",?26,$P(SRO(1),"^"),!,"2. Occurrence Category: ",?26,$P(SRO(2),"^")
W !,"3. "_$S($P(SR,"^",2)=3:"Sepsis Type",$P(SR,"^",2)=27&($P($G(^SRF(SRTN,"RA")),"^",2)="C"):"CPB Status",1:"ICD Diagnosis Code")_":",?26,$P(SRO(3),"^")
W !,"4. Treatment Instituted:",?26,$P(SRO(4),"^"),!,"5. Outcome to Date:",?26,$P(SRO(5),"^")
I $D(SRO(6)) W !,"6. Date Noted: ",?26,$P(SRO(6),"^")
S SRX=$S(SRTYPE=10:6,1:7),SRO(SRX)="^" I $O(^SRF(SRTN,SRTYPE,SRENTRY,1,0)) S SRO(SRX)="*** INFORMATION ENTERED ***"_SRO(SRX)
S X=$S(SRTYPE=10:1,1:4),SRO(SRX)=SRO(SRX)_X,SRMAX=SRX
W !,SRX_". Occurrence Comments: ",?26,$P(SRO(SRX),"^")
W !!,SRLINE
W !!,"Select Occurrence Information: " R X:DTIME I '$T!("^"[X) S:X["^" SRSOUT=1 G END
I "Aa"[X S X="1:"_SRMAX
I X'?.N1":".N,'$D(SRO(X)) D HELP G:SRSOUT END W @IOF G START
I X?.N1":".N S Y=$E(X),Z=$P(X,":",2) I Y<1!(Z>SRMAX)!(Y>Z) D HELP G:SRSOUT END W @IOF G START
D HDR^SROAUTL W !
I X?.N1":".N D RANGE G START
I $$LOCK^SROUTL(SRTN) D D UNLOCK^SROUTL(SRTN) D:SRZ=2 PRESS
.S SRZ=X K DIE,DA,DR S DA(1)=SRTN,DA=SRENTRY,DIE="^SRF("_SRTN_","_SRTYPE_",",DR=$P(SRO(X),"^",2)_"T" D ^DIE K DR,DA
G START
Q
ICDSTR ; get diagnosis info
N SRICDSTR
S SRICDSTR=$$ICDDX^ICDCODE(X,SRSDATE),X=$P(SRICDSTR,"^",2)_" "_$P(SRICDSTR,"^",4)
Q
HELP W @IOF,!!!!,"Enter the number, or range of numbers you want to edit. Examples of proper",!,"responses are listed below."
W !!,"1. Enter 'A' to update all occurrence information."
S RANGE="(1-"_SRMAX_")"
W !!,"2. Enter a number "_RANGE_" to update a specific occurrence element. (For",!," example, enter '2' to update the occurrence category)"
W !!,"3. Enter a range of numbers "_RANGE_" separated by a ':' to enter a range of",!," elements. (For example, enter '1:3' to enter occurrence, occurrence",!," category, and ICD diagnosis code)"
W ! D PRESS
Q
RANGE ; range of numbers
I $$LOCK^SROUTL(SRTN) D D UNLOCK^SROUTL(SRTN)
.S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) F EMILY=SHEMP:1:CURLEY Q:SRSOUT D ONE
I CURLEY=2 D PRESS
Q
ONE ; edit one item
K DR,DA,DIE S DR=$P(SRO(EMILY),"^",2)_"T",DA=SRENTRY,DA(1)=SRTN,DIE="^SRF("_SRTN_","_SRTYPE_"," D ^DIE K DR,DA I '$D(^SRF(SRTN,SRTYPE,SRENTRY))!$D(DTOUT)!$D(Y) S SRSOUT=1
Q
END K SRO,SR,X,DA,DIE,DR,Y
Q
SEPSIS D HDR^SROAUTL K DA,DIE,DR
S DA=SRENTRY,DA(1)=SRTN,DR="7T",DIE="^SRF("_SRTN_","_SRTYPE_"," D ^DIE K DR,DA
K DA,DIE,DR S SRNEW=0 I $D(DTOUT)!$D(Y) S SRSOUT=1 Q
Q
RCP D HDR^SROAUTL K DA,DIE,DR
S DA=SRENTRY,DA(1)=SRTN,DR="8T",DIE="^SRF("_SRTN_","_SRTYPE_"," D ^DIE K DR,DA
K DA,DIE,DR S SRNEW=0 I $D(DTOUT)!$D(Y) S SRSOUT=1 Q
Q
NOCAT W @IOF,!,"The occurrence selected does not have a corresponding category. A category",!,"must be selected at this time, or the occurrence will be deleted.",!
K DIE,DIC,X,Y,SRCAT
S DIC=136.5,DIC(0)="QEAMZ",DIC("A")="Select Occurrence Category: ",DIC("S")="I '$P(^(0),U,2)" S:SRTYPE=10 DIC("S")=DIC("S")_",$P(^(0),U,3)" D ^DIC
I +Y>0 S SRCAT=+Y K DIE,DR,DA S DA(1)=SRTN,DA=SRENTRY,DIE="^SRF("_DA_","_SRTYPE_",",DR=$S(SRTYPE=10:3,1:5)_"////"_SRCAT D ^DIE K DR,DA
I $D(SRCAT) K SRCAT Q
DEL W !!,"Are you sure that you want to delete this occurrence ? NO// " R SRYN:DTIME I '$T!(SRYN["^") D YUP S SRSOUT=1 Q
I "YyNn"'[SRYN W !!,"Enter 'YES' to delete this occurrence from the patient's record. Enter 'NO'",!,"to backup and enter a category for this occurrence." G DEL
I "Nn"[SRYN G NOCAT
YUP ; delete occurrence
K DIK,DA S DA=SRENTRY,DA(1)=SRTN,DIK="^SRF("_SRTN_","_SRTYPE_"," D ^DIK S SRSOUT=1
Q
PRESS W ! K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
Q
SROCMPED ;BIR/MAM - ENTER/EDIT OCCURRENCES ;05/01/09
+1 ;;3.0; Surgery ;**26,38,47,125,153,170**;24 Jun 93;Build 3
+2 IF '$PIECE(^SRF(SRTN,SRTYPE,SRENTRY,0),"^",2)
DO NOCAT
IF SRSOUT
SET SRSOUT=0
QUIT
+3 IF '$DATA(^SRF(SRTN,SRTYPE,SRENTRY,0))
KILL SRENTRY
SET SRSOUT=0
QUIT
START IF '$DATA(^SRF(SRTN,SRTYPE,SRENTRY))
KILL SRENTRY
SET SRSOUT=0
QUIT
+1 SET SRSOUT=0
SET SR=^SRF(SRTN,SRTYPE,SRENTRY,0)
+2 IF $GET(SRNEW)
IF $PIECE(SR,"^",2)=3
IF SRTYPE=16
DO SEPSIS
IF SRSOUT
GOTO END
GOTO START
+3 IF $GET(SRNEW)
IF $PIECE(SR,"^",2)=27
IF SRTYPE=16
IF $PIECE($GET(^SRF(SRTN,"RA")),"^",2)="C"
DO RCP
IF SRSOUT
GOTO END
GOTO START
+4 DO HDR^SROAUTL
WRITE !
+5 SET SRO(1)=$PIECE(SR,"^")_"^.01"
SET X=$PIECE(SR,"^",2)
SET SRO(2)=X_"^"_$SELECT(SRTYPE=10:3,1:5)
IF X
SET $PIECE(SRO(2),"^")=$PIECE(^SRO(136.5,X,0),"^")
+6 IF $PIECE(SR,"^",2)=3
SET Y=$PIECE(SR,"^",4)
SET C=$PIECE(^DD(130.22,7,0),"^",2)
IF Y'=""
DO Y^DIQ
SET SRO(3)=Y_"^7"
+7 IF $PIECE(SR,"^",2)'=3
Begin DoDot:1
+8 SET SRSDATE=$EXTRACT($PIECE(SR,"^",7),1,7)
IF 'SRSDATE
SET SRSDATE=$EXTRACT($PIECE(^SRF(SRTN,0),"^",9),1,7)
+9 IF $PIECE(SR,"^",2)=27
IF $PIECE($GET(^SRF(SRTN,"RA")),"^",2)="C"
SET Y=$PIECE(SR,"^",5)
SET C=$PIECE(^DD(130.22,8,0),"^",2)
IF Y'=""
DO Y^DIQ
SET SRO(3)=Y_"^8"
QUIT
+10 SET X=$PIECE(SR,"^",3)
IF X
DO ICDSTR
SET SRO(3)=X_"^"_$SELECT(SRTYPE=10:4,1:6)
End DoDot:1
+11 SET SR(2)=$GET(^SRF(SRTN,SRTYPE,SRENTRY,2))
SET SRO(4)=$PIECE(SR(2),"^")_"^"_$SELECT(SRTYPE=10:2,1:3)
+12 SET X=$PIECE(SR,"^",6)
SET SHEMP=$SELECT(X="U":"UNRESOLVED",X="I":"IMPROVED",X="D":"DEATH",X="W":"WORSE",1:"")
SET SRO(5)=SHEMP_"^.05"
+13 KILL SRO(6)
IF SRTYPE=16
SET X=$PIECE(SR,"^",7)
IF X
SET X=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
SET SRO(6)=X_"^2"
DISP WRITE !,"1. Occurrence: ",?26,$PIECE(SRO(1),"^"),!,"2. Occurrence Category: ",?26,$PIECE(SRO(2),"^")
+1 WRITE !,"3. "_$SELECT($PIECE(SR,"^",2)=3:"Sepsis Type",$PIECE(SR,"^",2)=27&($PIECE($GET(^SRF(SRTN,"RA")),"^",2)="C"):"CPB Status",1:"ICD Diagnosis Code")_":",?26,$PIECE(SRO(3),"^")
+2 WRITE !,"4. Treatment Instituted:",?26,$PIECE(SRO(4),"^"),!,"5. Outcome to Date:",?26,$PIECE(SRO(5),"^")
+3 IF $DATA(SRO(6))
WRITE !,"6. Date Noted: ",?26,$PIECE(SRO(6),"^")
+4 SET SRX=$SELECT(SRTYPE=10:6,1:7)
SET SRO(SRX)="^"
IF $ORDER(^SRF(SRTN,SRTYPE,SRENTRY,1,0))
SET SRO(SRX)="*** INFORMATION ENTERED ***"_SRO(SRX)
+5 SET X=$SELECT(SRTYPE=10:1,1:4)
SET SRO(SRX)=SRO(SRX)_X
SET SRMAX=SRX
+6 WRITE !,SRX_". Occurrence Comments: ",?26,$PIECE(SRO(SRX),"^")
+7 WRITE !!,SRLINE
+8 WRITE !!,"Select Occurrence Information: "
READ X:DTIME
IF '$TEST!("^"[X)
IF X["^"
SET SRSOUT=1
GOTO END
+9 IF "Aa"[X
SET X="1:"_SRMAX
+10 IF X'?.N1":".N
IF '$DATA(SRO(X))
DO HELP
IF SRSOUT
GOTO END
WRITE @IOF
GOTO START
+11 IF X?.N1":".N
SET Y=$EXTRACT(X)
SET Z=$PIECE(X,":",2)
IF Y<1!(Z>SRMAX)!(Y>Z)
DO HELP
IF SRSOUT
GOTO END
WRITE @IOF
GOTO START
+12 DO HDR^SROAUTL
WRITE !
+13 IF X?.N1":".N
DO RANGE
GOTO START
+14 IF $$LOCK^SROUTL(SRTN)
Begin DoDot:1
+15 SET SRZ=X
KILL DIE,DA,DR
SET DA(1)=SRTN
SET DA=SRENTRY
SET DIE="^SRF("_SRTN_","_SRTYPE_","
SET DR=$PIECE(SRO(X),"^",2)_"T"
DO ^DIE
KILL DR,DA
End DoDot:1
DO UNLOCK^SROUTL(SRTN)
IF SRZ=2
DO PRESS
+16 GOTO START
+17 QUIT
ICDSTR ; get diagnosis info
+1 NEW SRICDSTR
+2 SET SRICDSTR=$$ICDDX^ICDCODE(X,SRSDATE)
SET X=$PIECE(SRICDSTR,"^",2)_" "_$PIECE(SRICDSTR,"^",4)
+3 QUIT
HELP WRITE @IOF,!!!!,"Enter the number, or range of numbers you want to edit. Examples of proper",!,"responses are listed below."
+1 WRITE !!,"1. Enter 'A' to update all occurrence information."
+2 SET RANGE="(1-"_SRMAX_")"
+3 WRITE !!,"2. Enter a number "_RANGE_" to update a specific occurrence element. (For",!," example, enter '2' to update the occurrence category)"
+4 WRITE !!,"3. Enter a range of numbers "_RANGE_" separated by a ':' to enter a range of",!," elements. (For example, enter '1:3' to enter occurrence, occurrence",!," category, and ICD diagnosis code)"
+5 WRITE !
DO PRESS
+6 QUIT
RANGE ; range of numbers
+1 IF $$LOCK^SROUTL(SRTN)
Begin DoDot:1
+2 SET SHEMP=$PIECE(X,":")
SET CURLEY=$PIECE(X,":",2)
FOR EMILY=SHEMP:1:CURLEY
IF SRSOUT
QUIT
DO ONE
End DoDot:1
DO UNLOCK^SROUTL(SRTN)
+3 IF CURLEY=2
DO PRESS
+4 QUIT
ONE ; edit one item
+1 KILL DR,DA,DIE
SET DR=$PIECE(SRO(EMILY),"^",2)_"T"
SET DA=SRENTRY
SET DA(1)=SRTN
SET DIE="^SRF("_SRTN_","_SRTYPE_","
DO ^DIE
KILL DR,DA
IF '$DATA(^SRF(SRTN,SRTYPE,SRENTRY))!$DATA(DTOUT)!$DATA(Y)
SET SRSOUT=1
+2 QUIT
END KILL SRO,SR,X,DA,DIE,DR,Y
+1 QUIT
SEPSIS DO HDR^SROAUTL
KILL DA,DIE,DR
+1 SET DA=SRENTRY
SET DA(1)=SRTN
SET DR="7T"
SET DIE="^SRF("_SRTN_","_SRTYPE_","
DO ^DIE
KILL DR,DA
+2 KILL DA,DIE,DR
SET SRNEW=0
IF $DATA(DTOUT)!$DATA(Y)
SET SRSOUT=1
QUIT
+3 QUIT
RCP DO HDR^SROAUTL
KILL DA,DIE,DR
+1 SET DA=SRENTRY
SET DA(1)=SRTN
SET DR="8T"
SET DIE="^SRF("_SRTN_","_SRTYPE_","
DO ^DIE
KILL DR,DA
+2 KILL DA,DIE,DR
SET SRNEW=0
IF $DATA(DTOUT)!$DATA(Y)
SET SRSOUT=1
QUIT
+3 QUIT
NOCAT WRITE @IOF,!,"The occurrence selected does not have a corresponding category. A category",!,"must be selected at this time, or the occurrence will be deleted.",!
+1 KILL DIE,DIC,X,Y,SRCAT
+2 SET DIC=136.5
SET DIC(0)="QEAMZ"
SET DIC("A")="Select Occurrence Category: "
SET DIC("S")="I '$P(^(0),U,2)"
IF SRTYPE=10
SET DIC("S")=DIC("S")_",$P(^(0),U,3)"
DO ^DIC
+3 IF +Y>0
SET SRCAT=+Y
KILL DIE,DR,DA
SET DA(1)=SRTN
SET DA=SRENTRY
SET DIE="^SRF("_DA_","_SRTYPE_","
SET DR=$SELECT(SRTYPE=10:3,1:5)_"////"_SRCAT
DO ^DIE
KILL DR,DA
+4 IF $DATA(SRCAT)
KILL SRCAT
QUIT
DEL WRITE !!,"Are you sure that you want to delete this occurrence ? NO// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
DO YUP
SET SRSOUT=1
QUIT
+1 IF "YyNn"'[SRYN
WRITE !!,"Enter 'YES' to delete this occurrence from the patient's record. Enter 'NO'",!,"to backup and enter a category for this occurrence."
GOTO DEL
+2 IF "Nn"[SRYN
GOTO NOCAT
YUP ; delete occurrence
+1 KILL DIK,DA
SET DA=SRENTRY
SET DA(1)=SRTN
SET DIK="^SRF("_SRTN_","_SRTYPE_","
DO ^DIK
SET SRSOUT=1
+2 QUIT
PRESS WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
+1 QUIT
