Routine: SR153UTL

SR153UTL ;BIR/ADM - SR*3*153 UTILITY ROUTINE ;02/24/06

 ;;3.0; Surgery ;**153**;24 Jun 93;Build 11

PRE ; pre-install action for SR*3*153

 ; delete data from file 136.5  and re-initialize file

 K ^SRO(136.5) S ^SRO(136.5,0)="PERIOPERATIVE OCCURRENCE CATEGORY^136.5I^^"

 ;delete DD for modified field #202

 S DIK="^DD(130,",DA=202,DA(1)=130 D ^DIK

POST ; add ANION GAP to file 139.2

 N SRI

 I $G(^SRO(139.2,26,0))'="ANION GAP" D

 .S DA=26,DIK="^SRO(139.2," D ^DIK

 .S ^SRO(139.2,26,0)="ANION GAP",^SRO(139.2,26,2)=72

 .S DIK="^SRO(139.2,",DIK(1)=".01" D ENALL^DIK K DA,DIK

 ; add HEMOGLOBIN A1C to file 139.2

 I $G(^SRO(139.2,27,0))'="HEMOGLOBIN A1C" D

 .S DA=27,DIK="^SRO(139.2," D ^DIK

 .S ^SRO(139.2,27,0)="HEMOGLOBIN A1C",^SRO(139.2,27,2)=70

 .S DIK="^SRO(139.2,",DIK(1)=".01" D ENALL^DIK K DA,DIK

 ;VALVE REPAIR field (#370), convert any existing N's to '5' for NONE

 ;NUM OF PRIOR HEART SURGERIES (#352), convert any existing N's to '0' for NONE

 ;CURRENT SMOKER field (#202), existing data for CICSP in this field will be placed in CURRENT SMOKER (CARDIAC) field (#510)

 S SRTN=0 F  S SRTN=$O(^SRF(SRTN)) Q:'SRTN  D

 .I $P($G(^SRF(SRTN,207)),"^",6)="N" S $P(^(207),"^",6)=5

 .I $P($G(^SRF(SRTN,206)),"^",15)="N" S $P(^(206),"^",15)=0

 .S SRI=$P($G(^SRF(SRTN,200)),"^",3) I SRI>0 S $P(^SRF(SRTN,200.1),"^",5)=SRI,$P(^SRF(SRTN,200),"^",3)=""

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSR153UTL   1390     printed  Mar 13, 2025@21:43:13                                                                                                                                                                                                    Page 2

SR153UTL  ;BIR/ADM - SR*3*153 UTILITY ROUTINE ;02/24/06

 +1       ;;3.0; Surgery ;**153**;24 Jun 93;Build 11

 +2        QUIT

PRE       ; pre-install action for SR*3*153

 +1       ;

 +2       ; delete data from file 136.5  and re-initialize file

 +3        KILL ^SRO(136.5)

           SET ^SRO(136.5,0)="PERIOPERATIVE OCCURRENCE CATEGORY^136.5I^^"

 +4       ;delete DD for modified field #202

 +5        SET DIK="^DD(130,"

           SET DA=202

           SET DA(1)=130

           DO ^DIK

 +6        QUIT

POST      ; add ANION GAP to file 139.2

 +1        NEW SRI

 +2        IF $GET(^SRO(139.2,26,0))'="ANION GAP"

               Begin DoDot:1

 +3                SET DA=26

                   SET DIK="^SRO(139.2,"

                   DO ^DIK

 +4                SET ^SRO(139.2,26,0)="ANION GAP"

                   SET ^SRO(139.2,26,2)=72

 +5                SET DIK="^SRO(139.2,"

                   SET DIK(1)=".01"

                   DO ENALL^DIK

                   KILL DA,DIK

               End DoDot:1

 +6       ; add HEMOGLOBIN A1C to file 139.2

 +7        IF $GET(^SRO(139.2,27,0))'="HEMOGLOBIN A1C"

               Begin DoDot:1

 +8                SET DA=27

                   SET DIK="^SRO(139.2,"

                   DO ^DIK

 +9                SET ^SRO(139.2,27,0)="HEMOGLOBIN A1C"

                   SET ^SRO(139.2,27,2)=70

 +10               SET DIK="^SRO(139.2,"

                   SET DIK(1)=".01"

                   DO ENALL^DIK

                   KILL DA,DIK

               End DoDot:1

 +11      ;

 +12      ;VALVE REPAIR field (#370), convert any existing N's to '5' for NONE

 +13      ;NUM OF PRIOR HEART SURGERIES (#352), convert any existing N's to '0' for NONE

 +14      ;CURRENT SMOKER field (#202), existing data for CICSP in this field will be placed in CURRENT SMOKER (CARDIAC) field (#510)

 +15       SET SRTN=0

FOR

               SET SRTN=$ORDER(^SRF(SRTN))

               if 'SRTN

                   QUIT

               Begin DoDot:1

 +16               IF $PIECE($GET(^SRF(SRTN,207)),"^",6)="N"

                       SET $PIECE(^(207),"^",6)=5

 +17               IF $PIECE($GET(^SRF(SRTN,206)),"^",15)="N"

                       SET $PIECE(^(206),"^",15)=0

 +18               SET SRI=$PIECE($GET(^SRF(SRTN,200)),"^",3)

                   IF SRI>0

                       SET $PIECE(^SRF(SRTN,200.1),"^",5)=SRI

                       SET $PIECE(^SRF(SRTN,200),"^",3)=""

               End DoDot:1

 +19       QUIT

SR153UTL.m