177 lines
6.9 KiB
Mathematica
177 lines
6.9 KiB
Mathematica
FBPMRG1 ;WCIOFO/SAB-FEE BASIS PATIENT MERGE ROUTINE (cont) ;12/15/2001
|
|
;;3.5;FEE BASIS;**19,41**;JAN 30, 1995
|
|
Q
|
|
F162 ; File 162 FEE BASIS PAYMENT - The .01 field points to and is
|
|
; dinumed with the PATIENT (#2) file
|
|
; input
|
|
; FBFR - ien of patient (files #2,162) being merged from
|
|
; FBTO - ien of patient (files #2,162) being merged to
|
|
N FBAUTHP,FBFR1,FBFR2,FBFR3,FBFRIENS,FBTO1,FBTO2,FBTO3,FBTOIENS
|
|
N DA,DD,DO,DIC,DIK,DINUM,DLAYGO,X,Y
|
|
;
|
|
Q:'$D(^FBAAC(FBFR)) ; nothing to merge from
|
|
;
|
|
; since a 'from ien' exists, we'll need to keep track of the old
|
|
; and new 'iens' of payments that may have been reported to the
|
|
; Austin Automation Center (AAC). The AAC returns data concerning the
|
|
; payments and the 'iens' are used to locate the appropriate entry to
|
|
; update.
|
|
;
|
|
; Additionally, if both the from ien and to ien are in the FEE BASIS
|
|
; PAYMENT file then the SERVICE PROVIDED multiple and the TRAVEL
|
|
; PAYMENT DATE multiple will need to be handled here since they
|
|
; are allowed to have duplicate .01 values and a standard merge could
|
|
; inappropriately combine subfile entries whose .01 values match.
|
|
;
|
|
; medical payments
|
|
; loop thru vendor multiple
|
|
S FBFR1=0 F S FBFR1=$O(^FBAAC(FBFR,1,FBFR1)) Q:'FBFR1 D
|
|
. ; loop thru initial treatment date multiple
|
|
. S FBFR2=0 F S FBFR2=$O(^FBAAC(FBFR,1,FBFR1,1,FBFR2)) Q:'FBFR2 D
|
|
. . S FBAUTHP=$P($G(^FBAAC(FBFR,1,FBFR1,1,FBFR2,0)),U,4) ; auth pointer
|
|
. . ; loop thru service provided multiple
|
|
. . S FBFR3=0
|
|
. . F S FBFR3=$O(^FBAAC(FBFR,1,FBFR1,1,FBFR2,1,FBFR3)) Q:'FBFR3 D
|
|
. . . S FBFRIENS=FBFR3_","_FBFR2_","_FBFR1_","_FBFR_","
|
|
. . . ; If the 'to ien' does not exist then only the patient ien will be
|
|
. . . ; different on payments sent to the AAC. We just need to save
|
|
. . . ; the iens and the normal merge will take care of moving the data.
|
|
. . . I '$D(^FBAAC(FBTO)) S FBTOIENS=FBFR3_","_FBFR2_","_FBFR1_","_FBTO_","
|
|
. . . E D
|
|
. . . . ; both from ien and to ien are in the FEE BASIS PAYMENT file
|
|
. . . . S (FBTO1,FBTO2,FBTO3,FBTOIENS)="" ; initialize new iens
|
|
. . . . ;
|
|
. . . . ; create new service provided entry in 'to ien'
|
|
. . . . ; find or create vendor subentry in 'to ien'
|
|
. . . . I $D(^FBAAC(FBTO,1,FBFR1)) S FBTO1=FBFR1
|
|
. . . . E D
|
|
. . . . . ; need to add vendor subentry
|
|
. . . . . K DA,DD,DO
|
|
. . . . . S DA(1)=FBTO
|
|
. . . . . S DIC="^FBAAC("_DA(1)_",1,"
|
|
. . . . . S DIC(0)="L"
|
|
. . . . . S X=$P($G(^FBAAC(FBFR,1,FBFR1,0)),U)
|
|
. . . . . Q:X=""
|
|
. . . . . S DINUM=X,DLAYGO=162.01
|
|
. . . . . D FILE^DICN K DIC,DINUM,DLAYGO
|
|
. . . . . Q:$P(Y,U,3)'=1 ; couldn't add vendor subentry
|
|
. . . . . S FBTO1=+Y
|
|
. . . . Q:'$G(FBTO1) ; couldn't find or add the vendor in FBTO
|
|
. . . . ;
|
|
. . . . ; find or create initial treatment date subentry in 'to ien'
|
|
. . . . ;
|
|
. . . . S X=$P($G(^FBAAC(FBFR,1,FBFR1,1,FBFR2,0)),U) ; init treat date
|
|
. . . . Q:X=""
|
|
. . . . S FBTO2=$O(^FBAAC(FBTO,FBTO1,"AD",(9999999.9999-X),0))
|
|
. . . . I 'FBTO2 D
|
|
. . . . . ; need to add initial treatment date subentry
|
|
. . . . . K DA,DD,DO
|
|
. . . . . S DA(2)=FBTO
|
|
. . . . . S DA(1)=FBTO1
|
|
. . . . . S DIC="^FBAAC("_DA(2)_",1,"_DA(1)_",1,"
|
|
. . . . . S DIC(0)="L"
|
|
. . . . . S:FBAUTHP DIC("DR")="3////^S X=FBAUTHP" ;authorization pointer
|
|
. . . . . I $D(@(DIC_FBFR2_")"))=0 S DINUM=FBFR2 ; use same ien if avail
|
|
. . . . . S DLAYGO=162.02
|
|
. . . . . D FILE^DICN K DIC,DINUM,DLAYGO
|
|
. . . . . Q:$P(Y,U,3)'=1 ; couldn't add init treat date subentry
|
|
. . . . . S FBTO2=+Y
|
|
. . . . Q:'$G(FBTO2) ; couldn't find or add the init treat date in FBTO
|
|
. . . . ;
|
|
. . . . ; create new entry in service provided multiple of 'to ien'
|
|
. . . . K DA,DD,DO
|
|
. . . . S DA(3)=FBTO,DA(2)=FBTO1,DA(1)=FBTO2
|
|
. . . . S DIC="^FBAAC("_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"
|
|
. . . . S DIC(0)="L"
|
|
. . . . S X=$P($G(^FBAAC(FBFR,1,FBFR1,1,FBFR2,1,FBFR3,0)),U)
|
|
. . . . Q:X="" ; can't add without a service provided
|
|
. . . . I $D(@(DIC_FBFR3_")"))=0 S DINUM=FBFR3 ; use same ien if avail.
|
|
. . . . S DLAYGO=162.03
|
|
. . . . D FILE^DICN K DIC,DINUM,DLAYGO
|
|
. . . . Q:$P(Y,U,3)'=1 ; couldn't add new subentry
|
|
. . . . S FBTO3=+Y
|
|
. . . . S FBTOIENS=FBTO3_","_FBTO2_","_FBTO1_","_FBTO_","
|
|
. . . . ;
|
|
. . . . ; move service provided data
|
|
. . . . M ^FBAAC(FBTO,1,FBTO1,1,FBTO2,1,FBTO3)=^FBAAC(FBFR,1,FBFR1,1,FBFR2,1,FBFR3)
|
|
. . . . ;
|
|
. . . . ; delete 'from' service provided
|
|
. . . . K DA S DA(3)=FBFR,DA(2)=FBFR1,DA(1)=FBFR2,DA=FBFR3
|
|
. . . . S DIK="^FBAAC("_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"
|
|
. . . . D ^DIK K DA,DIK
|
|
. . . . ;
|
|
. . . . ; index 'to' service provided
|
|
. . . . K DA S DA(3)=FBTO,DA(2)=FBTO1,DA(1)=FBTO2,DA=FBTO3
|
|
. . . . S DIK="^FBAAC("_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"
|
|
. . . . D IX1^DIK K DA,DIK
|
|
. . . . ;
|
|
. . . Q:$G(FBTOIENS)="" ; unable to move service provided to FBTO
|
|
. . . ; save iens (FBFRIENS and FBTOIENS) to file
|
|
. . . D SAVIENS(162.03,FBFRIENS,FBTOIENS)
|
|
. . ; if all service provided entries moved then delete the treat. date
|
|
. . I $P($G(^FBAAC(FBFR,1,FBFR1,1,FBFR2,1,0)),U,4)=0 D
|
|
. . . K DA S DA(2)=FBFR,DA(1)=FBFR1,DA=FBFR2
|
|
. . . S DIK="^FBAAC("_DA(2)_",1,"_DA(1)_",1,"
|
|
. . . D ^DIK K DA,DIK
|
|
. ; if all initial treatment dates moved then delete the vendor
|
|
. I $P($G(^FBAAC(FBFR,1,FBFR1,1,0)),U,4)=0 D
|
|
. . K DA S DA(1)=FBFR,DA=FBFR1
|
|
. . S DIK="^FBAAC("_DA(1)_",1,"
|
|
. . D ^DIK K DA,DIK
|
|
;
|
|
; travel payments
|
|
; loop thru travel payment date multiple
|
|
S FBFR1=0 F S FBFR1=$O(^FBAAC(FBFR,3,FBFR1)) Q:'FBFR1 D
|
|
. S FBFRIENS=FBFR1_","_FBFR_","
|
|
. ; If the 'to ien' does not exist then only the patient ien will be
|
|
. ; different on payments sent to the AAC. We just need to save
|
|
. ; the iens and the normal merge will take care of moving the data.
|
|
. I '$D(^FBAAC(FBTO)) S FBTOIENS=FBFR1_","_FBTO_","
|
|
. E D
|
|
. . ; both from ien and to ien are in the FEE BASIS PAYMENT file
|
|
. . ; create travel payment date subentry in to ien
|
|
. . S (FBTO1,FBTOIENS)="" ; initialize new iens
|
|
. . K DA,DD,DO
|
|
. . S DA(1)=FBTO
|
|
. . S DIC="^FBAAC("_DA(1)_",3,"
|
|
. . S DIC(0)="L"
|
|
. . S X=$P($G(^FBAAC(FBFR,3,FBFR1,0)),U)
|
|
. . Q:X="" ; can't add without a travel payment date
|
|
. . I $D(@(DIC_FBFR1_")"))=0 S DINUM=FBFR1 ; use same ien if avail.
|
|
. . S DLAYGO=162.04
|
|
. . D FILE^DICN K DIC,DINUM,DLAYGO
|
|
. . Q:$P(Y,U,3)'=1 ; couldn't add new subentry
|
|
. . S FBTO1=+Y
|
|
. . S FBTOIENS=FBTO1_","_FBTO_","
|
|
. . ;
|
|
. . ; move data
|
|
. . M ^FBAAC(FBTO,3,FBTO1)=^FBAAC(FBFR,3,FBFR1)
|
|
. . ;
|
|
. . ; delete from ien
|
|
. . K DA S DA(1)=FBFR,DA=FBFR1
|
|
. . S DIK="^FBAAC("_DA(1)_",3,"
|
|
. . D ^DIK K DA,DIK
|
|
. . ;
|
|
. . ; index to ien
|
|
. . K DA S DA(1)=FBTO,DA=FBTO1
|
|
. . S DIK="^FBAAC("_DA(1)_",3,"
|
|
. . D IX1^DIK K DA,DIK
|
|
. ;
|
|
. Q:$G(FBTOIENS)="" ; unable to move travel payment date to FBTO
|
|
. ; save iens (FBFRIENS and FBTOIENS) to file
|
|
. D SAVIENS(162.04,FBFRIENS,FBTOIENS)
|
|
;
|
|
Q
|
|
;
|
|
SAVIENS(FBFILE,FBOLDIEN,FBNEWIEN) ; save old & new iens in file 161.45
|
|
N DA,DD,DIC,DLAYGO,DO,X,Y
|
|
S DIC="^FBAA(161.45,",DIC(0)="L"
|
|
S X=FBFILE
|
|
Q:X="" ; can't add without a from date
|
|
S DIC("DR")="1////^S X=FBOLDIEN;2////^S X=FBNEWIEN"
|
|
S DLAYGO=161.45
|
|
D FILE^DICN K DIC,DLAYGO
|
|
Q
|
|
;
|
|
;FBPMRG1
|