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

ADEUPD33.m

Go to the documentation of this file.
  1. ADEUPD33 ;IHS/OIT/GAB - ADE6.0 PATCH 33 [ 11/09/2018 14:05 PM ]
  1. ;;6.0;ADE;**33**;March 25, 1999;Build 53
  1. ;IHS/OIT/GAB 10/2018 Patch 33 ADA-CDT code updates for 2019
  1. ;Utility routine to update the ADA Code file
  1. UPDATE(ADEFILE,ADEFLDS,ADEWPFLD,ADEIENST,ADETGRTN,ADESETX) ;EP
  1. N ADEFDA
  1. S ADENFLDS=$L(ADEFLDS,","),ADEDONE=0,ADERPEAT=0,ADEN="",ADETXT=0
  1. F ADEI=1:1 S ADEX=$P($T(@$P(ADETGRTN,"^")+ADEI^@$P(ADETGRTN,"^",2)),";;",2) S:ADEX="***END***" ADEDONE=1 D Q:ADEDONE
  1. .I ADEX[U!ADEDONE D K ADETEXT S ADETXT=0 Q
  1. ..F D Q:ADERPEAT<2
  1. ...S ADELSTN=ADEN D:ADESETX'="" @ADESETX D:ADELSTN]"" FILE D SETFDA Q
  1. .Q:$G(ADEWPFLD)=""
  1. .S ADETXT=ADETXT+1,ADETEXT(ADETXT)=ADEX
  1. K ADECURX,ADEDONE,ADEI,ADEI1,ADELSTN,ADEN,ADEEND,ADENFLDS,ADERPEAT,ADESVX,ADESTART,ADETXT,ADETEXT,ADEX,ADEX1
  1. Q
  1. ;
  1. SETFDA ;EP
  1. ; Corresponds to values in X: the first is the field that is set with the first piece, etc. If a value isn't used to set a field
  1. ; nothing should be entered for that piece; should be left empty e.g. ".01,02,,.09"
  1. F ADEI1=1:1:ADENFLDS S ADEFLD=$P(ADEFLDS,",",ADEI1) I ADEFLD'="" S ADEX1=$P(ADEX,U,ADEI1) S:ADEX1'="" ADEFDA(ADEFILE,ADEIENST,ADEFLD)=ADEX1
  1. S ADEN=$P(ADEX,U)
  1. Q
  1. ;
  1. FILE ;EP
  1. D UPDATE^DIE(,"ADEFDA","ADEIEN","ADEEMSG")
  1. K ADEFDA,ADEEMSG
  1. ; get the IEN assigned
  1. I +$G(ADEIEN(1)),$G(ADETEXT(1))'="" D WP^DIE(ADEFILE,ADEIEN(1)_",",ADEWPFLD,,"ADETEXT","ADEEMSG")
  1. K ADEEMSG,ADEIEN
  1. Q
  1. ;
  1. DELETES(ADETGRTN,ADESETX,ADEDIK) ;EP
  1. F ADEI=1:1 S ADEX=$P($T(@$P(ADETGRTN,"^")+ADEI^@$P(ADETGRTN,"^",2)),";;",2) Q:ADEX="***END***" D
  1. . D:ADESETX'="" @ADESETX
  1. . I ADEX'="" S DA=ADEX,DIE=ADEDIK,DR=".08////3190101" D ^DIE
  1. . Q
  1. Q