- SROCMPED ;BIR/MAM - ENTER/EDIT OCCURRENCES ;08/16/2011
- ;;3.0;Surgery;**26,38,47,125,153,170,176,177,182,184**;24 Jun 93;Build 35
- 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
- I $G(SRNEW),$P(SR,"^",2)=12,SRTYPE=16 D STROKE G:SRSOUT END G START
- I $G(SRNEW),$P(SR,"^",2)=34 D NMC G:SRSOUT END G START
- I $G(SRNEW),$P(SR,"^",2)=40,SRTYPE=16 D UTI 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)=40 D SR40 G DISP
- 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)=12 S Y=$P(SR,"^",8),C=$P(^DD(130.22,9,0),"^",2) D:Y'="" Y^DIQ S SRO(3)=Y_"^9"
- I $P(SR,"^",2)=34,SRTYPE=16 S Y=$P(SR,"^",14),C=$P(^DD(130.22,15,0),"^",2) D:Y'="" Y^DIQ S SRO(3)=Y_"^15"
- I $P(SR,"^",2)=34,SRTYPE=10 S Y=$P(SR,"^",7),C=$P(^DD(130.13,5,0),"^",2) D:Y'="" Y^DIQ S SRO(3)=Y_"^5"
- I $P(SR,"^",2)'=3&($P(SR,"^",2)'=12)&($P(SR,"^",2)'=40)&($P(SR,"^",2)'=34) 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 N SRSYS S SRSYS=$$ICD910^SROICD(SRTN)
- W !,"1. Occurrence: ",?30,$P(SRO(1),"^"),!,"2. Occurrence Category: ",?30,$P(SRO(2),"^")
- I $P(SR,"^",2)=40 D
- .W !,"3. UTI Signs/Symptoms Urg/Freq/Dys: ",$P(SRO(3),"^")
- .W !,"4. UTI Signs/Symptoms Fever:",?30,$P(SRO(4),"^"),!,"5. UTI Signs/Symptoms Tenderness: ",$P(SRO(5),"^")
- .W !,"6. UTI Culture:",?30,$P(SRO(6),"^"),!,"7. Indwelling Urethral Catheter > 2 Calendar Days: ",$P(SRO(7),"^")
- I $P(SR,"^",2)'=40 S X=$P(SR,"^",2) D
- .W !,"3. "_$S(X=3:"Sepsis Type",X=12:"Stroke/CVA Duration",X=34:$S(SRTYPE=16:"Postop",1:"Intraop")_" Device Type",X=27&($P($G(^SRF(SRTN,"RA")),"^",2)="C"):"CPB Status",1:"ICD Diagnosis Code "_$$ICDSTR^SROICD(SRTN))_":",?30,$P(SRO(3),"^")
- S II=$S($P(SR,"^",2)=40:8,1:4) W !,II_". Treatment Instituted:",?30,$P(SRO(II),"^"),!,(II+1)_". Outcome to Date:",?30,$P(SRO(II+1),"^")
- S II=$S($P(SR,"^",2)=40:10,1:6) I $D(SRO(II)) W !,II_". Date Noted: ",?30,$P(SRO(II),"^")
- S SRX=$S($P(SR,"^",2)=40:11,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: ",?30,$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_","
- .S DR=$P(SRO(X),"^",2)_$S((SRTYPE=16&($P(SRO(X),"^",2)=6))!(SRTYPE=10&($P(SRO(X),"^",2)=4)):"ICD Diagnosis Code "_$$ICDSTR^SROICD(SRTN),1:"T") D ^DIE K DR,DA
- .I SRZ=3,$P(SR,"^",2)=12,$P(^SRF(SRTN,16,SRENTRY,0),"^",8)<2 D YUP
- G START
- Q
- ICDSTR ; get diagnosis info
- N SRICDSTR
- S SRICDSTR=$$ICD^SROICD(SRTN,X),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)_$S((SRTYPE=16&($P(SRO(EMILY),"^",2)=6))!(SRTYPE=10&($P(SRO(EMILY),"^",2)=4)):"ICD Diagnosis Code "_$$ICDSTR^SROICD(SRTN),1:"T")
- S DA=SRENTRY,DA(1)=SRTN
- S 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
- STROKE D HDR^SROAUTL K DIR S DIR(0)="130.22,9",DIR("A")="Stroke/CVA Duration",DIR("B")="<24 HOURS" D ^DIR K DIR I $D(DTOUT) S SRSOUT=1 Q
- K DA,DR,DIE I X["^"!(X="@")!(Y=1) D DEL S DA=SRTN,DIE=130,DR="256////N" D ^DIE K DR,DA,DIE Q
- S DA=SRENTRY,DR="9///"_Y,DA(1)=SRTN,DIE="^SRF(SRTN,16," D ^DIE S SRNEW=0 K DR,DA,DIE
- Q
- NMC D HDR^SROAUTL K DA,DIE,DR
- S DA=SRENTRY,DA(1)=SRTN,DR=$S(SRTYPE=10:"5T",1:"15T"),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
- UTI D HDR^SROAUTL S DA=SRENTRY,DA(1)=SRTN,DR="11T;12T;13T;14T;10T",DIE="^SRF(SRTN,16," D ^DIE K DR,DA
- K DA,DIE,DR S SRNEW=0 I $D(DTOUT)!$D(Y) S SRSOUT=1 Q
- Q
- SR40 ;
- S Y=$P(SR,"^",10),C=$P(^DD(130.22,11,0),"^",2) D:Y'="" Y^DIQ S SRO(3)=Y_"^11"
- S Y=$P(SR,"^",11),C=$P(^DD(130.22,12,0),"^",2) D:Y'="" Y^DIQ S SRO(4)=Y_"^12"
- S Y=$P(SR,"^",12),C=$P(^DD(130.22,13,0),"^",2) D:Y'="" Y^DIQ S SRO(5)=Y_"^13"
- S Y=$P(SR,"^",13),C=$P(^DD(130.22,14,0),"^",2) D:Y'="" Y^DIQ S SRO(6)=Y_"^14"
- S Y=$P(SR,"^",9),C=$P(^DD(130.22,10,0),"^",2) D:Y'="" Y^DIQ S SRO(7)=Y_"^10"
- S SR(2)=$G(^SRF(SRTN,SRTYPE,SRENTRY,2)),SRO(8)=$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(9)=SHEMP_"^.05"
- K SRO(10) S X=$P(SR,"^",7) S:X X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) S SRO(10)=X_"^2"
- S SRX=11,SRO(SRX)="^" I $O(^SRF(SRTN,SRTYPE,SRENTRY,1,0)) S SRO(SRX)="*** INFORMATION ENTERED ***"_SRO(SRX)
- S SRO(SRX)=SRO(SRX)_11
- 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 K DIK,DA
- Q
- PRESS W ! K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROCMPED 8034 printed Jan 18, 2025@03:43:59 Page 2
- SROCMPED ;BIR/MAM - ENTER/EDIT OCCURRENCES ;08/16/2011
- +1 ;;3.0;Surgery;**26,38,47,125,153,170,176,177,182,184**;24 Jun 93;Build 35
- +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 IF $GET(SRNEW)
- IF $PIECE(SR,"^",2)=12
- IF SRTYPE=16
- DO STROKE
- if SRSOUT
- GOTO END
- GOTO START
- +5 IF $GET(SRNEW)
- IF $PIECE(SR,"^",2)=34
- DO NMC
- if SRSOUT
- GOTO END
- GOTO START
- +6 IF $GET(SRNEW)
- IF $PIECE(SR,"^",2)=40
- IF SRTYPE=16
- DO UTI
- if SRSOUT
- GOTO END
- GOTO START
- +7 DO HDR^SROAUTL
- WRITE !
- +8 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),"^")
- +9 IF $PIECE(SR,"^",2)=40
- DO SR40
- GOTO DISP
- +10 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"
- +11 IF $PIECE(SR,"^",2)=12
- SET Y=$PIECE(SR,"^",8)
- SET C=$PIECE(^DD(130.22,9,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET SRO(3)=Y_"^9"
- +12 IF $PIECE(SR,"^",2)=34
- IF SRTYPE=16
- SET Y=$PIECE(SR,"^",14)
- SET C=$PIECE(^DD(130.22,15,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET SRO(3)=Y_"^15"
- +13 IF $PIECE(SR,"^",2)=34
- IF SRTYPE=10
- SET Y=$PIECE(SR,"^",7)
- SET C=$PIECE(^DD(130.13,5,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET SRO(3)=Y_"^5"
- +14 IF $PIECE(SR,"^",2)'=3&($PIECE(SR,"^",2)'=12)&($PIECE(SR,"^",2)'=40)&($PIECE(SR,"^",2)'=34)
- Begin DoDot:1
- +15 SET SRSDATE=$EXTRACT($PIECE(SR,"^",7),1,7)
- IF 'SRSDATE
- SET SRSDATE=$EXTRACT($PIECE(^SRF(SRTN,0),"^",9),1,7)
- +16 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
- +17 SET X=$PIECE(SR,"^",3)
- if X
- DO ICDSTR
- SET SRO(3)=X_"^"_$SELECT(SRTYPE=10:4,1:6)
- End DoDot:1
- +18 SET SR(2)=$GET(^SRF(SRTN,SRTYPE,SRENTRY,2))
- SET SRO(4)=$PIECE(SR(2),"^")_"^"_$SELECT(SRTYPE=10:2,1:3)
- +19 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"
- +20 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 NEW SRSYS
- SET SRSYS=$$ICD910^SROICD(SRTN)
- +1 WRITE !,"1. Occurrence: ",?30,$PIECE(SRO(1),"^"),!,"2. Occurrence Category: ",?30,$PIECE(SRO(2),"^")
- +2 IF $PIECE(SR,"^",2)=40
- Begin DoDot:1
- +3 WRITE !,"3. UTI Signs/Symptoms Urg/Freq/Dys: ",$PIECE(SRO(3),"^")
- +4 WRITE !,"4. UTI Signs/Symptoms Fever:",?30,$PIECE(SRO(4),"^"),!,"5. UTI Signs/Symptoms Tenderness: ",$PIECE(SRO(5),"^")
- +5 WRITE !,"6. UTI Culture:",?30,$PIECE(SRO(6),"^"),!,"7. Indwelling Urethral Catheter > 2 Calendar Days: ",$PIECE(SRO(7),"^")
- End DoDot:1
- +6 IF $PIECE(SR,"^",2)'=40
- SET X=$PIECE(SR,"^",2)
- Begin DoDot:1
- +7 WRITE !,"3. "_$SELECT(X=3:"Sepsis Type",X=12:"Stroke/CVA Duration",X=34:$SELECT(SRTYPE=16:"Postop",1:"Intraop")_" Device Type",X=27&($PIECE(...
- ... $GET(^SRF(SRTN,"RA")),"^",2)="C"):"CPB Status",1:"ICD Diagnosis Code "_$$ICDSTR^SROICD(SRTN))_":",?30,$PIECE(SRO(3),"^")
- End DoDot:1
- +8 SET II=$SELECT($PIECE(SR,"^",2)=40:8,1:4)
- WRITE !,II_". Treatment Instituted:",?30,$PIECE(SRO(II),"^"),!,(II+1)_". Outcome to Date:",?30,$PIECE(SRO(II+1),"^")
- +9 SET II=$SELECT($PIECE(SR,"^",2)=40:10,1:6)
- IF $DATA(SRO(II))
- WRITE !,II_". Date Noted: ",?30,$PIECE(SRO(II),"^")
- +10 SET SRX=$SELECT($PIECE(SR,"^",2)=40:11,SRTYPE=10:6,1:7)
- SET SRO(SRX)="^"
- IF $ORDER(^SRF(SRTN,SRTYPE,SRENTRY,1,0))
- SET SRO(SRX)="*** INFORMATION ENTERED ***"_SRO(SRX)
- +11 SET X=$SELECT(SRTYPE=10:1,1:4)
- SET SRO(SRX)=SRO(SRX)_X
- SET SRMAX=SRX
- +12 WRITE !,SRX_". Occurrence Comments: ",?30,$PIECE(SRO(SRX),"^")
- +13 WRITE !!,SRLINE
- +14 WRITE !!,"Select Occurrence Information: "
- READ X:DTIME
- IF '$TEST!("^"[X)
- if X["^"
- SET SRSOUT=1
- GOTO END
- +15 IF "Aa"[X
- SET X="1:"_SRMAX
- +16 IF X'?.N1":".N
- IF '$DATA(SRO(X))
- DO HELP
- if SRSOUT
- GOTO END
- WRITE @IOF
- GOTO START
- +17 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
- +18 DO HDR^SROAUTL
- WRITE !
- +19 IF X?.N1":".N
- DO RANGE
- GOTO START
- +20 IF $$LOCK^SROUTL(SRTN)
- Begin DoDot:1
- +21 SET SRZ=X
- KILL DIE,DA,DR
- SET DA(1)=SRTN
- SET DA=SRENTRY
- SET DIE="^SRF("_SRTN_","_SRTYPE_","
- +22 SET DR=$PIECE(SRO(X),"^",2)_$SELECT((SRTYPE=16&($PIECE(SRO(X),"^",2)=6))!(SRTYPE=10&($PIECE(SRO(X),"^",2)=4)):"ICD Diagnosis Code "_$$ICDSTR^SROICD(SRTN),1:"T")
- DO ^DIE
- KILL DR,DA
- +23 IF SRZ=3
- IF $PIECE(SR,"^",2)=12
- IF $PIECE(^SRF(SRTN,16,SRENTRY,0),"^",8)<2
- DO YUP
- End DoDot:1
- DO UNLOCK^SROUTL(SRTN)
- if SRZ=2
- DO PRESS
- +24 GOTO START
- +25 QUIT
- ICDSTR ; get diagnosis info
- +1 NEW SRICDSTR
- +2 SET SRICDSTR=$$ICD^SROICD(SRTN,X)
- 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
- +2 SET DR=$PIECE(SRO(EMILY),"^",2)_$SELECT((SRTYPE=16&($PIECE(SRO(EMILY),"^",2)=6))!(SRTYPE=10&($PIECE(SRO(EMILY),"^",2)=4)):"ICD Diagnosis Code "_$$ICDSTR^SROICD(SRTN),1:"T")
- +3 SET DA=SRENTRY
- SET DA(1)=SRTN
- +4 SET DIE="^SRF("_SRTN_","_SRTYPE_","
- +5 DO ^DIE
- KILL DR,DA
- +6 IF '$DATA(^SRF(SRTN,SRTYPE,SRENTRY))!$DATA(DTOUT)!$DATA(Y)
- SET SRSOUT=1
- +7 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
- STROKE DO HDR^SROAUTL
- KILL DIR
- SET DIR(0)="130.22,9"
- SET DIR("A")="Stroke/CVA Duration"
- SET DIR("B")="<24 HOURS"
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)
- SET SRSOUT=1
- QUIT
- +1 KILL DA,DR,DIE
- IF X["^"!(X="@")!(Y=1)
- DO DEL
- SET DA=SRTN
- SET DIE=130
- SET DR="256////N"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +2 SET DA=SRENTRY
- SET DR="9///"_Y
- SET DA(1)=SRTN
- SET DIE="^SRF(SRTN,16,"
- DO ^DIE
- SET SRNEW=0
- KILL DR,DA,DIE
- +3 QUIT
- NMC DO HDR^SROAUTL
- KILL DA,DIE,DR
- +1 SET DA=SRENTRY
- SET DA(1)=SRTN
- SET DR=$SELECT(SRTYPE=10:"5T",1:"15T")
- 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
- UTI DO HDR^SROAUTL
- SET DA=SRENTRY
- SET DA(1)=SRTN
- SET DR="11T;12T;13T;14T;10T"
- SET DIE="^SRF(SRTN,16,"
- DO ^DIE
- KILL DR,DA
- +1 KILL DA,DIE,DR
- SET SRNEW=0
- IF $DATA(DTOUT)!$DATA(Y)
- SET SRSOUT=1
- QUIT
- +2 QUIT
- SR40 ;
- +1 SET Y=$PIECE(SR,"^",10)
- SET C=$PIECE(^DD(130.22,11,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET SRO(3)=Y_"^11"
- +2 SET Y=$PIECE(SR,"^",11)
- SET C=$PIECE(^DD(130.22,12,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET SRO(4)=Y_"^12"
- +3 SET Y=$PIECE(SR,"^",12)
- SET C=$PIECE(^DD(130.22,13,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET SRO(5)=Y_"^13"
- +4 SET Y=$PIECE(SR,"^",13)
- SET C=$PIECE(^DD(130.22,14,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET SRO(6)=Y_"^14"
- +5 SET Y=$PIECE(SR,"^",9)
- SET C=$PIECE(^DD(130.22,10,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET SRO(7)=Y_"^10"
- +6 SET SR(2)=$GET(^SRF(SRTN,SRTYPE,SRENTRY,2))
- SET SRO(8)=$PIECE(SR(2),"^")_"^"_$SELECT(SRTYPE=10:2,1:3)
- +7 SET X=$PIECE(SR,"^",6)
- SET SHEMP=$SELECT(X="U":"UNRESOLVED",X="I":"IMPROVED",X="D":"DEATH",X="W":"WORSE",1:"")
- SET SRO(9)=SHEMP_"^.05"
- +8 KILL SRO(10)
- SET X=$PIECE(SR,"^",7)
- if X
- SET X=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
- SET SRO(10)=X_"^2"
- +9 SET SRX=11
- SET SRO(SRX)="^"
- IF $ORDER(^SRF(SRTN,SRTYPE,SRENTRY,1,0))
- SET SRO(SRX)="*** INFORMATION ENTERED ***"_SRO(SRX)
- +10 SET SRO(SRX)=SRO(SRX)_11
- +11 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
- KILL DIK,DA
- +2 QUIT
- PRESS WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!$DATA(DUOUT)
- SET SRSOUT=1
- +1 QUIT