- 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
