Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: OOPSNDBX

OOPSNDBX.m

Go to the documentation of this file. 
  1. OOPSNDBX ;WCIOFO/LLH-Extract data to MailMan message ;10/12/99
  1.  ;;2.0;ASISTS;;Jun 03, 2002
  1.  ;
  1.  ; Retrieves data from ^OOPS(2260, for 2162
  1.  ; Variables used
  1.  ;  OOPDA        IEN of Case
  1.  ;  OOPSAR       Array holding data
  1.  ;  OPL          Last Line number written in message text
  1.  ;  XMZ          Message Number
  1. EN ; Entry
  1.  N ARR,MESS,OPC,OPDATA,OPFLD,OPI,OPJ,OPSAR,OPT,OPX,SEG,TL,NCHAR
  1.  S RSIZE=0,ARR=0
  1.  S OPSAR(0)=$G(^OOPS(2260,OOPDA,0))
  1.  S OPSAR("2162A")=$G(^OOPS(2260,OOPDA,"2162A"))
  1.  S OPSAR("2162B")=$G(^OOPS(2260,OOPDA,"2162B"))
  1.  S OPSAR("2162D")=$G(^OOPS(2260,OOPDA,"2162D"))
  1.  S OPSAR("2162S")=$G(^OOPS(2260,OOPDA,"2162S"))
  1. OP1 ; Seg OP1
  1.  N TIME
  1.  S TIME=$P($P(OPSAR(0),U,5),".",2)
  1.  S OPX="OP1^"_$P(OPSAR(0),U)_U_$P(OPSAR(0),U,2)_U_$P(OPSAR(0),U,3)
  1.  S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"3:1")
  1.  S OPX=OPX_U_$$DC($P($P(OPSAR(0),U,5),"."))
  1.  S OPX=OPX_U_TIME_$E("0000",$L(TIME)+1,4)
  1.  S OPX=OPX_U_$P(OPSAR("2162A"),U)_U_$$DC($P(OPSAR("2162A"),U,2))
  1.  S OPX=OPX_U_$P(OPSAR("2162A"),U,3)
  1.  S OPX=OPX_U_$$GET1^DIQ(4,$P(OPSAR("2162A"),U,9),99)
  1.  S OPX=OPX_U_$P(OPSAR("2162A"),U,10)_U_$P(OPSAR("2162A"),U,11)
  1.  S OPX=OPX_U_$P(OPSAR("2162A"),U,12)_U_$P(OPSAR("2162A"),U,13)
  1.  S OPX=OPX_U_$P(OPSAR("2162A"),U,14)
  1.  S OPX=OPX_U_$P(OPSAR("2162B"),U)_U_$$GET1^DIQ(2260,OOPDA,"27:1")
  1.  S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"29:1")
  1.  S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"30:1")
  1.  S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"30.1:1")_U_$P(OPSAR("2162B"),U,5)
  1.  S OPX=OPX_U_$P(OPSAR("2162B"),U,6)_U_$P(OPSAR("2162B"),U,7)
  1.  S OPX=OPX_U_$P(OPSAR("2162D"),U)_U_$P(OPSAR("2162D"),U,2)
  1.  S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"36:1")
  1.  S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"37:1")
  1.  S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"38:1")
  1.  S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"41:1")
  1.  S OPX=OPX_U_$P(OPSAR("2162D"),U,8)
  1.  S OPX=OPX_U_$P(OPSAR(0),U,7)_"^|"
  1.  S ARR=ARR+1,MESS(ARR)=OPX
  1.  S RSIZE=RSIZE+$L(OPX)+2
  1.  ;
  1. OP2 ; Seg OP2 - Description of Incident (Word Processing)
  1.  S OPFLD=28,SEG="OP2"
  1.  D WP
  1. OP3 ; Seg OP3 - Equipment Device Failure
  1.  K OPX
  1.  I $P($G(OPSAR("2162D")),U,7)'="" D
  1.  . S OPX="OP3"_U_$P(OPSAR("2162D"),U,7)_"^|"
  1.  . S ARR=ARR+1,MESS(ARR)=OPX
  1.  . S RSIZE=RSIZE+$L(OPX)+2
  1. OP4 ; Seg OP4 - Corrective Action - Word Processing
  1.  S OPFLD=47,SEG="OP4"
  1.  D WP
  1. OP5 ; Seg OP5 - Safety Officer Comments - Word Processing
  1.  S OPFLD=55,SEG="OP5"
  1.  D WP
  1. OP6 ; Seg OP6 - Area Exposed to Bodily Fluid - Multiple
  1.  K OPX
  1.  S OPDATA=""
  1.  S TL=0 F OPI=0:1 S TL=$O(^OOPS(2260,OOPDA,"2162E",TL)) Q:'TL
  1.  I OPI S TL=0 F OPJ=1:1 S TL=$O(^OOPS(2260,OOPDA,"2162E",TL)) Q:'TL  D
  1.  . S OPDATA=$G(^OOPS(2260,OOPDA,"2162E",TL,0)) Q:(OPDATA="")
  1.  . I OPJ=1 S OPX="OP6"_U_OPDATA
  1.  . I OPJ>1 S OPX=OPX_","_OPDATA
  1.  I $D(OPX) S OPX=OPX_"^|" D
  1.  . S ARR=ARR+1,MESS(ARR)=OPX
  1.  . S RSIZE=RSIZE+$L(OPX)+2
  1. OP7 ; Seg OP7 - Personal Protective Equipment - Multiple
  1.  K OPX
  1.  S OPDATA=""
  1.  S TL=0 F OPI=0:1 S TL=$O(^OOPS(2260,OOPDA,"2162F",TL)) Q:'TL
  1.  I OPI S TL=0 F OPJ=1:1 S TL=$O(^OOPS(2260,OOPDA,"2162F",TL)) Q:'TL  D
  1.  . S OPDATA=$G(^OOPS(2260,OOPDA,"2162F",TL,0)) Q:(OPDATA="")
  1.  . I OPJ=1 S OPX="OP7"_U_OPDATA
  1.  . I OPJ>1 S OPX=OPX_","_OPDATA
  1.  I $D(OPX) S OPX=OPX_"^|" D
  1.  . S ARR=ARR+1,MESS(ARR)=OPX
  1.  . S RSIZE=RSIZE+$L(OPX)+2
  1. OP8 ; Seg OP8 - new needlestick fields
  1.  K OPX
  1.  S OPDATA=""
  1.  S OPX="OP8"_U_$$GET1^DIQ(2260,OOPDA,"82:.01")_U_$$GET1^DIQ(2260,OOPDA,"83:.01")
  1.  S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"84:.01")
  1.  S OPX=OPX_U_$P(OPSAR("2162B"),U,13)_U_"|"
  1.  S ARR=ARR+1,MESS(ARR)=OPX
  1.  S RSIZE=RSIZE+$L(OPX)+2
  1. OP9 ; Seg OP9 - Word processing field for field 85
  1.  N NSEG
  1.  K OPX
  1.  S NCHAR=$L(OPSAR("2162S"))
  1.  S NSEG=$S((NCHAR>210):4,(NCHAR>140&(NCHAR<211)):3,(NCHAR>70&(NCHAR<141)):2,1:0)
  1.  I NCHAR D
  1.  . S OPX="OP9^1^"_NSEG_"^"_$E(OPSAR("2162S"),1,70)_U_"|"
  1.  . S ARR=ARR+1,MESS(ARR)=OPX,RSIZE=RSIZE+$L(OPX)+2
  1.  I NCHAR>70 D
  1.  . S OPX="OP9^2^"_NSEG_"^"_$E(OPSAR("2162S"),71,140)_U_"|"
  1.  . S ARR=ARR+1,MESS(ARR)=OPX,RSIZE=RSIZE+$L(OPX)+2
  1.  I NCHAR>140 D
  1.  . S OPX="OP9^3^"_NSEG_"^"_$E(OPSAR("2162S"),141,210)_U_"|"
  1.  . S ARR=ARR+1,MESS(ARR)=OPX,RSIZE=RSIZE+$L(OPX)+2
  1.  I NCHAR>210 D
  1.  . S OPX="OP9^4^"_NSEG_"^"_$E(OPSAR("2162S"),211,250)_U_"|"
  1.  . S ARR=ARR+1,MESS(ARR)=OPX,RSIZE=RSIZE+$L(OPX)+2
  1.  ;
  1. EXIT ; Loads the message and Quits the routine
  1.  I RSIZE+MSIZE>31500 D
  1.  . S END=$P($P(^OOPS(2260,OPAST,0),U),"-",2)
  1.  . D SEND^OOPSNDB,CREATE^OOPSNDB
  1.  . S (START,END)=""
  1.  F I=1:1:ARR I $G(MESS(I))'="" D
  1.  . S OPL=OPL+1,^XMB(3.9,XMZ,2,OPL,0)=MESS(I)
  1.  . I START="" S START=$P($P(OPSAR(0),U),"-",2)
  1.  S MSIZE=MSIZE+RSIZE
  1.  K ARR,MESS,OPDT,RSIZE
  1.  Q
  1. WP ; Word Processing Fields
  1.  N DIWL,DIWR,DIWF,OPGLB,OPNODE,X
  1.  S OPI=0
  1.  K ^UTILITY($J,"W")
  1.  S DIWL=1,DIWR="",DIWF="|C70"
  1.  S OPNODE=$P($$GET1^DID(2260,OPFLD,"","GLOBAL SUBSCRIPT LOCATION"),";")
  1.  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
  1.  S OPT=$G(^UTILITY($J,"W",1))+0
  1.  I OPT S OPI=0 F OPC=1:1 S OPI=$O(^UTILITY($J,"W",1,OPI)) Q:'OPI  D
  1.  . S OPX=SEG_U_OPC_U_OPT_U_$E(^UTILITY($J,"W",1,OPI,0),1,220)_"^|"
  1.  . S ARR=ARR+1,MESS(ARR)=OPX
  1.  . S RSIZE=RSIZE+$L(OPX)+2
  1.  K ^UTILITY($J,"W"),X
  1.  Q
  1. DC(OPDT) ; Convert Date to YYYYMMDD
  1.  S:OPDT]"" OPDT=OPDT+17000000\1
  1.  Q OPDT