- ASDMERG ; IHS/ADC/PDW/ENM - -- sched patient merge ; [ 03/25/1999 11:48 AM ]
- ;;5.0;IHS SCHEDULING;;MAR 25, 1999
- ;
- ; ^SC(clinic,"S",appointment date/time,1,index,0)="patient^..."
- ; ^DPT(patient,"S",appointment date/time,0)="clinic^..."
- ;
- ; dfn=patient, c=clinic, i=index
- ; v=appointment date/time FM internal
- ;
- ;
- I '$G(XDRMRG("FR")),'$G(XDRMRG("TO")) Q
- N DFN,V,C,I,N,F
- A ; -- update patient pointer in 44
- S DFN=XDRMRG("FR"),V=0 F S V=$O(^DPT(DFN,"S",V)) Q:'V D
- . S C=+$G(^DPT(DFN,"S",V,0)) Q:'C
- . S I=0 F S I=$O(^SC(C,"S",V,1,I)) Q:'I D
- .. S N=$G(^SC(C,"S",V,1,I,0)) Q:'N Q:+N'=DFN
- .. S $P(^SC(C,"S",V,1,I,0),U)=XDRMRG("TO")
- . K F S F="",I=0 F S I=$O(^SC(C,"S",V,1,I)) Q:'I D
- .. S N=$G(^SC(C,"S",V,1,I,0)) Q:'N
- .. K:$G(F(+N)) ^SC(C,"S",V,1,I) S F(+N)=1 Q
- Q
- ;
- 44 ; -- check/cleanup 44
- N DFN,V,C,I,N,F
- S C=0 F S C=$O(^SC(C)) Q:'C D
- . S V=0 F S V=$O(^SC(C,"S",V)) Q:'V D
- .. K F S F="",I=0 F S I=$O(^SC(C,"S",V,1,I)) Q:'I D
- ... S N=$G(^SC(C,"S",V,1,I,0)) Q:'N
- ... S DFN=$P($G(^DPT(+N,0)),U,19)
- ... I DFN,$G(F(DFN)) K ^SC(C,"S",V,1,I) Q
- ... I $G(F(+N)) K ^SC(C,"S",V,1,I) Q
- ... S F(+N)=1 Q:'DFN S $P(^SC(C,"S",V,1,I,0),U)=DFN,F(DFN)=1
- Q
- ;
- 2 ; -- if patient file node and no 44, set
- N DFN,V,C,I,X,T,N,F
- S DFN=0 F S DFN=$O(^DPT(DFN)) Q:'DFN D
- . S V=0 F S V=$O(^DPT(DFN,"S",V)) Q:'V D
- .. S N=^DPT(DFN,"S",V,0) Q:'N S C=+N
- .. S T="",(N,X,F,I)=0 F S I=$O(^SC(C,"S",V,1,I)) Q:'I Q:F D
- ... S X=I+1,N=$G(^SC(C,"S",V,1,I,0)),T=$P(N,U,2) I +N=DFN S F=I
- .. Q:F S ^SC(C,"S",V,1,X,0)=DFN_U_T_U_U_"comp. gen."_U_U_DUZ_U_DT
- Q
- ASDMERG ; IHS/ADC/PDW/ENM - -- sched patient merge ; [ 03/25/1999 11:48 AM ]
- +1 ;;5.0;IHS SCHEDULING;;MAR 25, 1999
- +2 ;
- +3 ; ^SC(clinic,"S",appointment date/time,1,index,0)="patient^..."
- +4 ; ^DPT(patient,"S",appointment date/time,0)="clinic^..."
- +5 ;
- +6 ; dfn=patient, c=clinic, i=index
- +7 ; v=appointment date/time FM internal
- +8 ;
- +9 ;
- +10 IF '$GET(XDRMRG("FR"))
- IF '$GET(XDRMRG("TO"))
- QUIT
- +11 NEW DFN,V,C,I,N,F
- A ; -- update patient pointer in 44
- +1 SET DFN=XDRMRG("FR")
- SET V=0
- FOR
- SET V=$ORDER(^DPT(DFN,"S",V))
- IF 'V
- QUIT
- Begin DoDot:1
- +2 SET C=+$GET(^DPT(DFN,"S",V,0))
- IF 'C
- QUIT
- +3 SET I=0
- FOR
- SET I=$ORDER(^SC(C,"S",V,1,I))
- IF 'I
- QUIT
- Begin DoDot:2
- +4 SET N=$GET(^SC(C,"S",V,1,I,0))
- IF 'N
- QUIT
- IF +N'=DFN
- QUIT
- +5 SET $PIECE(^SC(C,"S",V,1,I,0),U)=XDRMRG("TO")
- End DoDot:2
- +6 KILL F
- SET F=""
- SET I=0
- FOR
- SET I=$ORDER(^SC(C,"S",V,1,I))
- IF 'I
- QUIT
- Begin DoDot:2
- +7 SET N=$GET(^SC(C,"S",V,1,I,0))
- IF 'N
- QUIT
- +8 IF $GET(F(+N))
- KILL ^SC(C,"S",V,1,I)
- SET F(+N)=1
- QUIT
- End DoDot:2
- End DoDot:1
- +9 QUIT
- +10 ;
- 44 ; -- check/cleanup 44
- +1 NEW DFN,V,C,I,N,F
- +2 SET C=0
- FOR
- SET C=$ORDER(^SC(C))
- IF 'C
- QUIT
- Begin DoDot:1
- +3 SET V=0
- FOR
- SET V=$ORDER(^SC(C,"S",V))
- IF 'V
- QUIT
- Begin DoDot:2
- +4 KILL F
- SET F=""
- SET I=0
- FOR
- SET I=$ORDER(^SC(C,"S",V,1,I))
- IF 'I
- QUIT
- Begin DoDot:3
- +5 SET N=$GET(^SC(C,"S",V,1,I,0))
- IF 'N
- QUIT
- +6 SET DFN=$PIECE($GET(^DPT(+N,0)),U,19)
- +7 IF DFN
- IF $GET(F(DFN))
- KILL ^SC(C,"S",V,1,I)
- QUIT
- +8 IF $GET(F(+N))
- KILL ^SC(C,"S",V,1,I)
- QUIT
- +9 SET F(+N)=1
- IF 'DFN
- QUIT
- SET $PIECE(^SC(C,"S",V,1,I,0),U)=DFN
- SET F(DFN)=1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +10 QUIT
- +11 ;
- 2 ; -- if patient file node and no 44, set
- +1 NEW DFN,V,C,I,X,T,N,F
- +2 SET DFN=0
- FOR
- SET DFN=$ORDER(^DPT(DFN))
- IF 'DFN
- QUIT
- Begin DoDot:1
- +3 SET V=0
- FOR
- SET V=$ORDER(^DPT(DFN,"S",V))
- IF 'V
- QUIT
- Begin DoDot:2
- +4 SET N=^DPT(DFN,"S",V,0)
- IF 'N
- QUIT
- SET C=+N
- +5 SET T=""
- SET (N,X,F,I)=0
- FOR
- SET I=$ORDER(^SC(C,"S",V,1,I))
- IF 'I
- QUIT
- IF F
- QUIT
- Begin DoDot:3
- +6 SET X=I+1
- SET N=$GET(^SC(C,"S",V,1,I,0))
- SET T=$PIECE(N,U,2)
- IF +N=DFN
- SET F=I
- End DoDot:3
- +7 IF F
- QUIT
- SET ^SC(C,"S",V,1,X,0)=DFN_U_T_U_U_"comp. gen."_U_U_DUZ_U_DT
- End DoDot:2
- End DoDot:1
- +8 QUIT
