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

IBCN118.m

Go to the documentation of this file. 
  1. IBCN118 ;ALB/KML - TRIGGER LOGIC CALLED BY DD XREF 2.312, 1.08 ;06-APR-2015
  1.  ;;2.0;INTEGRATED BILLING;**528,565**;21-MAR-94;Build 41
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. TRIGSET ; trigger called from MUMPS xref from DD(2.312, 1.08)
  1.  ; ensure that the new fields at the new COMMENT - SUBSCRIBER POLICY multiple (2.312, 1.18) get updated when 2.312, 1.08 is edited
  1.  ;
  1.  ; Expected variables:
  1.  ;   DA = system wide array of iens associated with the patient record
  1.  ;  DUZ = system wide user IEN
  1.  ;
  1.  N IBDT,IBDFN,IBPOLDA,IBCDA,IBPOLCOM
  1.  ;
  1.  S IBDFN=$G(DA(1)),IBPOLDA=$G(DA),IBPOLCOM=$P($G(^DPT(IBDFN,.312,IBPOLDA,1)),U,8)
  1.  ;
  1.  ; -- comments do not exist for the user so add comments
  1.  I '$O(^DPT(IBDFN,.312,IBPOLDA,13,"C",DUZ,"")) D ADCOM(IBDFN,IBPOLDA,IBPOLCOM) Q
  1.  ;
  1.  ; -- get the last policy comment entered and the comment IEN
  1.  S IBDT=$O(^DPT(IBDFN,.312,IBPOLDA,13,"B",""),-1),IBCDA=$O(^DPT(IBDFN,.312,IBPOLDA,13,"B",IBDT,""),-1)
  1.  ;
  1.  ; -- edit comment if comment exist for the user
  1.  I $P(^DPT(IBDFN,.312,IBPOLDA,13,IBCDA,0),U,2)=DUZ D EDCOM(IBDFN,IBDT,IBCDA)
  1.  Q
  1.  ;
  1. ADCOM(IBDFN,IBPOLDA,IBPOLCOM) ; add new patient policy comment to multiple (2.312, 1.18)
  1.  ;
  1.  L +^DPT(IBDFN,.312,IBPOLDA,13):5 I '$T D CMLKD Q
  1.  ;
  1.  N FDA,IENS,DIERR
  1.  ;
  1.  ; -- populate FDA array
  1.  S IENS="+1"_","_IBPOLDA_","_IBDFN_","
  1.  S FDA(2.342,IENS,.01)=$$NOW^XLFDT()
  1.  S FDA(2.342,IENS,.02)=DUZ
  1.  S FDA(2.342,IENS,.03)=IBPOLCOM
  1.  ;
  1.  ; -- add comments
  1.  D UPDATE^DIE(,"FDA",,"DIERR") I $D(DIERR) W !,!,"Error...ADCOM-IBCN118...Cannot Add policy comment" D PAUSE^VALM1
  1.  L -^DPT(IBDFN,.312,IBPOLDA,13)
  1.  Q
  1.  ;
  1. EDCOM(IBDFN,IBDT,IBCDA) ; edit existing comment entry at 2.312,1.18 multiple
  1.  ; Input:
  1.  ;   IBDT  = date/time that comment was made
  1.  ;   CMIEN = comment IEN
  1.  ;
  1.  ; -- only make edits to comments if the first 80 characters are different
  1.  Q:$P($G(^DPT(IBDFN,.312,IBPOLDA,1)),U,8)=$E($P(^DPT(IBDFN,.312,IBPOLDA,13,IBCDA,1),U),1,80)
  1.  ;
  1.  N FDA,IENS,DIERR
  1.  ;
  1.  L +^DPT(IBDFN,.312,IBPOLDA,13):5 I '$T D CMLKD Q
  1.  ;
  1.  ; -- populate FDA array
  1.  S IENS=IBCDA_","_IBPOLDA_","_IBDFN_","
  1.  S FDA(2.342,IENS,.01)=$$NOW^XLFDT()
  1.  S FDA(2.342,IENS,.02)=DUZ
  1.  S FDA(2.342,IENS,.03)=$P($G(^DPT(IBDFN,.312,IBPOLDA,1)),U,8)
  1.  ;
  1.  ; -- update comments
  1.  D FILE^DIE("","FDA","DIERR") I $D(DIERR) W !,!,"Error...EDCOM-IBCN118...Cannot edit policy comments" D PAUSE^VALM1
  1.  L -^DPT(IBDFN,.312,IBPOLDA,13)
  1.  Q
  1.  ;
  1. TRIGKIL ; remove data at 2.312, 1.18 multiple when 2.312, 1.08 gets removed
  1.  ;
  1.  ; -- don't kill data at 1.18 multiple since data exists at 2.313, 1.08
  1.  Q:$P(^DPT(DA(1),.312,DA,1),U,8)]""
  1.  ;
  1.  N FDA,IBDT,CMIEN,IENS,DIERR
  1.  ;
  1.  S IBDT=$O(^DPT(DA(1),.312,DA,13,"BB",DUZ,""),-1)
  1.  ;
  1.  ; -- user doesn't have comments at the 1.18 multiple or the user has comments but not for the current date so quit
  1.  Q:IBDT']""  Q:$P(IBDT,".")'=DT
  1.  ;
  1.  ; -- populate FDA array
  1.  S CMIEN=$O(^DPT(DA(1),.312,DA,13,"BB",DUZ,IBDT,""),-1)
  1.  S IENS=CMIEN_","_DA_","_DA(1)_","
  1.  S FDA(2.342,IENS,.01)="@"
  1.  S FDA(2.342,IENS,.02)="@"
  1.  S FDA(2.342,IENS,.03)="@"
  1.  ;
  1.  ; -- update comments
  1.  D FILE^DIE("","FDA","DIERR") I $D(DIERR) W !,!,"Error...TRIGKIL-IBCN118...Cannot Remove data from (2.312,1.18)" D PAUSE^VALM1
  1.  Q
  1.  ;
  1. CMLKD ; -- write record locked message
  1.  W !!,"Sorry, another user currently editing this entry."
  1.  W !,"Try again later."
  1.  D PAUSE^VALM1
  1.  Q