FBAAUTL7 ;AISC/CMR,dmk,WCIOFO/SAB-UTILITY ROUTINE ;5/27/1999
;;3.5;FEE BASIS;**4**;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
SCPT ;set "AE" x-ref when SERVICE PROVIDED field is added or modified
; called by .01 field of SERVICE PROVIDED multiple in file 162
; input
; X = new value of SERVICE PROVIDED (internal)
; DA = IEN of entry in SERVICE PROVIDED multiple
; DA(1) = IEN of entry in INITIAL TREATMENT DATE multiple
; DA(2) = IEN of entry in VENDOR multiple
; DA(3) = IEN of PATIENT in file #162
;
Q:'$G(X)
N FBAADT,Y
; obtain current value of INITIAL TREATMENT DATE field from global
S FBAADT=$P(^FBAAC(DA(3),1,DA(2),1,DA(1),0),U)
; build sorted list of CPT modifers from the CPT MODIFIER multiple
S Y=$$MODL^FBAAUTL4("^FBAAC("_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"_DA_",""M"")")
; set node in "AE" x-ref
S ^FBAAC("AE",DA(3),DA(2),FBAADT,X_$S(Y]"":"-"_Y,1:""),DA)=""
Q
;
KCPT ;kill "AE" x-ref when SERVICE PROVIDED field is deleted or modified
; called by .01 field of SERVICE PROVIDED multiple in file 162
; input
; X = old value of SERVICE PROVIDED (internal)
; DA = IEN of entry in SERVICE PROVIDED multiple
; DA(1) = IEN of entry in INITIAL TREATMENT DATE multiple
; DA(2) = IEN of entry in VENDOR multiple
; DA(3) = IEN of PATIENT in file #162
;
Q:'$G(X)
N CPTM,FBAADT,Y
; obtain current value of INITIAL TREATMENT DATE field from global
S FBAADT=$P(^FBAAC(DA(3),1,DA(2),1,DA(1),0),U)
; kill all nodes in x-ref for this SERVICE PROVIDED entry (DA)
; Note: Deleting an entry in the SERVICE PROVIDED multiple will
; cause the x-ref kill logic of the CPT MODIFIER sub-multiple to be
; executed for each modifer before any global updates take place.
; Therefore, there can be several nodes to delete by the time the
; SERVICE PROVIDED field kill logic is run since each CPT MODIFIER
; kill logic will have set a node for any remaining modifiers.
S CPTM=""
F S CPTM=$O(^FBAAC("AE",DA(3),DA(2),FBAADT,CPTM)) Q:CPTM="" D
. I $D(^FBAAC("AE",DA(3),DA(2),FBAADT,CPTM,DA)) K ^(DA)
Q
;
SMOD ;set "AE" x-ref when CPT MODIFIER is added or modified
; called by .01 field of CPT MODIFIER multiple in file 162
; input
; X = new value of CPT MODIFIER (internal)
; DA = IEN of entry in CPT MODIFIER multiple
; DA(1) = IEN of entry in SERVICE PROVIDED multiple
; DA(2) = IEN of entry in INITIAL TREATMENT DATE multiple
; DA(3) = IEN of entry in VENDOR multiple
; DA(4) = IEN of PATIENT in file #162
;
Q:'$G(X)
N FBAADT,FBAACP,FBMODA,Y
; obtain current value of INITIAL TREATMENT DATE field
S FBAADT=$P(^FBAAC(DA(4),1,DA(3),1,DA(2),0),U)
; obtain current value of SERVICE PROVIDED field
S FBAACP=$P($G(^FBAAC(DA(4),1,DA(3),1,DA(2),1,DA(1),0)),U)
; obtain array of modifiers in global for CPT MODIFIER multiple
D MODDATA^FBAAUTL4(DA(4),DA(3),DA(2),DA(1))
;
; when a new/changed modifier is entered, the x-ref that previously
; existed will need to be deleted.
; remove node associated with new/changed modifier from array
K FBMODA(DA)
; build sorted list of modifiers without the new/changed modifier
S Y=$$MODL^FBAAUTL4("FBMODA")
; kill existing x-ref node (if any) for the service
K:$D(^FBAAC("AE",DA(4),DA(3),FBAADT,FBAACP_$S(Y]"":"-"_Y,1:""),DA(1))) ^(DA(1))
;
; now create a node in the x-ref for the new/changed value
; add new/changed modifier to modifier array
S FBMODA(DA)=X
; build sorted list of all modifiers
S Y=$$MODL^FBAAUTL4("FBMODA")
; set x-ref node
S ^FBAAC("AE",DA(4),DA(3),FBAADT,FBAACP_"-"_Y,DA(1))=""
Q
;
KMOD ;kill "AE" x-ref when CPT MODIFIER is deleted or modified
; called by .01 field of CPT MODIFIER multiple in file 162
; input
; X = old value of CPT MODIFIER (internal)
; DA = IEN of entry in CPT MODIFIER multiple
; DA(1) = IEN of entry in SERVICE PROVIDED multiple
; DA(2) = IEN of entry in INITIAL TREATMENT DATE multiple
; DA(3) = IEN of entry in VENDOR multiple
; DA(4) = IEN of PATIENT in file #162
;
Q:'$G(X)
N FBAADT,FBAACP,FBMODA,Y
; obtain current value of INITIAL TREATMENT DATE field
S FBAADT=$P(^FBAAC(DA(4),1,DA(3),1,DA(2),0),U)
; obtain current value of SERVICE PROVIDED field
S FBAACP=$P($G(^FBAAC(DA(4),1,DA(3),1,DA(2),1,DA(1),0)),U)
; obtain array of modifiers in global for CPT MODIFIER multiple
D MODDATA^FBAAUTL4(DA(4),DA(3),DA(2),DA(1))
;
; if a CPT modifier was deleted or changed then we need to delete
; the x-ref for the old value
; overwrite node in array for the deleted/changed CPT modifier since
; the global may have already been updated
S FBMODA(DA)=X
; build sorted list of CPT modifiers
S Y=$$MODL^FBAAUTL4("FBMODA")
; kill existing x-ref node
K:$D(^FBAAC("AE",DA(4),DA(3),FBAADT,FBAACP_$S(Y]"":"-"_Y,1:""),DA(1))) ^(DA(1))
;
; if a CPT modifier was deleted then we need to set a x-ref node for
; procedure and any remaining modifiers. Note that during a change
; the set logic is run after the kill logic and it will delete the
; x-ref node created here before setting a node for the new value.
; remove deleted/changed modifier from array
K FBMODA(DA)
; build sorted list of remaining modifiers
S Y=$$MODL^FBAAUTL4("FBMODA")
; set x-ref node
S ^FBAAC("AE",DA(4),DA(3),FBAADT,FBAACP_$S(Y]"":"-"_Y,1:""),DA(1))=""
Q
;
;FBAAUTL7
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAUTL7 5470 printed Apr 09, 2024@21:00:32 Page 2
FBAAUTL7 ;AISC/CMR,dmk,WCIOFO/SAB-UTILITY ROUTINE ;5/27/1999
+1 ;;3.5;FEE BASIS;**4**;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
SCPT ;set "AE" x-ref when SERVICE PROVIDED field is added or modified
+1 ; called by .01 field of SERVICE PROVIDED multiple in file 162
+2 ; input
+3 ; X = new value of SERVICE PROVIDED (internal)
+4 ; DA = IEN of entry in SERVICE PROVIDED multiple
+5 ; DA(1) = IEN of entry in INITIAL TREATMENT DATE multiple
+6 ; DA(2) = IEN of entry in VENDOR multiple
+7 ; DA(3) = IEN of PATIENT in file #162
+8 ;
+9 if '$GET(X)
QUIT
+10 NEW FBAADT,Y
+11 ; obtain current value of INITIAL TREATMENT DATE field from global
+12 SET FBAADT=$PIECE(^FBAAC(DA(3),1,DA(2),1,DA(1),0),U)
+13 ; build sorted list of CPT modifers from the CPT MODIFIER multiple
+14 SET Y=$$MODL^FBAAUTL4("^FBAAC("_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"_DA_",""M"")")
+15 ; set node in "AE" x-ref
+16 SET ^FBAAC("AE",DA(3),DA(2),FBAADT,X_$SELECT(Y]"":"-"_Y,1:""),DA)=""
+17 QUIT
+18 ;
KCPT ;kill "AE" x-ref when SERVICE PROVIDED field is deleted or modified
+1 ; called by .01 field of SERVICE PROVIDED multiple in file 162
+2 ; input
+3 ; X = old value of SERVICE PROVIDED (internal)
+4 ; DA = IEN of entry in SERVICE PROVIDED multiple
+5 ; DA(1) = IEN of entry in INITIAL TREATMENT DATE multiple
+6 ; DA(2) = IEN of entry in VENDOR multiple
+7 ; DA(3) = IEN of PATIENT in file #162
+8 ;
+9 if '$GET(X)
QUIT
+10 NEW CPTM,FBAADT,Y
+11 ; obtain current value of INITIAL TREATMENT DATE field from global
+12 SET FBAADT=$PIECE(^FBAAC(DA(3),1,DA(2),1,DA(1),0),U)
+13 ; kill all nodes in x-ref for this SERVICE PROVIDED entry (DA)
+14 ; Note: Deleting an entry in the SERVICE PROVIDED multiple will
+15 ; cause the x-ref kill logic of the CPT MODIFIER sub-multiple to be
+16 ; executed for each modifer before any global updates take place.
+17 ; Therefore, there can be several nodes to delete by the time the
+18 ; SERVICE PROVIDED field kill logic is run since each CPT MODIFIER
+19 ; kill logic will have set a node for any remaining modifiers.
+20 SET CPTM=""
+21 FOR
SET CPTM=$ORDER(^FBAAC("AE",DA(3),DA(2),FBAADT,CPTM))
if CPTM=""
QUIT
Begin DoDot:1
+22 IF $DATA(^FBAAC("AE",DA(3),DA(2),FBAADT,CPTM,DA))
KILL ^(DA)
End DoDot:1
+23 QUIT
+24 ;
SMOD ;set "AE" x-ref when CPT MODIFIER is added or modified
+1 ; called by .01 field of CPT MODIFIER multiple in file 162
+2 ; input
+3 ; X = new value of CPT MODIFIER (internal)
+4 ; DA = IEN of entry in CPT MODIFIER multiple
+5 ; DA(1) = IEN of entry in SERVICE PROVIDED multiple
+6 ; DA(2) = IEN of entry in INITIAL TREATMENT DATE multiple
+7 ; DA(3) = IEN of entry in VENDOR multiple
+8 ; DA(4) = IEN of PATIENT in file #162
+9 ;
+10 if '$GET(X)
QUIT
+11 NEW FBAADT,FBAACP,FBMODA,Y
+12 ; obtain current value of INITIAL TREATMENT DATE field
+13 SET FBAADT=$PIECE(^FBAAC(DA(4),1,DA(3),1,DA(2),0),U)
+14 ; obtain current value of SERVICE PROVIDED field
+15 SET FBAACP=$PIECE($GET(^FBAAC(DA(4),1,DA(3),1,DA(2),1,DA(1),0)),U)
+16 ; obtain array of modifiers in global for CPT MODIFIER multiple
+17 DO MODDATA^FBAAUTL4(DA(4),DA(3),DA(2),DA(1))
+18 ;
+19 ; when a new/changed modifier is entered, the x-ref that previously
+20 ; existed will need to be deleted.
+21 ; remove node associated with new/changed modifier from array
+22 KILL FBMODA(DA)
+23 ; build sorted list of modifiers without the new/changed modifier
+24 SET Y=$$MODL^FBAAUTL4("FBMODA")
+25 ; kill existing x-ref node (if any) for the service
+26 if $DATA(^FBAAC("AE",DA(4),DA(3),FBAADT,FBAACP_$SELECT(Y]""
KILL ^(DA(1))
+27 ;
+28 ; now create a node in the x-ref for the new/changed value
+29 ; add new/changed modifier to modifier array
+30 SET FBMODA(DA)=X
+31 ; build sorted list of all modifiers
+32 SET Y=$$MODL^FBAAUTL4("FBMODA")
+33 ; set x-ref node
+34 SET ^FBAAC("AE",DA(4),DA(3),FBAADT,FBAACP_"-"_Y,DA(1))=""
+35 QUIT
+36 ;
KMOD ;kill "AE" x-ref when CPT MODIFIER is deleted or modified
+1 ; called by .01 field of CPT MODIFIER multiple in file 162
+2 ; input
+3 ; X = old value of CPT MODIFIER (internal)
+4 ; DA = IEN of entry in CPT MODIFIER multiple
+5 ; DA(1) = IEN of entry in SERVICE PROVIDED multiple
+6 ; DA(2) = IEN of entry in INITIAL TREATMENT DATE multiple
+7 ; DA(3) = IEN of entry in VENDOR multiple
+8 ; DA(4) = IEN of PATIENT in file #162
+9 ;
+10 if '$GET(X)
QUIT
+11 NEW FBAADT,FBAACP,FBMODA,Y
+12 ; obtain current value of INITIAL TREATMENT DATE field
+13 SET FBAADT=$PIECE(^FBAAC(DA(4),1,DA(3),1,DA(2),0),U)
+14 ; obtain current value of SERVICE PROVIDED field
+15 SET FBAACP=$PIECE($GET(^FBAAC(DA(4),1,DA(3),1,DA(2),1,DA(1),0)),U)
+16 ; obtain array of modifiers in global for CPT MODIFIER multiple
+17 DO MODDATA^FBAAUTL4(DA(4),DA(3),DA(2),DA(1))
+18 ;
+19 ; if a CPT modifier was deleted or changed then we need to delete
+20 ; the x-ref for the old value
+21 ; overwrite node in array for the deleted/changed CPT modifier since
+22 ; the global may have already been updated
+23 SET FBMODA(DA)=X
+24 ; build sorted list of CPT modifiers
+25 SET Y=$$MODL^FBAAUTL4("FBMODA")
+26 ; kill existing x-ref node
+27 if $DATA(^FBAAC("AE",DA(4),DA(3),FBAADT,FBAACP_$SELECT(Y]""
KILL ^(DA(1))
+28 ;
+29 ; if a CPT modifier was deleted then we need to set a x-ref node for
+30 ; procedure and any remaining modifiers. Note that during a change
+31 ; the set logic is run after the kill logic and it will delete the
+32 ; x-ref node created here before setting a node for the new value.
+33 ; remove deleted/changed modifier from array
+34 KILL FBMODA(DA)
+35 ; build sorted list of remaining modifiers
+36 SET Y=$$MODL^FBAAUTL4("FBMODA")
+37 ; set x-ref node
+38 SET ^FBAAC("AE",DA(4),DA(3),FBAADT,FBAACP_$SELECT(Y]"":"-"_Y,1:""),DA(1))=""
+39 QUIT
+40 ;
+41 ;FBAAUTL7
