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

PSXBLD2.m

Go to the documentation of this file.
  1. PSXBLD2 ;BIR/EJW-New warning label Data for Transmission ;10/26/04
  1. ;;2.0;CMOP;**54,71**;11 Apr 97;Build 1
  1. ;
  1. ;Reference to ^PS(55, supported by DBIA #2228
  1. ;Reference to WTEXT^PSSWRNA supported by DBIA #4444
  1. ;
  1. NEWWARN ;Send All New warnings to CMOP in NTE11 & NTE11A
  1. ; First 220 characters will be placed into the NTE11 segment, any
  1. ; text > 220 will be placed into a continuation segment of NTE11A,
  1. ; but only up to an additional max of 220 characters.
  1. ;
  1. N J,TEXT,W,TXT1,TXT2
  1. ;send English warnings
  1. F J=1:1:$L(WARN,",") S W=$P(WARN,",",J) Q:W="" D
  1. .S TEXT=$$WTEXT^PSSWRNA(W)
  1. .Q:TEXT=""
  1. .S TXT1=$E(TEXT,1,220),TXT2=$E($E(TEXT,221,$L(TEXT)),1,220)
  1. .S MSG=MSG+1,PSXORD(MSG)="NTE|11|"_$P(RXY,"^")_"|ENG|"_W_"|"_TXT1
  1. .S:TXT2]"" MSG=MSG+1,PSXORD(MSG)="NTE|11A|"_$P(RXY,"^")_"|ENG|"_W_"|"_TXT2
  1. ;
  1. ;quit if Patient Not Language Spanish
  1. I $P($G(^PS(55,DFN,"LAN")),"^",2)'=2 Q
  1. ;quit also, if Patient Other Language Not Yes
  1. I '$P($G(^PS(55,DFN,"LAN")),"^") Q
  1. ;
  1. ;send Spanish warnings also
  1. F J=1:1:$L(WARN,",") S W=$P(WARN,",",J) Q:W="" D
  1. .S TEXT=$$WTEXT^PSSWRNA(W,2)
  1. .Q:TEXT=""
  1. .S TXT1=$E(TEXT,1,220),TXT2=$E($E(TEXT,221,$L(TEXT)),1,220)
  1. .S MSG=MSG+1,PSXORD(MSG)="NTE|11|"_$P(RXY,"^")_"|SPA|"_W_"|"_TXT1
  1. .S:TXT2]"" MSG=MSG+1,PSXORD(MSG)="NTE|11A|"_$P(RXY,"^")_"|SPA|"_W_"|"_TXT2
  1. Q