OOPSNDBX ;WCIOFO/LLH-Extract data to MailMan message ;10/12/99
;;2.0;ASISTS;;Jun 03, 2002
;
; Retrieves data from ^OOPS(2260, for 2162
; Variables used
; OOPDA IEN of Case
; OOPSAR Array holding data
; OPL Last Line number written in message text
; XMZ Message Number
EN ; Entry
N ARR,MESS,OPC,OPDATA,OPFLD,OPI,OPJ,OPSAR,OPT,OPX,SEG,TL,NCHAR
S RSIZE=0,ARR=0
S OPSAR(0)=$G(^OOPS(2260,OOPDA,0))
S OPSAR("2162A")=$G(^OOPS(2260,OOPDA,"2162A"))
S OPSAR("2162B")=$G(^OOPS(2260,OOPDA,"2162B"))
S OPSAR("2162D")=$G(^OOPS(2260,OOPDA,"2162D"))
S OPSAR("2162S")=$G(^OOPS(2260,OOPDA,"2162S"))
OP1 ; Seg OP1
N TIME
S TIME=$P($P(OPSAR(0),U,5),".",2)
S OPX="OP1^"_$P(OPSAR(0),U)_U_$P(OPSAR(0),U,2)_U_$P(OPSAR(0),U,3)
S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"3:1")
S OPX=OPX_U_$$DC($P($P(OPSAR(0),U,5),"."))
S OPX=OPX_U_TIME_$E("0000",$L(TIME)+1,4)
S OPX=OPX_U_$P(OPSAR("2162A"),U)_U_$$DC($P(OPSAR("2162A"),U,2))
S OPX=OPX_U_$P(OPSAR("2162A"),U,3)
S OPX=OPX_U_$$GET1^DIQ(4,$P(OPSAR("2162A"),U,9),99)
S OPX=OPX_U_$P(OPSAR("2162A"),U,10)_U_$P(OPSAR("2162A"),U,11)
S OPX=OPX_U_$P(OPSAR("2162A"),U,12)_U_$P(OPSAR("2162A"),U,13)
S OPX=OPX_U_$P(OPSAR("2162A"),U,14)
S OPX=OPX_U_$P(OPSAR("2162B"),U)_U_$$GET1^DIQ(2260,OOPDA,"27:1")
S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"29:1")
S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"30:1")
S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"30.1:1")_U_$P(OPSAR("2162B"),U,5)
S OPX=OPX_U_$P(OPSAR("2162B"),U,6)_U_$P(OPSAR("2162B"),U,7)
S OPX=OPX_U_$P(OPSAR("2162D"),U)_U_$P(OPSAR("2162D"),U,2)
S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"36:1")
S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"37:1")
S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"38:1")
S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"41:1")
S OPX=OPX_U_$P(OPSAR("2162D"),U,8)
S OPX=OPX_U_$P(OPSAR(0),U,7)_"^|"
S ARR=ARR+1,MESS(ARR)=OPX
S RSIZE=RSIZE+$L(OPX)+2
;
OP2 ; Seg OP2 - Description of Incident (Word Processing)
S OPFLD=28,SEG="OP2"
D WP
OP3 ; Seg OP3 - Equipment Device Failure
K OPX
I $P($G(OPSAR("2162D")),U,7)'="" D
. S OPX="OP3"_U_$P(OPSAR("2162D"),U,7)_"^|"
. S ARR=ARR+1,MESS(ARR)=OPX
. S RSIZE=RSIZE+$L(OPX)+2
OP4 ; Seg OP4 - Corrective Action - Word Processing
S OPFLD=47,SEG="OP4"
D WP
OP5 ; Seg OP5 - Safety Officer Comments - Word Processing
S OPFLD=55,SEG="OP5"
D WP
OP6 ; Seg OP6 - Area Exposed to Bodily Fluid - Multiple
K OPX
S OPDATA=""
S TL=0 F OPI=0:1 S TL=$O(^OOPS(2260,OOPDA,"2162E",TL)) Q:'TL
I OPI S TL=0 F OPJ=1:1 S TL=$O(^OOPS(2260,OOPDA,"2162E",TL)) Q:'TL D
. S OPDATA=$G(^OOPS(2260,OOPDA,"2162E",TL,0)) Q:(OPDATA="")
. I OPJ=1 S OPX="OP6"_U_OPDATA
. I OPJ>1 S OPX=OPX_","_OPDATA
I $D(OPX) S OPX=OPX_"^|" D
. S ARR=ARR+1,MESS(ARR)=OPX
. S RSIZE=RSIZE+$L(OPX)+2
OP7 ; Seg OP7 - Personal Protective Equipment - Multiple
K OPX
S OPDATA=""
S TL=0 F OPI=0:1 S TL=$O(^OOPS(2260,OOPDA,"2162F",TL)) Q:'TL
I OPI S TL=0 F OPJ=1:1 S TL=$O(^OOPS(2260,OOPDA,"2162F",TL)) Q:'TL D
. S OPDATA=$G(^OOPS(2260,OOPDA,"2162F",TL,0)) Q:(OPDATA="")
. I OPJ=1 S OPX="OP7"_U_OPDATA
. I OPJ>1 S OPX=OPX_","_OPDATA
I $D(OPX) S OPX=OPX_"^|" D
. S ARR=ARR+1,MESS(ARR)=OPX
. S RSIZE=RSIZE+$L(OPX)+2
OP8 ; Seg OP8 - new needlestick fields
K OPX
S OPDATA=""
S OPX="OP8"_U_$$GET1^DIQ(2260,OOPDA,"82:.01")_U_$$GET1^DIQ(2260,OOPDA,"83:.01")
S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"84:.01")
S OPX=OPX_U_$P(OPSAR("2162B"),U,13)_U_"|"
S ARR=ARR+1,MESS(ARR)=OPX
S RSIZE=RSIZE+$L(OPX)+2
OP9 ; Seg OP9 - Word processing field for field 85
N NSEG
K OPX
S NCHAR=$L(OPSAR("2162S"))
S NSEG=$S((NCHAR>210):4,(NCHAR>140&(NCHAR<211)):3,(NCHAR>70&(NCHAR<141)):2,1:0)
I NCHAR D
. S OPX="OP9^1^"_NSEG_"^"_$E(OPSAR("2162S"),1,70)_U_"|"
. S ARR=ARR+1,MESS(ARR)=OPX,RSIZE=RSIZE+$L(OPX)+2
I NCHAR>70 D
. S OPX="OP9^2^"_NSEG_"^"_$E(OPSAR("2162S"),71,140)_U_"|"
. S ARR=ARR+1,MESS(ARR)=OPX,RSIZE=RSIZE+$L(OPX)+2
I NCHAR>140 D
. S OPX="OP9^3^"_NSEG_"^"_$E(OPSAR("2162S"),141,210)_U_"|"
. S ARR=ARR+1,MESS(ARR)=OPX,RSIZE=RSIZE+$L(OPX)+2
I NCHAR>210 D
. S OPX="OP9^4^"_NSEG_"^"_$E(OPSAR("2162S"),211,250)_U_"|"
. S ARR=ARR+1,MESS(ARR)=OPX,RSIZE=RSIZE+$L(OPX)+2
;
EXIT ; Loads the message and Quits the routine
I RSIZE+MSIZE>31500 D
. S END=$P($P(^OOPS(2260,OPAST,0),U),"-",2)
. D SEND^OOPSNDB,CREATE^OOPSNDB
. S (START,END)=""
F I=1:1:ARR I $G(MESS(I))'="" D
. S OPL=OPL+1,^XMB(3.9,XMZ,2,OPL,0)=MESS(I)
. I START="" S START=$P($P(OPSAR(0),U),"-",2)
S MSIZE=MSIZE+RSIZE
K ARR,MESS,OPDT,RSIZE
Q
WP ; Word Processing Fields
N DIWL,DIWR,DIWF,OPGLB,OPNODE,X
S OPI=0
K ^UTILITY($J,"W")
S DIWL=1,DIWR="",DIWF="|C70"
S OPNODE=$P($$GET1^DID(2260,OPFLD,"","GLOBAL SUBSCRIPT LOCATION"),";")
S OPI=0 F S OPI=$O(^OOPS(2260,OOPDA,OPNODE,OPI)) Q:'OPI S X=$G(^OOPS(2260,OOPDA,OPNODE,OPI,0)) D:X]"" ^DIWP
S OPT=$G(^UTILITY($J,"W",1))+0
I OPT S OPI=0 F OPC=1:1 S OPI=$O(^UTILITY($J,"W",1,OPI)) Q:'OPI D
. S OPX=SEG_U_OPC_U_OPT_U_$E(^UTILITY($J,"W",1,OPI,0),1,220)_"^|"
. S ARR=ARR+1,MESS(ARR)=OPX
. S RSIZE=RSIZE+$L(OPX)+2
K ^UTILITY($J,"W"),X
Q
DC(OPDT) ; Convert Date to YYYYMMDD
S:OPDT]"" OPDT=OPDT+17000000\1
Q OPDT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSNDBX 5170 printed Apr 09, 2024@20:43:47 Page 2
OOPSNDBX ;WCIOFO/LLH-Extract data to MailMan message ;10/12/99
+1 ;;2.0;ASISTS;;Jun 03, 2002
+2 ;
+3 ; Retrieves data from ^OOPS(2260, for 2162
+4 ; Variables used
+5 ; OOPDA IEN of Case
+6 ; OOPSAR Array holding data
+7 ; OPL Last Line number written in message text
+8 ; XMZ Message Number
EN ; Entry
+1 NEW ARR,MESS,OPC,OPDATA,OPFLD,OPI,OPJ,OPSAR,OPT,OPX,SEG,TL,NCHAR
+2 SET RSIZE=0
SET ARR=0
+3 SET OPSAR(0)=$GET(^OOPS(2260,OOPDA,0))
+4 SET OPSAR("2162A")=$GET(^OOPS(2260,OOPDA,"2162A"))
+5 SET OPSAR("2162B")=$GET(^OOPS(2260,OOPDA,"2162B"))
+6 SET OPSAR("2162D")=$GET(^OOPS(2260,OOPDA,"2162D"))
+7 SET OPSAR("2162S")=$GET(^OOPS(2260,OOPDA,"2162S"))
OP1 ; Seg OP1
+1 NEW TIME
+2 SET TIME=$PIECE($PIECE(OPSAR(0),U,5),".",2)
+3 SET OPX="OP1^"_$PIECE(OPSAR(0),U)_U_$PIECE(OPSAR(0),U,2)_U_$PIECE(OPSAR(0),U,3)
+4 SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"3:1")
+5 SET OPX=OPX_U_$$DC($PIECE($PIECE(OPSAR(0),U,5),"."))
+6 SET OPX=OPX_U_TIME_$EXTRACT("0000",$LENGTH(TIME)+1,4)
+7 SET OPX=OPX_U_$PIECE(OPSAR("2162A"),U)_U_$$DC($PIECE(OPSAR("2162A"),U,2))
+8 SET OPX=OPX_U_$PIECE(OPSAR("2162A"),U,3)
+9 SET OPX=OPX_U_$$GET1^DIQ(4,$PIECE(OPSAR("2162A"),U,9),99)
+10 SET OPX=OPX_U_$PIECE(OPSAR("2162A"),U,10)_U_$PIECE(OPSAR("2162A"),U,11)
+11 SET OPX=OPX_U_$PIECE(OPSAR("2162A"),U,12)_U_$PIECE(OPSAR("2162A"),U,13)
+12 SET OPX=OPX_U_$PIECE(OPSAR("2162A"),U,14)
+13 SET OPX=OPX_U_$PIECE(OPSAR("2162B"),U)_U_$$GET1^DIQ(2260,OOPDA,"27:1")
+14 SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"29:1")
+15 SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"30:1")
+16 SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"30.1:1")_U_$PIECE(OPSAR("2162B"),U,5)
+17 SET OPX=OPX_U_$PIECE(OPSAR("2162B"),U,6)_U_$PIECE(OPSAR("2162B"),U,7)
+18 SET OPX=OPX_U_$PIECE(OPSAR("2162D"),U)_U_$PIECE(OPSAR("2162D"),U,2)
+19 SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"36:1")
+20 SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"37:1")
+21 SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"38:1")
+22 SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"41:1")
+23 SET OPX=OPX_U_$PIECE(OPSAR("2162D"),U,8)
+24 SET OPX=OPX_U_$PIECE(OPSAR(0),U,7)_"^|"
+25 SET ARR=ARR+1
SET MESS(ARR)=OPX
+26 SET RSIZE=RSIZE+$LENGTH(OPX)+2
+27 ;
OP2 ; Seg OP2 - Description of Incident (Word Processing)
+1 SET OPFLD=28
SET SEG="OP2"
+2 DO WP
OP3 ; Seg OP3 - Equipment Device Failure
+1 KILL OPX
+2 IF $PIECE($GET(OPSAR("2162D")),U,7)'=""
Begin DoDot:1
+3 SET OPX="OP3"_U_$PIECE(OPSAR("2162D"),U,7)_"^|"
+4 SET ARR=ARR+1
SET MESS(ARR)=OPX
+5 SET RSIZE=RSIZE+$LENGTH(OPX)+2
End DoDot:1
OP4 ; Seg OP4 - Corrective Action - Word Processing
+1 SET OPFLD=47
SET SEG="OP4"
+2 DO WP
OP5 ; Seg OP5 - Safety Officer Comments - Word Processing
+1 SET OPFLD=55
SET SEG="OP5"
+2 DO WP
OP6 ; Seg OP6 - Area Exposed to Bodily Fluid - Multiple
+1 KILL OPX
+2 SET OPDATA=""
+3 SET TL=0
FOR OPI=0:1
SET TL=$ORDER(^OOPS(2260,OOPDA,"2162E",TL))
if 'TL
QUIT
+4 IF OPI
SET TL=0
FOR OPJ=1:1
SET TL=$ORDER(^OOPS(2260,OOPDA,"2162E",TL))
if 'TL
QUIT
Begin DoDot:1
+5 SET OPDATA=$GET(^OOPS(2260,OOPDA,"2162E",TL,0))
if (OPDATA="")
QUIT
+6 IF OPJ=1
SET OPX="OP6"_U_OPDATA
+7 IF OPJ>1
SET OPX=OPX_","_OPDATA
End DoDot:1
+8 IF $DATA(OPX)
SET OPX=OPX_"^|"
Begin DoDot:1
+9 SET ARR=ARR+1
SET MESS(ARR)=OPX
+10 SET RSIZE=RSIZE+$LENGTH(OPX)+2
End DoDot:1
OP7 ; Seg OP7 - Personal Protective Equipment - Multiple
+1 KILL OPX
+2 SET OPDATA=""
+3 SET TL=0
FOR OPI=0:1
SET TL=$ORDER(^OOPS(2260,OOPDA,"2162F",TL))
if 'TL
QUIT
+4 IF OPI
SET TL=0
FOR OPJ=1:1
SET TL=$ORDER(^OOPS(2260,OOPDA,"2162F",TL))
if 'TL
QUIT
Begin DoDot:1
+5 SET OPDATA=$GET(^OOPS(2260,OOPDA,"2162F",TL,0))
if (OPDATA="")
QUIT
+6 IF OPJ=1
SET OPX="OP7"_U_OPDATA
+7 IF OPJ>1
SET OPX=OPX_","_OPDATA
End DoDot:1
+8 IF $DATA(OPX)
SET OPX=OPX_"^|"
Begin DoDot:1
+9 SET ARR=ARR+1
SET MESS(ARR)=OPX
+10 SET RSIZE=RSIZE+$LENGTH(OPX)+2
End DoDot:1
OP8 ; Seg OP8 - new needlestick fields
+1 KILL OPX
+2 SET OPDATA=""
+3 SET OPX="OP8"_U_$$GET1^DIQ(2260,OOPDA,"82:.01")_U_$$GET1^DIQ(2260,OOPDA,"83:.01")
+4 SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"84:.01")
+5 SET OPX=OPX_U_$PIECE(OPSAR("2162B"),U,13)_U_"|"
+6 SET ARR=ARR+1
SET MESS(ARR)=OPX
+7 SET RSIZE=RSIZE+$LENGTH(OPX)+2
OP9 ; Seg OP9 - Word processing field for field 85
+1 NEW NSEG
+2 KILL OPX
+3 SET NCHAR=$LENGTH(OPSAR("2162S"))
+4 SET NSEG=$SELECT((NCHAR>210):4,(NCHAR>140&(NCHAR<211)):3,(NCHAR>70&(NCHAR<141)):2,1:0)
+5 IF NCHAR
Begin DoDot:1
+6 SET OPX="OP9^1^"_NSEG_"^"_$EXTRACT(OPSAR("2162S"),1,70)_U_"|"
+7 SET ARR=ARR+1
SET MESS(ARR)=OPX
SET RSIZE=RSIZE+$LENGTH(OPX)+2
End DoDot:1
+8 IF NCHAR>70
Begin DoDot:1
+9 SET OPX="OP9^2^"_NSEG_"^"_$EXTRACT(OPSAR("2162S"),71,140)_U_"|"
+10 SET ARR=ARR+1
SET MESS(ARR)=OPX
SET RSIZE=RSIZE+$LENGTH(OPX)+2
End DoDot:1
+11 IF NCHAR>140
Begin DoDot:1
+12 SET OPX="OP9^3^"_NSEG_"^"_$EXTRACT(OPSAR("2162S"),141,210)_U_"|"
+13 SET ARR=ARR+1
SET MESS(ARR)=OPX
SET RSIZE=RSIZE+$LENGTH(OPX)+2
End DoDot:1
+14 IF NCHAR>210
Begin DoDot:1
+15 SET OPX="OP9^4^"_NSEG_"^"_$EXTRACT(OPSAR("2162S"),211,250)_U_"|"
+16 SET ARR=ARR+1
SET MESS(ARR)=OPX
SET RSIZE=RSIZE+$LENGTH(OPX)+2
End DoDot:1
+17 ;
EXIT ; Loads the message and Quits the routine
+1 IF RSIZE+MSIZE>31500
Begin DoDot:1
+2 SET END=$PIECE($PIECE(^OOPS(2260,OPAST,0),U),"-",2)
+3 DO SEND^OOPSNDB
DO CREATE^OOPSNDB
+4 SET (START,END)=""
End DoDot:1
+5 FOR I=1:1:ARR
IF $GET(MESS(I))'=""
Begin DoDot:1
+6 SET OPL=OPL+1
SET ^XMB(3.9,XMZ,2,OPL,0)=MESS(I)
+7 IF START=""
SET START=$PIECE($PIECE(OPSAR(0),U),"-",2)
End DoDot:1
+8 SET MSIZE=MSIZE+RSIZE
+9 KILL ARR,MESS,OPDT,RSIZE
+10 QUIT
WP ; Word Processing Fields
+1 NEW DIWL,DIWR,DIWF,OPGLB,OPNODE,X
+2 SET OPI=0
+3 KILL ^UTILITY($JOB,"W")
+4 SET DIWL=1
SET DIWR=""
SET DIWF="|C70"
+5 SET OPNODE=$PIECE($$GET1^DID(2260,OPFLD,"","GLOBAL SUBSCRIPT LOCATION"),";")
+6 SET OPI=0
FOR
SET OPI=$ORDER(^OOPS(2260,OOPDA,OPNODE,OPI))
if 'OPI
QUIT
SET X=$GET(^OOPS(2260,OOPDA,OPNODE,OPI,0))
if X]""
DO ^DIWP
+7 SET OPT=$GET(^UTILITY($JOB,"W",1))+0
+8 IF OPT
SET OPI=0
FOR OPC=1:1
SET OPI=$ORDER(^UTILITY($JOB,"W",1,OPI))
if 'OPI
QUIT
Begin DoDot:1
+9 SET OPX=SEG_U_OPC_U_OPT_U_$EXTRACT(^UTILITY($JOB,"W",1,OPI,0),1,220)_"^|"
+10 SET ARR=ARR+1
SET MESS(ARR)=OPX
+11 SET RSIZE=RSIZE+$LENGTH(OPX)+2
End DoDot:1
+12 KILL ^UTILITY($JOB,"W"),X
+13 QUIT
DC(OPDT) ; Convert Date to YYYYMMDD
+1 if OPDT]""
SET OPDT=OPDT+17000000\1
+2 QUIT OPDT
