OOPSXP5.m

OOPSXP5 ;WCIOFO/LLH - INIT ROUTINE FOR VISN 2 INTEGRATION; 09/20/99

 ;;1.0;ASISTS;**5**;Jun 01, 1998

 ;

 ;  This is the Pre-Init for OOPS*1*5

 ;  It will be used to populate blank STATION NUMBER fields in 

 ;  ^OOPS(2260 file.

 ;

PRE ; Pre-Init to Convert Station Number

 ; First assure ^DD(2260,13 has not been changed - implies conv run

 D FIELD^DID(2260,13,"","TYPE","ARR")

 I ARR("TYPE")'="FREE TEXT" QUIT

 S FAC=XPDQUES("PRE1")

 I $G(FAC)="" QUIT

 S IEN=0

 ; Loop thru file, if Station # blank, stuff with FAC

 ; if Station has a value, convert to pointer

 F  S IEN=$O(^OOPS(2260,IEN)) Q:IEN'>0  D

 . D GETS^DIQ(2260,IEN,13,"IE","ARR")

 . S STA=$G(ARR(2260,IEN_",",13,"I"))

 . I $G(STA)'="" D

 .. I ARR(2260,IEN_",",13,"E")'=ARR(2260,IEN_",",13,"I") Q

 .. I $O(^DIC(4,"D",STA,""))="" D

 ... S CASE=$$GET1^DIQ(2260,IEN,.01,"E")

 ... S MES="Station # for Case #: "_CASE_", could not be Converted, "

 ... S MES=MES_"Update Manually."

 ... D MES^XPDUTL(MES)

 .. I $O(^DIC(4,"D",STA,""))'="" S STA=$O(^DIC(4,"D",STA,""))

 . I '$G(STA) D

 .. S STA=FAC

 . K DA,DIE,DR

 . S DA=IEN,DIE="^OOPS(2260,",DR="13////"_STA

 . D ^DIE K DA,DIE,DR

 S MES="ASISTS Cases have been Updated with Station Number."

 D BMES^XPDUTL(MES)

 D MES^XPDUTL(" ")

 Q

 ;

POST ; Post-init used to Update Table files

 ; Load Dictionary with changed descriptions

 K DIE,DA,DR

 S DIE="^OOPS(2261.2,"

 S DA=11,DR=".01///^S X=""Hollow Bore Needlestick""" D ^DIE

 S DA=13,DR=".01///^S X=""Exposure to Body Fluids/Splash""" D ^DIE

 K DIE,DA,DR

 ; Need to do something about Suture Needlestick - being ADDED

 K DIC,DA,DR

 S (DIC,DIE)="^OOPS(2261.2,",DIC(0)="L",DLAYGO=2261.2

 S DINUM=14

 I $D(@(DIC_DINUM_")"))=0 D

 . S X="Suture Needlestick"

 . D FILE^DICN

 . S DA=+Y

 . S DR="1///^S X=DA"

 . D ^DIE

 E  D

 . S DA=14,DR=".01///^S X=""Suture Needlestick""" D ^DIE

 . S DR="1///^S X=DA" D ^DIE

 K DIC,DIE,DA,DR

 ;

 S DIE="^OOPS(2261.7,"

 S DA=39,DR=".01///^S X=""Drill bit/burr""" D ^DIE

 ; Need to do something about Blunt Suture Needle

 K DIC,DA,DR

 S (DIC,DIE)="^OOPS(2261.7,",DIC(0)="L",DLAYGO=2261.7

 S DINUM=66

 I $D(@(DIC_DINUM_")"))=0 D

 . S X="Blunt Suture Needle"

 . D FILE^DICN

 . S DA=+Y

 . S DR="1///^S X=50" D ^DIE

 . S DR="2///^S X=""N""" D ^DIE

 E  D

 . S DA=66,DR=".01///^S X=""Blunt Suture Needle""" D ^DIE

 . S DR="1///^S X=50" D ^DIE

 . S DR="2///^S X=""N""" D ^DIE

 K DIC,DIE,DA,DR

 S MES="Table Files have been Updated."

 D BMES^XPDUTL(MES)

 D MES^XPDUTL(" ")

 ; Update X-Reference for Station Number

 S DIK="^OOPS(2260,",DIK(1)="13^D" D ENALL^DIK

 QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---OOPSXP5   2617     printed  Feb 18, 2025@23:06:21                                                                                                                                                                                                     Page 2

OOPSXP5   ;WCIOFO/LLH - INIT ROUTINE FOR VISN 2 INTEGRATION; 09/20/99

 +1       ;;1.0;ASISTS;**5**;Jun 01, 1998

 +2       ;

 +3       ;  This is the Pre-Init for OOPS*1*5

 +4       ;  It will be used to populate blank STATION NUMBER fields in 

 +5       ;  ^OOPS(2260 file.

 +6       ;

PRE       ; Pre-Init to Convert Station Number

 +1       ; First assure ^DD(2260,13 has not been changed - implies conv run

 +2        DO FIELD^DID(2260,13,"","TYPE","ARR")

 +3        IF ARR("TYPE")'="FREE TEXT"

               QUIT 

 +4        SET FAC=XPDQUES("PRE1")

 +5        IF $GET(FAC)=""

               QUIT 

 +6        SET IEN=0

 +7       ; Loop thru file, if Station # blank, stuff with FAC

 +8       ; if Station has a value, convert to pointer

 +9        FOR 

               SET IEN=$ORDER(^OOPS(2260,IEN))

               if IEN'>0

                   QUIT 

               Begin DoDot:1

 +10               DO GETS^DIQ(2260,IEN,13,"IE","ARR")

 +11               SET STA=$GET(ARR(2260,IEN_",",13,"I"))

 +12               IF $GET(STA)'=""

                       Begin DoDot:2

 +13                       IF ARR(2260,IEN_",",13,"E")'=ARR(2260,IEN_",",13,"I")

                               QUIT 

 +14                       IF $ORDER(^DIC(4,"D",STA,""))=""

                               Begin DoDot:3

 +15                               SET CASE=$$GET1^DIQ(2260,IEN,.01,"E")

 +16                               SET MES="Station # for Case #: "_CASE_", could not be Converted, "

 +17                               SET MES=MES_"Update Manually."

 +18                               DO MES^XPDUTL(MES)

                               End DoDot:3

 +19                       IF $ORDER(^DIC(4,"D",STA,""))'=""

                               SET STA=$ORDER(^DIC(4,"D",STA,""))

                       End DoDot:2

 +20               IF '$GET(STA)

                       Begin DoDot:2

 +21                       SET STA=FAC

                       End DoDot:2

 +22               KILL DA,DIE,DR

 +23               SET DA=IEN

                   SET DIE="^OOPS(2260,"

                   SET DR="13////"_STA

 +24               DO ^DIE

                   KILL DA,DIE,DR

               End DoDot:1

 +25       SET MES="ASISTS Cases have been Updated with Station Number."

 +26       DO BMES^XPDUTL(MES)

 +27       DO MES^XPDUTL(" ")

 +28       QUIT 

 +29      ;

POST      ; Post-init used to Update Table files

 +1       ; Load Dictionary with changed descriptions

 +2        KILL DIE,DA,DR

 +3        SET DIE="^OOPS(2261.2,"

 +4        SET DA=11

           SET DR=".01///^S X=""Hollow Bore Needlestick"""

           DO ^DIE

 +5        SET DA=13

           SET DR=".01///^S X=""Exposure to Body Fluids/Splash"""

           DO ^DIE

 +6        KILL DIE,DA,DR

 +7       ; Need to do something about Suture Needlestick - being ADDED

 +8        KILL DIC,DA,DR

 +9        SET (DIC,DIE)="^OOPS(2261.2,"

           SET DIC(0)="L"

           SET DLAYGO=2261.2

 +10       SET DINUM=14

 +11       IF $DATA(@(DIC_DINUM_")"))=0

               Begin DoDot:1

 +12               SET X="Suture Needlestick"

 +13               DO FILE^DICN

 +14               SET DA=+Y

 +15               SET DR="1///^S X=DA"

 +16               DO ^DIE

               End DoDot:1

 +17      IF '$TEST

               Begin DoDot:1

 +18               SET DA=14

                   SET DR=".01///^S X=""Suture Needlestick"""

                   DO ^DIE

 +19               SET DR="1///^S X=DA"

                   DO ^DIE

               End DoDot:1

 +20       KILL DIC,DIE,DA,DR

 +21      ;

 +22       SET DIE="^OOPS(2261.7,"

 +23       SET DA=39

           SET DR=".01///^S X=""Drill bit/burr"""

           DO ^DIE

 +24      ; Need to do something about Blunt Suture Needle

 +25       KILL DIC,DA,DR

 +26       SET (DIC,DIE)="^OOPS(2261.7,"

           SET DIC(0)="L"

           SET DLAYGO=2261.7

 +27       SET DINUM=66

 +28       IF $DATA(@(DIC_DINUM_")"))=0

               Begin DoDot:1

 +29               SET X="Blunt Suture Needle"

 +30               DO FILE^DICN

 +31               SET DA=+Y

 +32               SET DR="1///^S X=50"

                   DO ^DIE

 +33               SET DR="2///^S X=""N"""

                   DO ^DIE

               End DoDot:1

 +34      IF '$TEST

               Begin DoDot:1

 +35               SET DA=66

                   SET DR=".01///^S X=""Blunt Suture Needle"""

                   DO ^DIE

 +36               SET DR="1///^S X=50"

                   DO ^DIE

 +37               SET DR="2///^S X=""N"""

                   DO ^DIE

               End DoDot:1

 +38       KILL DIC,DIE,DA,DR

 +39       SET MES="Table Files have been Updated."

 +40       DO BMES^XPDUTL(MES)

 +41       DO MES^XPDUTL(" ")

 +42      ; Update X-Reference for Station Number

 +43       SET DIK="^OOPS(2260,"

           SET DIK(1)="13^D"

           DO ENALL^DIK

 +44       QUIT