IBCN118 ;ALB/KML - TRIGGER LOGIC CALLED BY DD XREF 2.312, 1.08 ;06-APR-2015
;;2.0;INTEGRATED BILLING;**528,565**;21-MAR-94;Build 41
;;Per VA Directive 6402, this routine should not be modified.
;
TRIGSET ; trigger called from MUMPS xref from DD(2.312, 1.08)
; 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
;
; Expected variables:
; DA = system wide array of iens associated with the patient record
; DUZ = system wide user IEN
;
N IBDT,IBDFN,IBPOLDA,IBCDA,IBPOLCOM
;
S IBDFN=$G(DA(1)),IBPOLDA=$G(DA),IBPOLCOM=$P($G(^DPT(IBDFN,.312,IBPOLDA,1)),U,8)
;
; -- comments do not exist for the user so add comments
I '$O(^DPT(IBDFN,.312,IBPOLDA,13,"C",DUZ,"")) D ADCOM(IBDFN,IBPOLDA,IBPOLCOM) Q
;
; -- get the last policy comment entered and the comment IEN
S IBDT=$O(^DPT(IBDFN,.312,IBPOLDA,13,"B",""),-1),IBCDA=$O(^DPT(IBDFN,.312,IBPOLDA,13,"B",IBDT,""),-1)
;
; -- edit comment if comment exist for the user
I $P(^DPT(IBDFN,.312,IBPOLDA,13,IBCDA,0),U,2)=DUZ D EDCOM(IBDFN,IBDT,IBCDA)
Q
;
ADCOM(IBDFN,IBPOLDA,IBPOLCOM) ; add new patient policy comment to multiple (2.312, 1.18)
;
L +^DPT(IBDFN,.312,IBPOLDA,13):5 I '$T D CMLKD Q
;
N FDA,IENS,DIERR
;
; -- populate FDA array
S IENS="+1"_","_IBPOLDA_","_IBDFN_","
S FDA(2.342,IENS,.01)=$$NOW^XLFDT()
S FDA(2.342,IENS,.02)=DUZ
S FDA(2.342,IENS,.03)=IBPOLCOM
;
; -- add comments
D UPDATE^DIE(,"FDA",,"DIERR") I $D(DIERR) W !,!,"Error...ADCOM-IBCN118...Cannot Add policy comment" D PAUSE^VALM1
L -^DPT(IBDFN,.312,IBPOLDA,13)
Q
;
EDCOM(IBDFN,IBDT,IBCDA) ; edit existing comment entry at 2.312,1.18 multiple
; Input:
; IBDT = date/time that comment was made
; CMIEN = comment IEN
;
; -- only make edits to comments if the first 80 characters are different
Q:$P($G(^DPT(IBDFN,.312,IBPOLDA,1)),U,8)=$E($P(^DPT(IBDFN,.312,IBPOLDA,13,IBCDA,1),U),1,80)
;
N FDA,IENS,DIERR
;
L +^DPT(IBDFN,.312,IBPOLDA,13):5 I '$T D CMLKD Q
;
; -- populate FDA array
S IENS=IBCDA_","_IBPOLDA_","_IBDFN_","
S FDA(2.342,IENS,.01)=$$NOW^XLFDT()
S FDA(2.342,IENS,.02)=DUZ
S FDA(2.342,IENS,.03)=$P($G(^DPT(IBDFN,.312,IBPOLDA,1)),U,8)
;
; -- update comments
D FILE^DIE("","FDA","DIERR") I $D(DIERR) W !,!,"Error...EDCOM-IBCN118...Cannot edit policy comments" D PAUSE^VALM1
L -^DPT(IBDFN,.312,IBPOLDA,13)
Q
;
TRIGKIL ; remove data at 2.312, 1.18 multiple when 2.312, 1.08 gets removed
;
; -- don't kill data at 1.18 multiple since data exists at 2.313, 1.08
Q:$P(^DPT(DA(1),.312,DA,1),U,8)]""
;
N FDA,IBDT,CMIEN,IENS,DIERR
;
S IBDT=$O(^DPT(DA(1),.312,DA,13,"BB",DUZ,""),-1)
;
; -- user doesn't have comments at the 1.18 multiple or the user has comments but not for the current date so quit
Q:IBDT']"" Q:$P(IBDT,".")'=DT
;
; -- populate FDA array
S CMIEN=$O(^DPT(DA(1),.312,DA,13,"BB",DUZ,IBDT,""),-1)
S IENS=CMIEN_","_DA_","_DA(1)_","
S FDA(2.342,IENS,.01)="@"
S FDA(2.342,IENS,.02)="@"
S FDA(2.342,IENS,.03)="@"
;
; -- update comments
D FILE^DIE("","FDA","DIERR") I $D(DIERR) W !,!,"Error...TRIGKIL-IBCN118...Cannot Remove data from (2.312,1.18)" D PAUSE^VALM1
Q
;
CMLKD ; -- write record locked message
W !!,"Sorry, another user currently editing this entry."
W !,"Try again later."
D PAUSE^VALM1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCN118 3378 printed Oct 16, 2024@18:14:19 Page 2
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
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
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
+2 ;
+3 ; Expected variables:
+4 ; DA = system wide array of iens associated with the patient record
+5 ; DUZ = system wide user IEN
+6 ;
+7 NEW IBDT,IBDFN,IBPOLDA,IBCDA,IBPOLCOM
+8 ;
+9 SET IBDFN=$GET(DA(1))
SET IBPOLDA=$GET(DA)
SET IBPOLCOM=$PIECE($GET(^DPT(IBDFN,.312,IBPOLDA,1)),U,8)
+10 ;
+11 ; -- comments do not exist for the user so add comments
+12 IF '$ORDER(^DPT(IBDFN,.312,IBPOLDA,13,"C",DUZ,""))
DO ADCOM(IBDFN,IBPOLDA,IBPOLCOM)
QUIT
+13 ;
+14 ; -- get the last policy comment entered and the comment IEN
+15 SET IBDT=$ORDER(^DPT(IBDFN,.312,IBPOLDA,13,"B",""),-1)
SET IBCDA=$ORDER(^DPT(IBDFN,.312,IBPOLDA,13,"B",IBDT,""),-1)
+16 ;
+17 ; -- edit comment if comment exist for the user
+18 IF $PIECE(^DPT(IBDFN,.312,IBPOLDA,13,IBCDA,0),U,2)=DUZ
DO EDCOM(IBDFN,IBDT,IBCDA)
+19 QUIT
+20 ;
ADCOM(IBDFN,IBPOLDA,IBPOLCOM) ; add new patient policy comment to multiple (2.312, 1.18)
+1 ;
+2 LOCK +^DPT(IBDFN,.312,IBPOLDA,13):5
IF '$TEST
DO CMLKD
QUIT
+3 ;
+4 NEW FDA,IENS,DIERR
+5 ;
+6 ; -- populate FDA array
+7 SET IENS="+1"_","_IBPOLDA_","_IBDFN_","
+8 SET FDA(2.342,IENS,.01)=$$NOW^XLFDT()
+9 SET FDA(2.342,IENS,.02)=DUZ
+10 SET FDA(2.342,IENS,.03)=IBPOLCOM
+11 ;
+12 ; -- add comments
+13 DO UPDATE^DIE(,"FDA",,"DIERR")
IF $DATA(DIERR)
WRITE !,!,"Error...ADCOM-IBCN118...Cannot Add policy comment"
DO PAUSE^VALM1
+14 LOCK -^DPT(IBDFN,.312,IBPOLDA,13)
+15 QUIT
+16 ;
EDCOM(IBDFN,IBDT,IBCDA) ; edit existing comment entry at 2.312,1.18 multiple
+1 ; Input:
+2 ; IBDT = date/time that comment was made
+3 ; CMIEN = comment IEN
+4 ;
+5 ; -- only make edits to comments if the first 80 characters are different
+6 if $PIECE($GET(^DPT(IBDFN,.312,IBPOLDA,1)),U,8)=$EXTRACT($PIECE(^DPT(IBDFN,.312,IBPOLDA,13,IBCDA,1),U),1,80)
QUIT
+7 ;
+8 NEW FDA,IENS,DIERR
+9 ;
+10 LOCK +^DPT(IBDFN,.312,IBPOLDA,13):5
IF '$TEST
DO CMLKD
QUIT
+11 ;
+12 ; -- populate FDA array
+13 SET IENS=IBCDA_","_IBPOLDA_","_IBDFN_","
+14 SET FDA(2.342,IENS,.01)=$$NOW^XLFDT()
+15 SET FDA(2.342,IENS,.02)=DUZ
+16 SET FDA(2.342,IENS,.03)=$PIECE($GET(^DPT(IBDFN,.312,IBPOLDA,1)),U,8)
+17 ;
+18 ; -- update comments
+19 DO FILE^DIE("","FDA","DIERR")
IF $DATA(DIERR)
WRITE !,!,"Error...EDCOM-IBCN118...Cannot edit policy comments"
DO PAUSE^VALM1
+20 LOCK -^DPT(IBDFN,.312,IBPOLDA,13)
+21 QUIT
+22 ;
TRIGKIL ; remove data at 2.312, 1.18 multiple when 2.312, 1.08 gets removed
+1 ;
+2 ; -- don't kill data at 1.18 multiple since data exists at 2.313, 1.08
+3 if $PIECE(^DPT(DA(1),.312,DA,1),U,8)]""
QUIT
+4 ;
+5 NEW FDA,IBDT,CMIEN,IENS,DIERR
+6 ;
+7 SET IBDT=$ORDER(^DPT(DA(1),.312,DA,13,"BB",DUZ,""),-1)
+8 ;
+9 ; -- user doesn't have comments at the 1.18 multiple or the user has comments but not for the current date so quit
+10 if IBDT']""
QUIT
if $PIECE(IBDT,".")'=DT
QUIT
+11 ;
+12 ; -- populate FDA array
+13 SET CMIEN=$ORDER(^DPT(DA(1),.312,DA,13,"BB",DUZ,IBDT,""),-1)
+14 SET IENS=CMIEN_","_DA_","_DA(1)_","
+15 SET FDA(2.342,IENS,.01)="@"
+16 SET FDA(2.342,IENS,.02)="@"
+17 SET FDA(2.342,IENS,.03)="@"
+18 ;
+19 ; -- update comments
+20 DO FILE^DIE("","FDA","DIERR")
IF $DATA(DIERR)
WRITE !,!,"Error...TRIGKIL-IBCN118...Cannot Remove data from (2.312,1.18)"
DO PAUSE^VALM1
+21 QUIT
+22 ;
CMLKD ; -- write record locked message
+1 WRITE !!,"Sorry, another user currently editing this entry."
+2 WRITE !,"Try again later."
+3 DO PAUSE^VALM1
+4 QUIT
