- ACHSMERG ; IHS/ITSC/TPF/PMF - CHS PATIENT MERGE INTERFACE ;
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**20**;JUN 11, 2001
- ;
- ; This entire routine is in support
- ; of the patient merge development and testing.
- ;
- ; XDRMRG("FR") contains DFN of FROM pt (one being merged away)
- ; XDRMRG("TO") contains DFN of TO pt (the one being kept)
- ;
- ;ACHS*3.1*20 IHS.OIT.FCJ 7-28-11 ADDED NXT LINE FOR CALL FROM MERGE ROUTINES
- EN(XDRMRG) ;EP
- ;
- Q:'$D(XDRMRG("FR"))
- Q:'$D(XDRMRG("TO"))
- ;
- ; S XDRMRG("FR")=1062,XDRMRG("TO")=1064 ; *** FOR TESTING, ONLY
- ; S XDRMRG("FR")=1064,XDRMRG("TO")=1062 ; *** FOR TESTING, ONLY
- ;
- N L,D,T
- ;
- ; L = Location
- ; D = Document IEN
- ; T = Transaction IEN
- ;
- ; ^ACHSF(DA(1),"PB",+X,DA,1)
- ; ^ACHSF("AC",$E(X,1,30),DA(2),DA(1),DA)
- ; ^ACHSF(DA(2),"EOBP",+X,DA(1),DA,9999999-%)
- ; The "PB" x-ref is more reliable. The "AC" is only set at
- ; final pay.
- ; One entire document is merged, at once, rather than use the "PB"
- ; for the Document record, then the "AC" for the transaction
- ; records, to minimize the possibility of errors.
- ;
- S L=0
- ;
- F S L=$O(^ACHSF(L)) Q:'L S D=0 F S D=$O(^ACHSF(L,"PB",XDRMRG("FR"),D)) Q:'D D
- .K ^ACHSF(L,"PB",XDRMRG("FR"),D)
- .Q:'$D(^ACHSF(L,"D",D,0))
- .S $P(^ACHSF(L,"D",D,0),U,22)=XDRMRG("TO")
- .S ^ACHSF(L,"PB",XDRMRG("TO"),D,1)=""
- .S T=0
- .F S T=$O(^ACHSF(L,"D",D,"T",T)) Q:'T D
- ..K ^ACHSF("AC",XDRMRG("FR"),L,D,T)
- ..K ^ACHSF(L,"EOBP",XDRMRG("FR"),D,T)
- ..S $P(^ACHSF(L,"D",D,"T",T,0),U,3)=XDRMRG("TO")
- ..S ^ACHSF("AC",XDRMRG("TO"),L,D,T)=""
- ..S %=$P(^ACHSF(L,"D",D,"T",T,0),U,13)
- ..I % S ^ACHSF(L,"EOBP",XDRMRG("TO"),D,T,9999999-%)=""
- ..Q
- .Q
- ;
- ;
- ;
- ; L = Patient Name
- ; D = Denial IEN
- ;
- ; ^ACHSDEN("C",$P(^DPT(X,0),U,1),DA)
- ;
- S L=$P(^DPT(XDRMRG("FR"),0),U),D=0
- ;
- F S D=$O(^ACHSDEN("C",L,D)) Q:'D I $P(^ACHSDEN(D,0),U,4)="Y" D
- .K ^ACHSDEN("C",L,D)
- .S $P(^ACHSDEN(D,0),U,5)=XDRMRG("TO")
- .S ^ACHSDEN("C",$P(^DPT(XDRMRG("TO"),0),U),D)=""
- .Q
- ;
- Q
- ;
- ;
- FR ;EP - From PACKAGE file, to determine if FR pt has data for pt merge.
- Q:'$D(XDRMRG("FR"))
- N L
- ;
- ; L = Location or Pt Name
- ;
- S L=0
- ;
- F S L=$O(^ACHSF(L)) Q:'L I $O(^ACHSF(L,"PB",XDRMRG("FR"),0)) S XDRZ=1 Q
- ;
- S L=$P(^DPT(XDRMRG("FR"),0),U),D=0
- ;
- F S D=$O(^ACHSDEN("C",L,D)) Q:'D I $P(^ACHSDEN(D,0),U,4)="Y" S XDRZ=1 Q
- ;
- Q
- ;
- ACHSMERG ; IHS/ITSC/TPF/PMF - CHS PATIENT MERGE INTERFACE ;
- +1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**20**;JUN 11, 2001
- +2 ;
- +3 ; This entire routine is in support
- +4 ; of the patient merge development and testing.
- +5 ;
- +6 ; XDRMRG("FR") contains DFN of FROM pt (one being merged away)
- +7 ; XDRMRG("TO") contains DFN of TO pt (the one being kept)
- +8 ;
- +9 ;ACHS*3.1*20 IHS.OIT.FCJ 7-28-11 ADDED NXT LINE FOR CALL FROM MERGE ROUTINES
- EN(XDRMRG) ;EP
- +1 ;
- +2 IF '$DATA(XDRMRG("FR"))
- QUIT
- +3 IF '$DATA(XDRMRG("TO"))
- QUIT
- +4 ;
- +5 ; S XDRMRG("FR")=1062,XDRMRG("TO")=1064 ; *** FOR TESTING, ONLY
- +6 ; S XDRMRG("FR")=1064,XDRMRG("TO")=1062 ; *** FOR TESTING, ONLY
- +7 ;
- +8 NEW L,D,T
- +9 ;
- +10 ; L = Location
- +11 ; D = Document IEN
- +12 ; T = Transaction IEN
- +13 ;
- +14 ; ^ACHSF(DA(1),"PB",+X,DA,1)
- +15 ; ^ACHSF("AC",$E(X,1,30),DA(2),DA(1),DA)
- +16 ; ^ACHSF(DA(2),"EOBP",+X,DA(1),DA,9999999-%)
- +17 ; The "PB" x-ref is more reliable. The "AC" is only set at
- +18 ; final pay.
- +19 ; One entire document is merged, at once, rather than use the "PB"
- +20 ; for the Document record, then the "AC" for the transaction
- +21 ; records, to minimize the possibility of errors.
- +22 ;
- +23 SET L=0
- +24 ;
- +25 FOR
- SET L=$ORDER(^ACHSF(L))
- IF 'L
- QUIT
- SET D=0
- FOR
- SET D=$ORDER(^ACHSF(L,"PB",XDRMRG("FR"),D))
- IF 'D
- QUIT
- Begin DoDot:1
- +26 KILL ^ACHSF(L,"PB",XDRMRG("FR"),D)
- +27 IF '$DATA(^ACHSF(L,"D",D,0))
- QUIT
- +28 SET $PIECE(^ACHSF(L,"D",D,0),U,22)=XDRMRG("TO")
- +29 SET ^ACHSF(L,"PB",XDRMRG("TO"),D,1)=""
- +30 SET T=0
- +31 FOR
- SET T=$ORDER(^ACHSF(L,"D",D,"T",T))
- IF 'T
- QUIT
- Begin DoDot:2
- +32 KILL ^ACHSF("AC",XDRMRG("FR"),L,D,T)
- +33 KILL ^ACHSF(L,"EOBP",XDRMRG("FR"),D,T)
- +34 SET $PIECE(^ACHSF(L,"D",D,"T",T,0),U,3)=XDRMRG("TO")
- +35 SET ^ACHSF("AC",XDRMRG("TO"),L,D,T)=""
- +36 SET %=$PIECE(^ACHSF(L,"D",D,"T",T,0),U,13)
- +37 IF %
- SET ^ACHSF(L,"EOBP",XDRMRG("TO"),D,T,9999999-%)=""
- +38 QUIT
- End DoDot:2
- +39 QUIT
- End DoDot:1
- +40 ;
- +41 ;
- +42 ;
- +43 ; L = Patient Name
- +44 ; D = Denial IEN
- +45 ;
- +46 ; ^ACHSDEN("C",$P(^DPT(X,0),U,1),DA)
- +47 ;
- +48 SET L=$PIECE(^DPT(XDRMRG("FR"),0),U)
- SET D=0
- +49 ;
- +50 FOR
- SET D=$ORDER(^ACHSDEN("C",L,D))
- IF 'D
- QUIT
- IF $PIECE(^ACHSDEN(D,0),U,4)="Y"
- Begin DoDot:1
- +51 KILL ^ACHSDEN("C",L,D)
- +52 SET $PIECE(^ACHSDEN(D,0),U,5)=XDRMRG("TO")
- +53 SET ^ACHSDEN("C",$PIECE(^DPT(XDRMRG("TO"),0),U),D)=""
- +54 QUIT
- End DoDot:1
- +55 ;
- +56 QUIT
- +57 ;
- +58 ;
- FR ;EP - From PACKAGE file, to determine if FR pt has data for pt merge.
- +1 IF '$DATA(XDRMRG("FR"))
- QUIT
- +2 NEW L
- +3 ;
- +4 ; L = Location or Pt Name
- +5 ;
- +6 SET L=0
- +7 ;
- +8 FOR
- SET L=$ORDER(^ACHSF(L))
- IF 'L
- QUIT
- IF $ORDER(^ACHSF(L,"PB",XDRMRG("FR"),0))
- SET XDRZ=1
- QUIT
- +9 ;
- +10 SET L=$PIECE(^DPT(XDRMRG("FR"),0),U)
- SET D=0
- +11 ;
- +12 FOR
- SET D=$ORDER(^ACHSDEN("C",L,D))
- IF 'D
- QUIT
- IF $PIECE(^ACHSDEN(D,0),U,4)="Y"
- SET XDRZ=1
- QUIT
- +13 ;
- +14 QUIT
- +15 ;
