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

BTPWTIAD.m

Go to the documentation of this file.
  1. BTPWTIAD ;VNGT/HS/ALA-Create an Addendum to a Note ; 07 Jun 2010 6:54 AM
  1. ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
  1. ;
  1. ;
  1. EN(NDATA,TIUDA,TEXT) ; EP -- BTPW TIU ADDENDUM
  1. ; Input
  1. ; TIUDA - IEN of the original document
  1. ; TEXT - TEXT of the addendum to be created
  1. NEW UID,II,TIUX,RESULT
  1. S II=0
  1. ;
  1. NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWTINT D UNWIND^%ZTER" ; SAC 2006 2.2.3
  1. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1. S NDATA=$NA(^TMP("BTPWTIAD",UID))
  1. K @NDATA
  1. S TIUX(1202)=DUZ
  1. S TIUX(1301)=$$NOW^XLFDT()
  1. S @NDATA@(II)="I00010RESULT^T01024MSG^I00010ADIEN"_$C(30)
  1. ;
  1. S TEXT=$G(TEXT,"")
  1. I TEXT="" D
  1. . N LIST,BN
  1. . S LIST="",BN=""
  1. . F S BN=$O(TEXT(BN)) Q:BN="" S LIST=LIST_TEXT(BN)
  1. . K TEXT
  1. . S TEXT=LIST
  1. . K LIST
  1. ;
  1. ;Define Addendum Text
  1. I TEXT'="" F I=1:1:$L(TEXT,$C(10)) S TIUX("TEXT",I,0)=$P(TEXT,$C(10),I)
  1. I '$D(TIUX("TEXT")) S TIUX("TEXT",1,0)="CMET Notification marked as Entered in Error"
  1. ;
  1. D MAKEADD^TIUSRVP(.RESULT,TIUDA,.TIUX,1)
  1. I $P(RESULT,U,1)=0 D Q
  1. . S II=II+1,@NDATA@(II)="-1^"_$P(RESULT,U,2)_$C(30)
  1. . S II=II+1,@NDATA@(II)=$C(31)
  1. S II=II+1,@NDATA@(II)="1^^"_$P(RESULT,U,1)_$C(30)
  1. S II=II+1,@NDATA@(II)=$C(31)
  1. Q