SROAPRT7 ;BIR/MAM - PRINT OCCURRENCES ;08/16/2011
;;3.0;Surgery;**38,47,57,60,125,160,176,177,182,184**;24 Jun 93;Build 35
K SRA,SRAO D EN^SROCCAT S SRA(205)=$G(^SRF(SRTN,205))
S NYUK=$P(SRA(205),"^",5) D YN S SRAO(1)=SHEMP_"^403",NYUK=$P(SRA(205),"^",6) D YN S SRAO("1A")=SHEMP_"^248",NYUK=$P(SRA(205),"^",7) D YN S SRAO("1B")=SHEMP_"^249"
S NYUK=$P(SRA(205),"^",37) D YN S SRAO("6E")=SHEMP_"^488",NYUK=$P(SRA(205),"^",8) D YN S SRAO("1C")=SHEMP_"^404",NYUK=$P(SRA(205),"^",39) D YN S SRAO("6F")=SHEMP_"^447"
S NYUK=$P(SRA(205),"^",9) D YN S SRAO(2)=SHEMP_"^318",NYUK=$P(SRA(205),"^",10) D YN S SRAO("2A")=SHEMP_"^251"
S NYUK=$P(SRA(205),"^",44) D YN S SRAO("2B")=SHEMP_"^422"
S NYUK=$P(SRA(205),"^",12) D YN S SRAO("2C")=SHEMP_"^252"
S NYUK=$P(SRA(205),"^",13) D YN S SRAO("2D")=SHEMP_"^285"
S NYUK=$P(SRA(205),"^",15) D YN S SRAO(3)=SHEMP_"^319",NYUK=$P(SRA(205),"^",16) D YN S SRAO("3A")=SHEMP_"^409",NYUK=$P(SRA(205),"^",17) D YN S SRAO("3B")=SHEMP_"^254",NYUK=$P(SRA(205),"^",42) D YN S SRAO("3C")=SHEMP_"^644"
S NYUK=$P(SRA(205),"^",20) D YN S SRAO(4)=SHEMP_"^320",NYUK=$P(SRA(205),"^",21) D YN S SRAO("4A")=SHEMP_"^256",NYUK=$P(SRA(205),"^",22) D YN S SRAO("4B")=SHEMP_"^410",NYUK=$P(SRA(205),"^",23) D YN S SRAO("4C")=SHEMP_"^287"
S NYUK=$P(SRA(205),"^",25) D YN S SRAO(5)=SHEMP_"^321",NYUK=$P(SRA(205),"^",26) D YN S SRAO("5A")=SHEMP_"^411",NYUK=$P(SRA(205),"^",27) D YN S SRAO("5B")=SHEMP_"^258",NYUK=$P(SRA(205),"^",28) D YN S SRAO("5C")=SHEMP_"^259"
S NYUK=$P(SRA(205),"^",30) D YN S SRAO(6)=SHEMP_"^322",NYUK=$P(SRA(205),"^",32) D YN S SRAO("6A")=SHEMP_"^257"
S NYUK=$P(SRA(205),"^",33) D YN S SRAO("6B")=SHEMP_"^261",NYUK=$P(SRA(205),"^",34) D YN S SRAO("6C")=SHEMP_"^263",NYUK=$P(SRA(205),"^",35) D YN S SRAO("6D")=SHEMP_"^250"
K SROOC N SRDUR,SRSEP,SRSTAR
D OCC^SROAUTL0
S X=$G(SROOC(21)) I X'="" S X=$P($G(SROOC(21)),U)_" "_$E($P($G(SROOC(21)),U,2),1,17)
S SRAO("6G")=X_"^392"
S X=$G(SROOC(29)) I X'="" S X=$P($G(SROOC(29)),U)_" "_$E($P($G(SROOC(29)),U,2),1,17)
S SRAO("2E")=X_"^253"
S X=$G(SROOC(30)) I X'="" S X=$P($G(SROOC(30)),U)_" "_$E($P($G(SROOC(30)),U,2),1,17)
S SRAO("4D")=X_"^343"
S X=$G(SROOC(31)) I X'="" S X=$P($G(SROOC(31)),U)_" "_$E($P($G(SROOC(31)),U,2),1,17)
S SRAO("3D")=X_"^286"
S X=$G(SROOC(32)) I X'="" S X=$P($G(SROOC(32)),U)_" "_$E($P($G(SROOC(32)),U,2),1,17)
S SRAO("5D")=X_"^344"
S X=$G(SROOC(36)) I X'="" S X=$P($G(SROOC(36)),U)_" "_$E($P($G(SROOC(36)),U,2),1,17)
S SRAO("1D")=X_"^489"
S Y=6 F S Y=$O(SRAO(Y)) Q:Y="" D
.I $E(Y)="1" S SRI=$S(Y="1A":1,Y="1B":2,Y="1C":22,1:"") Q:SRI=""
.I $E(Y)="2" S SRI=$S(Y="2A":4,Y="2B":42,Y="2C":5,Y="2D":6,1:"") Q:SRI=""
.I $E(Y)="3" S SRI=$S(Y="3A":8,Y="3B":9,Y="3C":40,1:"") Q:SRI=""
.I $E(Y)="4" S SRI=$S(Y="4A":12,Y="4B":13,Y="4C":14,1:"") Q:SRI=""
.I $E(Y)="5" S SRI=$S(Y="5A":16,Y="5B":17,Y="5C":11,1:"") Q:SRI=""
.I $E(Y)="6" S SRI=$S(Y="6A":15,Y="6B":19,Y="6C":20,Y="6D":3,Y="6E":35,Y="6F":38,1:"") Q:SRI=""
.S SRIN=Y I SROC(SRI)=" "&($P(SRAO(SRIN),"^")="YES") S $P(SRAO(SRIN),"^")="ND"
.S $P(SRAO(SRIN),"^")=$S($P(SRAO(SRIN),"^")="YES":$E(SROC(SRI),4,5)_"/"_$E(SROC(SRI),6,7)_"/"_$E(SROC(SRI),2,3),$P(SRAO(SRIN),"^")="NO":" "_$P(SRAO(SRIN),"^"),$P(SRAO(SRIN),"^")="ND":" NO DATE",1:$P(SRAO(SRIN),"^"))
I $G(SRSEP)'="" S X=$P(SRAO("6D"),"^"),$P(SRAO("6D"),"^")=SRSEP_" "_X
I $G(SRDUR)'="" S X=$P(SRAO("4A"),"^"),$P(SRAO("4A"),"^")=SRDUR_" "_X
F SRK="1D","4D","3D","5D","2E","6G" S SRKO=$S(SRK="4D":30,SRK="3D":31,SRK="5D":32,SRK="2E":29,SRK="6G":21,SRK="1D":36,1:"") I $P(SRAO(SRK),"^")'="" D
.S SRSTAR=1 I SROC(SRKO)=" " S SRD="NO DATE"
.I SROC(SRKO)'=" " S SRD=$E(SROC(SRKO),4,5)_"/"_$E(SROC(SRKO),6,7)_"/"_$E(SROC(SRKO),2,3)
.S $P(SRAO(SRK),"^")="* "_$P(SRAO(SRK),"^")_$J(SRD,(26-$L($P(SRAO(SRK),"^")))+10)
DISP W:$E(IOST)'="C" ! W !,?21,"PERIOPERATIVE OCCURRENCE INFORMATION",!!,"WOUND OCCURRENCES:",?30,$P(SRAO(1),"^"),?41,"CNS OCCURRENCES:",?71,$P(SRAO(4),"^")
W !,"Superficial Incisional SSI:",?30,$P(SRAO("1A"),"^"),?41,"Stroke/CVA:" D
.I $P(SRAO("4A"),"^")=" NO" W ?68,"NO SYMPTOMS" Q
.W ?58,$J($P(SRAO("4A"),"^"),21)
W !,"Deep Incisional SSI:",?30,$P(SRAO("1B"),"^"),?41,"Coma > 24 Hours:",?71,$P(SRAO("4B"),"^")
W !,"Wound Disruption:",?30,$P(SRAO("1C"),"^"),?41,"Peripheral Nerve Injury:",?71,$P(SRAO("4C"),"^")
I $P(SRAO("1D"),"^")'=""!($P(SRAO("4D"),"^")'="") W !,$P(SRAO("1D"),"^"),?41,$P(SRAO("4D"),"^")
W !!,"URINARY TRACT OCCURRENCES: ",?30,$P(SRAO(3),"^"),?41,"CARDIAC OCCURRENCES:",?71,$P(SRAO(5),"^")
W !,"Renal Insufficiency: ",?30,$P(SRAO("3A"),"^"),?41,"Arrest Requiring CPR:",?71,$P(SRAO("5A"),"^")
W !,"Acute Renal Failure:",?30,$P(SRAO("3B"),"^"),?41,"Myocardial Infarction:",?71,$P(SRAO("5B"),"^")
W !,"Symptomatic UTI:",?30,$P(SRAO("3C"),"^"),?41,$P(SRAO("5D"),"^")
I $P(SRAO("3D"),"^")'="" W !,$P(SRAO("3D"),"^")
W !,?41,"OTHER OCCURRENCES:",?71,$P(SRAO(6),"^")
W !,"RESPIRATORY OCCURRENCES:",?30,$P(SRAO(2),"^"),?41,"Bleeding/Transfusions:",?71,$P(SRAO("6A"),"^")
W !,"Pneumonia:",?30,$P(SRAO("2A"),"^"),?41,"Graft/Prosthesis/Flap Failure:",?71,$P(SRAO("6B"),"^")
W !,"Out Of OR Unplanned Intub:",?30,$P(SRAO("2B"),"^"),?41,"DVT/Thrombophlebitis:",?71,$P(SRAO("6C"),"^")
W !,"Pulmonary Embolism:",?30,$P(SRAO("2C"),"^"),?41,"Systemic Sepsis: " D
.I $P(SRAO("6D"),"^")=" NO" W ?71,$P(SRAO("6D"),"^") Q
.W $J($P(SRAO("6D"),"^"),21)
W !,"On Ventilator > 48 Hours:",?30,$P(SRAO("2D"),"^"),?41,"Organ/Space SSI:",?71,$P(SRAO("6E"),"^")
W !,$P(SRAO("2E"),"^"),?41,"C. difficile Colitis:",?71,$P(SRAO("6F"),"^")
W !,?41,$P(SRAO("6G"),"^")
I $G(SRSTAR) W !,"* indicates Other "_$$ICDSTR^SROICD(SRTN)
I $E(IOST)="C" W !! K DIR S DIR(0)="FOA",DIR("A")="Press RETURN to continue" D ^DIR K DIR
Q
YN S SHEMP=$S(NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:"")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROAPRT7 5839 printed Oct 16, 2024@18:42:25 Page 2
SROAPRT7 ;BIR/MAM - PRINT OCCURRENCES ;08/16/2011
+1 ;;3.0;Surgery;**38,47,57,60,125,160,176,177,182,184**;24 Jun 93;Build 35
+2 KILL SRA,SRAO
DO EN^SROCCAT
SET SRA(205)=$GET(^SRF(SRTN,205))
+3 SET NYUK=$PIECE(SRA(205),"^",5)
DO YN
SET SRAO(1)=SHEMP_"^403"
SET NYUK=$PIECE(SRA(205),"^",6)
DO YN
SET SRAO("1A")=SHEMP_"^248"
SET NYUK=$PIECE(SRA(205),"^",7)
DO YN
SET SRAO("1B")=SHEMP_"^249"
+4 SET NYUK=$PIECE(SRA(205),"^",37)
DO YN
SET SRAO("6E")=SHEMP_"^488"
SET NYUK=$PIECE(SRA(205),"^",8)
DO YN
SET SRAO("1C")=SHEMP_"^404"
SET NYUK=$PIECE(SRA(205),"^",39)
DO YN
SET SRAO("6F")=SHEMP_"^447"
+5 SET NYUK=$PIECE(SRA(205),"^",9)
DO YN
SET SRAO(2)=SHEMP_"^318"
SET NYUK=$PIECE(SRA(205),"^",10)
DO YN
SET SRAO("2A")=SHEMP_"^251"
+6 SET NYUK=$PIECE(SRA(205),"^",44)
DO YN
SET SRAO("2B")=SHEMP_"^422"
+7 SET NYUK=$PIECE(SRA(205),"^",12)
DO YN
SET SRAO("2C")=SHEMP_"^252"
+8 SET NYUK=$PIECE(SRA(205),"^",13)
DO YN
SET SRAO("2D")=SHEMP_"^285"
+9 SET NYUK=$PIECE(SRA(205),"^",15)
DO YN
SET SRAO(3)=SHEMP_"^319"
SET NYUK=$PIECE(SRA(205),"^",16)
DO YN
SET SRAO("3A")=SHEMP_"^409"
SET NYUK=$PIECE(SRA(205),"^",17)
DO YN
SET SRAO("3B")=SHEMP_"^254"
SET NYUK=$PIECE(SRA(205),"^",42)
DO YN
SET SRAO("3C")=SHEMP_"^644"
+10 SET NYUK=$PIECE(SRA(205),"^",20)
DO YN
SET SRAO(4)=SHEMP_"^320"
SET NYUK=$PIECE(SRA(205),"^",21)
DO YN
SET SRAO("4A")=SHEMP_"^256"
SET NYUK=$PIECE(SRA(205),"^",22)
DO YN
SET SRAO("4B")=SHEMP_"^410"
SET NYUK=$PIECE(SRA(205),"^",23)
DO YN
SET SRAO("4C")=SHEMP_"^287"
+11 SET NYUK=$PIECE(SRA(205),"^",25)
DO YN
SET SRAO(5)=SHEMP_"^321"
SET NYUK=$PIECE(SRA(205),"^",26)
DO YN
SET SRAO("5A")=SHEMP_"^411"
SET NYUK=$PIECE(SRA(205),"^",27)
DO YN
SET SRAO("5B")=SHEMP_"^258"
SET NYUK=$PIECE(SRA(205),"^",28)
DO YN
SET SRAO("5C")=SHEMP_"^259"
+12 SET NYUK=$PIECE(SRA(205),"^",30)
DO YN
SET SRAO(6)=SHEMP_"^322"
SET NYUK=$PIECE(SRA(205),"^",32)
DO YN
SET SRAO("6A")=SHEMP_"^257"
+13 SET NYUK=$PIECE(SRA(205),"^",33)
DO YN
SET SRAO("6B")=SHEMP_"^261"
SET NYUK=$PIECE(SRA(205),"^",34)
DO YN
SET SRAO("6C")=SHEMP_"^263"
SET NYUK=$PIECE(SRA(205),"^",35)
DO YN
SET SRAO("6D")=SHEMP_"^250"
+14 KILL SROOC
NEW SRDUR,SRSEP,SRSTAR
+15 DO OCC^SROAUTL0
+16 SET X=$GET(SROOC(21))
IF X'=""
SET X=$PIECE($GET(SROOC(21)),U)_" "_$EXTRACT($PIECE($GET(SROOC(21)),U,2),1,17)
+17 SET SRAO("6G")=X_"^392"
+18 SET X=$GET(SROOC(29))
IF X'=""
SET X=$PIECE($GET(SROOC(29)),U)_" "_$EXTRACT($PIECE($GET(SROOC(29)),U,2),1,17)
+19 SET SRAO("2E")=X_"^253"
+20 SET X=$GET(SROOC(30))
IF X'=""
SET X=$PIECE($GET(SROOC(30)),U)_" "_$EXTRACT($PIECE($GET(SROOC(30)),U,2),1,17)
+21 SET SRAO("4D")=X_"^343"
+22 SET X=$GET(SROOC(31))
IF X'=""
SET X=$PIECE($GET(SROOC(31)),U)_" "_$EXTRACT($PIECE($GET(SROOC(31)),U,2),1,17)
+23 SET SRAO("3D")=X_"^286"
+24 SET X=$GET(SROOC(32))
IF X'=""
SET X=$PIECE($GET(SROOC(32)),U)_" "_$EXTRACT($PIECE($GET(SROOC(32)),U,2),1,17)
+25 SET SRAO("5D")=X_"^344"
+26 SET X=$GET(SROOC(36))
IF X'=""
SET X=$PIECE($GET(SROOC(36)),U)_" "_$EXTRACT($PIECE($GET(SROOC(36)),U,2),1,17)
+27 SET SRAO("1D")=X_"^489"
+28 SET Y=6
FOR
SET Y=$ORDER(SRAO(Y))
if Y=""
QUIT
Begin DoDot:1
+29 IF $EXTRACT(Y)="1"
SET SRI=$SELECT(Y="1A":1,Y="1B":2,Y="1C":22,1:"")
if SRI=""
QUIT
+30 IF $EXTRACT(Y)="2"
SET SRI=$SELECT(Y="2A":4,Y="2B":42,Y="2C":5,Y="2D":6,1:"")
if SRI=""
QUIT
+31 IF $EXTRACT(Y)="3"
SET SRI=$SELECT(Y="3A":8,Y="3B":9,Y="3C":40,1:"")
if SRI=""
QUIT
+32 IF $EXTRACT(Y)="4"
SET SRI=$SELECT(Y="4A":12,Y="4B":13,Y="4C":14,1:"")
if SRI=""
QUIT
+33 IF $EXTRACT(Y)="5"
SET SRI=$SELECT(Y="5A":16,Y="5B":17,Y="5C":11,1:"")
if SRI=""
QUIT
+34 IF $EXTRACT(Y)="6"
SET SRI=$SELECT(Y="6A":15,Y="6B":19,Y="6C":20,Y="6D":3,Y="6E":35,Y="6F":38,1:"")
if SRI=""
QUIT
+35 SET SRIN=Y
IF SROC(SRI)=" "&($PIECE(SRAO(SRIN),"^")="YES")
SET $PIECE(SRAO(SRIN),"^")="ND"
+36 SET $PIECE(SRAO(SRIN),"^")=$SELECT($PIECE(SRAO(SRIN),"^")="YES":$EXTRACT(SROC(SRI),4,5)_"/"_$EXTRACT(SROC(SRI),6,7)_"/"_$EXTRACT(SROC(SRI),2,3),$PIECE(SRAO(SRIN),"^")="NO":" "_...
... $PIECE(SRAO(SRIN),"^"),$PIECE(SRAO(SRIN),"^")="ND":" NO DATE",1:$PIECE(SRAO(SRIN),"^"))
End DoDot:1
+37 IF $GET(SRSEP)'=""
SET X=$PIECE(SRAO("6D"),"^")
SET $PIECE(SRAO("6D"),"^")=SRSEP_" "_X
+38 IF $GET(SRDUR)'=""
SET X=$PIECE(SRAO("4A"),"^")
SET $PIECE(SRAO("4A"),"^")=SRDUR_" "_X
+39 FOR SRK="1D","4D","3D","5D","2E","6G"
SET SRKO=$SELECT(SRK="4D":30,SRK="3D":31,SRK="5D":32,SRK="2E":29,SRK="6G":21,SRK="1D":36,1:"")
IF $PIECE(SRAO(SRK),"^")'=""
Begin DoDot:1
+40 SET SRSTAR=1
IF SROC(SRKO)=" "
SET SRD="NO DATE"
+41 IF SROC(SRKO)'=" "
SET SRD=$EXTRACT(SROC(SRKO),4,5)_"/"_$EXTRACT(SROC(SRKO),6,7)_"/"_$EXTRACT(SROC(SRKO),2,3)
+42 SET $PIECE(SRAO(SRK),"^")="* "_$PIECE(SRAO(SRK),"^")_$JUSTIFY(SRD,(26-$LENGTH($PIECE(SRAO(SRK),"^")))+10)
End DoDot:1
DISP if $EXTRACT(IOST)'="C"
WRITE !
WRITE !,?21,"PERIOPERATIVE OCCURRENCE INFORMATION",!!,"WOUND OCCURRENCES:",?30,$PIECE(SRAO(1),"^"),?41,"CNS OCCURRENCES:",?71,$PIECE(SRAO(4),"^")
+1 WRITE !,"Superficial Incisional SSI:",?30,$PIECE(SRAO("1A"),"^"),?41,"Stroke/CVA:"
Begin DoDot:1
+2 IF $PIECE(SRAO("4A"),"^")=" NO"
WRITE ?68,"NO SYMPTOMS"
QUIT
+3 WRITE ?58,$JUSTIFY($PIECE(SRAO("4A"),"^"),21)
End DoDot:1
+4 WRITE !,"Deep Incisional SSI:",?30,$PIECE(SRAO("1B"),"^"),?41,"Coma > 24 Hours:",?71,$PIECE(SRAO("4B"),"^")
+5 WRITE !,"Wound Disruption:",?30,$PIECE(SRAO("1C"),"^"),?41,"Peripheral Nerve Injury:",?71,$PIECE(SRAO("4C"),"^")
+6 IF $PIECE(SRAO("1D"),"^")'=""!($PIECE(SRAO("4D"),"^")'="")
WRITE !,$PIECE(SRAO("1D"),"^"),?41,$PIECE(SRAO("4D"),"^")
+7 WRITE !!,"URINARY TRACT OCCURRENCES: ",?30,$PIECE(SRAO(3),"^"),?41,"CARDIAC OCCURRENCES:",?71,$PIECE(SRAO(5),"^")
+8 WRITE !,"Renal Insufficiency: ",?30,$PIECE(SRAO("3A"),"^"),?41,"Arrest Requiring CPR:",?71,$PIECE(SRAO("5A"),"^")
+9 WRITE !,"Acute Renal Failure:",?30,$PIECE(SRAO("3B"),"^"),?41,"Myocardial Infarction:",?71,$PIECE(SRAO("5B"),"^")
+10 WRITE !,"Symptomatic UTI:",?30,$PIECE(SRAO("3C"),"^"),?41,$PIECE(SRAO("5D"),"^")
+11 IF $PIECE(SRAO("3D"),"^")'=""
WRITE !,$PIECE(SRAO("3D"),"^")
+12 WRITE !,?41,"OTHER OCCURRENCES:",?71,$PIECE(SRAO(6),"^")
+13 WRITE !,"RESPIRATORY OCCURRENCES:",?30,$PIECE(SRAO(2),"^"),?41,"Bleeding/Transfusions:",?71,$PIECE(SRAO("6A"),"^")
+14 WRITE !,"Pneumonia:",?30,$PIECE(SRAO("2A"),"^"),?41,"Graft/Prosthesis/Flap Failure:",?71,$PIECE(SRAO("6B"),"^")
+15 WRITE !,"Out Of OR Unplanned Intub:",?30,$PIECE(SRAO("2B"),"^"),?41,"DVT/Thrombophlebitis:",?71,$PIECE(SRAO("6C"),"^")
+16 WRITE !,"Pulmonary Embolism:",?30,$PIECE(SRAO("2C"),"^"),?41,"Systemic Sepsis: "
Begin DoDot:1
+17 IF $PIECE(SRAO("6D"),"^")=" NO"
WRITE ?71,$PIECE(SRAO("6D"),"^")
QUIT
+18 WRITE $JUSTIFY($PIECE(SRAO("6D"),"^"),21)
End DoDot:1
+19 WRITE !,"On Ventilator > 48 Hours:",?30,$PIECE(SRAO("2D"),"^"),?41,"Organ/Space SSI:",?71,$PIECE(SRAO("6E"),"^")
+20 WRITE !,$PIECE(SRAO("2E"),"^"),?41,"C. difficile Colitis:",?71,$PIECE(SRAO("6F"),"^")
+21 WRITE !,?41,$PIECE(SRAO("6G"),"^")
+22 IF $GET(SRSTAR)
WRITE !,"* indicates Other "_$$ICDSTR^SROICD(SRTN)
+23 IF $EXTRACT(IOST)="C"
WRITE !!
KILL DIR
SET DIR(0)="FOA"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
KILL DIR
+24 QUIT
YN SET SHEMP=$SELECT(NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:"")
+1 QUIT
