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

PXKMOD.m

Go to the documentation of this file.
  1. PXKMOD ;ISA/KWP -MAIN ROUTINE FOR SAVING MODIFIERS ;10/11/2018
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,121,211**;Aug 12, 1996;Build 454
  1. SUBSCR ;
  1. AFTER N PXKMOD
  1. S PXKMOD=""
  1. F S PXKMOD=$O(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKMOD)) Q:'PXKMOD D
  1. . S PXKAFT(1,PXKMOD)=$G(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKMOD,"AFTER"))
  1. BEFORE S PXKMOD=""
  1. F S PXKMOD=$O(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKMOD)) Q:'PXKMOD D
  1. . S PXKBEF(1,PXKMOD)=$G(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKMOD,"BEFORE"))
  1. Q
  1. UPD(PXKPIEN) ;Add a modifier
  1. N PXKMOD,PXRETVAL,PXKMIEN
  1. S PXKMOD=""
  1. F S PXKMOD=$O(PXKAV(1,PXKMOD)) Q:PXKMOD="" D
  1. .S PXKMIEN=PXKAV(1,PXKMOD)
  1. .;If the modifier is already present do not add it again.
  1. .I $D(^AUPNVCPT(PXKPIEN,1,"B",PXKMIEN)) Q
  1. .S PXRETVAL=$$ADD(PXKPIEN,PXKMIEN)
  1. Q
  1. LOOP N PXKMOD
  1. S PXKMOD=""
  1. F S PXKMOD=$O(PXKAFT(1,PXKMOD)) Q:PXKMOD="" D
  1. . Q:PXKAFT(1,PXKMOD)=""
  1. . S PXKAV(1,PXKMOD)=PXKAFT(1,PXKMOD)
  1. S PXKMOD=""
  1. F S PXKMOD=$O(PXKBEF(1,PXKMOD)) Q:PXKMOD="" D
  1. . Q:PXKBEF(1,PXKMOD)=""
  1. . S PXKBV(1,PXKMOD)=PXKBEF(1,PXKMOD)
  1. Q
  1. DELETE(IEN) ;
  1. N DIE,DR,SIEN,DA
  1. S DIE="^AUPNVCPT("_IEN_",1,",DR=".01////@",SIEN=0
  1. F S SIEN=$O(^AUPNVCPT(IEN,1,SIEN)) Q:SIEN="" S DA=SIEN,DA(1)=IEN D ^DIE
  1. Q 1
  1. ADD(IEN,PXKMOD) ;
  1. N DA,DIC,DO,X
  1. S DIC="^AUPNVCPT("_IEN_",1,"
  1. S DIC("P")=$P($G(^DD(+$P($G(^AUPNVCPT(0)),"^",2),1,0)),"^",2)
  1. S DA(1)=IEN
  1. S DIC(0)="L"
  1. S PXKMOD=$P($$MOD^ICPTMOD(PXKMOD,"I",+^TMP("PXK",$J,"VST",1,0,"AFTER")),"^")
  1. I PXKMOD<0 Q 0
  1. S X=PXKMOD
  1. D FILE^DICN
  1. Q 1