- SROAPRT7 ;BIR/MAM - PRINT OCCURRENCES ;01/24/07
- ;;3.0; Surgery ;**38,47,57,60,125,160**;24 Jun 93;Build 7
- 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",NYUK=$P(SRA(205),"^",11) D YN S SRAO("2B")=SHEMP_"^412",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),"^",18) D YN S SRAO("3C")=SHEMP_"^255"
- 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 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":7,Y="2C":5,Y="2D":6,1:"") Q:SRI=""
- .I $E(Y)="3" S SRI=$S(Y="3A":8,Y="3B":9,Y="3C":10,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
- 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:",?33,$P(SRAO(1),"^"),?41,"CNS OCCURRENCES:",?74,$P(SRAO(4),"^")
- W !,"Superficial Incisional SSI:",?30,$P(SRAO("1A"),"^"),?41,"Stroke/CVA:",?71,$P(SRAO("4A"),"^")
- 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: ",?33,$P(SRAO(3),"^"),?41,"CARDIAC OCCURRENCES:",?74,$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 !,"Urinary Tract Infection:",?30,$P(SRAO("3C"),"^"),?41,$P(SRAO("5D"),"^")
- I $P(SRAO("3D"),"^")'="" W !,$P(SRAO("3D"),"^")
- W !,?41,"OTHER OCCURRENCES:",?74,$P(SRAO(6),"^")
- W !,"RESPIRATORY OCCURRENCES:",?33,$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 !,"Unplanned Intubation:",?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 (ICD9)"
- 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
- SROAPRT7 ;BIR/MAM - PRINT OCCURRENCES ;01/24/07
- +1 ;;3.0; Surgery ;**38,47,57,60,125,160**;24 Jun 93;Build 7
- +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"
- SET NYUK=$PIECE(SRA(205),"^",11)
- DO YN
- SET SRAO("2B")=SHEMP_"^412"
- SET NYUK=$PIECE(SRA(205),"^",12)
- DO YN
- SET SRAO("2C")=SHEMP_"^252"
- +6 SET NYUK=$PIECE(SRA(205),"^",13)
- DO YN
- SET SRAO("2D")=SHEMP_"^285"
- +7 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),"^",18)
- DO YN
- SET SRAO("3C")=SHEMP_"^255"
- +8 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"
- +9 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"
- +10 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"
- +11 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"
- +12 KILL SROOC
- NEW SRSEP,SRSTAR
- +13 DO OCC^SROAUTL0
- +14 SET X=$GET(SROOC(21))
- IF X'=""
- SET X=$PIECE($GET(SROOC(21)),U)_" "_$EXTRACT($PIECE($GET(SROOC(21)),U,2),1,17)
- +15 SET SRAO("6G")=X_"^392"
- +16 SET X=$GET(SROOC(29))
- IF X'=""
- SET X=$PIECE($GET(SROOC(29)),U)_" "_$EXTRACT($PIECE($GET(SROOC(29)),U,2),1,17)
- +17 SET SRAO("2E")=X_"^253"
- +18 SET X=$GET(SROOC(30))
- IF X'=""
- SET X=$PIECE($GET(SROOC(30)),U)_" "_$EXTRACT($PIECE($GET(SROOC(30)),U,2),1,17)
- +19 SET SRAO("4D")=X_"^343"
- +20 SET X=$GET(SROOC(31))
- IF X'=""
- SET X=$PIECE($GET(SROOC(31)),U)_" "_$EXTRACT($PIECE($GET(SROOC(31)),U,2),1,17)
- +21 SET SRAO("3D")=X_"^286"
- +22 SET X=$GET(SROOC(32))
- IF X'=""
- SET X=$PIECE($GET(SROOC(32)),U)_" "_$EXTRACT($PIECE($GET(SROOC(32)),U,2),1,17)
- +23 SET SRAO("5D")=X_"^344"
- +24 SET X=$GET(SROOC(36))
- IF X'=""
- SET X=$PIECE($GET(SROOC(36)),U)_" "_$EXTRACT($PIECE($GET(SROOC(36)),U,2),1,17)
- +25 SET SRAO("1D")=X_"^489"
- +26 SET Y=6
- FOR
- SET Y=$ORDER(SRAO(Y))
- IF Y=""
- QUIT
- Begin DoDot:1
- +27 IF $EXTRACT(Y)="1"
- SET SRI=$SELECT(Y="1A":1,Y="1B":2,Y="1C":22,1:"")
- IF SRI=""
- QUIT
- +28 IF $EXTRACT(Y)="2"
- SET SRI=$SELECT(Y="2A":4,Y="2B":7,Y="2C":5,Y="2D":6,1:"")
- IF SRI=""
- QUIT
- +29 IF $EXTRACT(Y)="3"
- SET SRI=$SELECT(Y="3A":8,Y="3B":9,Y="3C":10,1:"")
- IF SRI=""
- QUIT
- +30 IF $EXTRACT(Y)="4"
- SET SRI=$SELECT(Y="4A":12,Y="4B":13,Y="4C":14,1:"")
- IF SRI=""
- QUIT
- +31 IF $EXTRACT(Y)="5"
- SET SRI=$SELECT(Y="5A":16,Y="5B":17,Y="5C":11,1:"")
- IF SRI=""
- QUIT
- +32 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
- +33 SET SRIN=Y
- IF SROC(SRI)=" "&($PIECE(SRAO(SRIN),"^")="YES")
- SET $PIECE(SRAO(SRIN),"^")="ND"
- +34 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
- +35 IF $GET(SRSEP)'=""
- SET X=$PIECE(SRAO("6D"),"^")
- SET $PIECE(SRAO("6D"),"^")=SRSEP_" "_X
- +36 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
- +37 SET SRSTAR=1
- IF SROC(SRKO)=" "
- SET SRD="NO DATE"
- +38 IF SROC(SRKO)'=" "
- SET SRD=$EXTRACT(SROC(SRKO),4,5)_"/"_$EXTRACT(SROC(SRKO),6,7)_"/"_$EXTRACT(SROC(SRKO),2,3)
- +39 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:",?33,$PIECE(SRAO(1),"^"),?41,"CNS OCCURRENCES:",?74,$PIECE(SRAO(4),"^")
- +1 WRITE !,"Superficial Incisional SSI:",?30,$PIECE(SRAO("1A"),"^"),?41,"Stroke/CVA:",?71,$PIECE(SRAO("4A"),"^")
- +2 WRITE !,"Deep Incisional SSI:",?30,$PIECE(SRAO("1B"),"^"),?41,"Coma > 24 Hours:",?71,$PIECE(SRAO("4B"),"^")
- +3 WRITE !,"Wound Disruption:",?30,$PIECE(SRAO("1C"),"^"),?41,"Peripheral Nerve Injury:",?71,$PIECE(SRAO("4C"),"^")
- +4 IF $PIECE(SRAO("1D"),"^")'=""!($PIECE(SRAO("4D"),"^")'="")
- WRITE !,$PIECE(SRAO("1D"),"^"),?41,$PIECE(SRAO("4D"),"^")
- +5 WRITE !!,"URINARY TRACT OCCURRENCES: ",?33,$PIECE(SRAO(3),"^"),?41,"CARDIAC OCCURRENCES:",?74,$PIECE(SRAO(5),"^")
- +6 WRITE !,"Renal Insufficiency: ",?30,$PIECE(SRAO("3A"),"^"),?41,"Arrest Requiring CPR:",?71,$PIECE(SRAO("5A"),"^")
- +7 WRITE !,"Acute Renal Failure:",?30,$PIECE(SRAO("3B"),"^"),?41,"Myocardial Infarction:",?71,$PIECE(SRAO("5B"),"^")
- +8 WRITE !,"Urinary Tract Infection:",?30,$PIECE(SRAO("3C"),"^"),?41,$PIECE(SRAO("5D"),"^")
- +9 IF $PIECE(SRAO("3D"),"^")'=""
- WRITE !,$PIECE(SRAO("3D"),"^")
- +10 WRITE !,?41,"OTHER OCCURRENCES:",?74,$PIECE(SRAO(6),"^")
- +11 WRITE !,"RESPIRATORY OCCURRENCES:",?33,$PIECE(SRAO(2),"^"),?41,"Bleeding/Transfusions:",?71,$PIECE(SRAO("6A"),"^")
- +12 WRITE !,"Pneumonia:",?30,$PIECE(SRAO("2A"),"^"),?41,"Graft/Prosthesis/Flap Failure:",?71,$PIECE(SRAO("6B"),"^")
- +13 WRITE !,"Unplanned Intubation:",?30,$PIECE(SRAO("2B"),"^"),?41,"DVT/Thrombophlebitis:",?71,$PIECE(SRAO("6C"),"^")
- +14 WRITE !,"Pulmonary Embolism:",?30,$PIECE(SRAO("2C"),"^"),?41,"Systemic Sepsis: "
- Begin DoDot:1
- +15 IF $PIECE(SRAO("6D"),"^")=" NO"
- WRITE ?71,$PIECE(SRAO("6D"),"^")
- QUIT
- +16 WRITE $JUSTIFY($PIECE(SRAO("6D"),"^"),21)
- End DoDot:1
- +17 WRITE !,"On Ventilator > 48 Hours:",?30,$PIECE(SRAO("2D"),"^"),?41,"Organ/Space SSI:",?71,$PIECE(SRAO("6E"),"^")
- +18 WRITE !,$PIECE(SRAO("2E"),"^"),?41,"C. difficile Colitis:",?71,$PIECE(SRAO("6F"),"^")
- +19 WRITE !,?41,$PIECE(SRAO("6G"),"^")
- +20 IF $GET(SRSTAR)
- WRITE !,"* indicates Other (ICD9)"
- +21 IF $EXTRACT(IOST)="C"
- WRITE !!
- KILL DIR
- SET DIR(0)="FOA"
- SET DIR("A")="Press RETURN to continue"
- DO ^DIR
- KILL DIR
- +22 QUIT
- YN SET SHEMP=$SELECT(NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:"")
- +1 QUIT
