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 ---[H[J[2J[HOOPSXP5 2617 printed Dec 13, 2024@01:39:57 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
