BSDMERG.m

BSDMERG ; IHS/ANMC/LJF - SCHED PATIENT MERGE ; 

 ;;5.3;PIMS;;APR 26, 2002

 ;

 ;  ^SC(clinic,"S",appointment date/time,1,index,0)="patient^..." 

 ;  ^SC(clinic,"C",chart request date,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

 ;

 ; -- update patient pointer in 44 

 NEW DFN,DATE,CLN,I,NODE

 S DFN=XDRMRG("FR"),DATE=0

 F  S DATE=$O(^DPT(DFN,"S",DATE)) Q:'DATE  D    ;find from pat's appts

 . S CLN=+$G(^DPT(DFN,"S",DATE,0)) Q:'CLN       ;get clinic

 . S I=0

 . F  S I=$O(^SC(CLN,"S",DATE,1,I)) Q:'I  D     ;find appt under clinic

 .. S NODE=$G(^SC(CLN,"S",DATE,1,I,0)) Q:'NODE

 .. Q:+NODE'=DFN                                  ;quit if not this pat

 .. S $P(^SC(CLN,"S",DATE,1,I,0),U)=XDRMRG("TO")  ;reset to "to" pat

 ;

 ; -- check all chart request nodes for from patient

 S CLN=0

 F  S CLN=$O(^SC(CLN)) Q:'CLN  D

 . S DATE=0 F  S DATE=$O(^SC(CLN,"C",DATE)) Q:'DATE  D

 .. S I=0 F  S I=$O(^SC(CLN,"C",DATE,1,I)) Q:'I  D

 ... I +$G(^SC(CLN,"C",DATE,1,I,0))=DFN S ^SC(CLN,"C",DATE,1,I,0)=XDRMRG("TO")

 ;

 Q

 ;

BSDMERG   ; IHS/ANMC/LJF - SCHED PATIENT MERGE ; 

 +1       ;;5.3;PIMS;;APR 26, 2002

 +2       ;

 +3       ;  ^SC(clinic,"S",appointment date/time,1,index,0)="patient^..." 

 +4       ;  ^SC(clinic,"C",chart request date,1,index,0)="patient"

 +5       ;  ^DPT(patient,"S",appointment date/time,0)="clinic^..."

 +6       ;

 +7       ;            dfn=patient, c=clinic, i=index

 +8       ;          v=appointment date/time FM internal

 +9       ;

 +10      ;

 +11       IF '$GET(XDRMRG("FR"))

               IF '$GET(XDRMRG("TO"))

                   QUIT 

 +12      ;

 +13      ; -- update patient pointer in 44 

 +14       NEW DFN,DATE,CLN,I,NODE

 +15       SET DFN=XDRMRG("FR")

           SET DATE=0

 +16      ;find from pat's appts

           FOR 

               SET DATE=$ORDER(^DPT(DFN,"S",DATE))

               IF 'DATE

                   QUIT 

               Begin DoDot:1

 +17      ;get clinic

                   SET CLN=+$GET(^DPT(DFN,"S",DATE,0))

                   IF 'CLN

                       QUIT 

 +18               SET I=0

 +19      ;find appt under clinic

                   FOR 

                       SET I=$ORDER(^SC(CLN,"S",DATE,1,I))

                       IF 'I

                           QUIT 

                       Begin DoDot:2

 +20                       SET NODE=$GET(^SC(CLN,"S",DATE,1,I,0))

                           IF 'NODE

                               QUIT 

 +21      ;quit if not this pat

                           IF +NODE'=DFN

                               QUIT 

 +22      ;reset to "to" pat

                           SET $PIECE(^SC(CLN,"S",DATE,1,I,0),U)=XDRMRG("TO")

                       End DoDot:2

               End DoDot:1

 +23      ;

 +24      ; -- check all chart request nodes for from patient

 +25       SET CLN=0

 +26       FOR 

               SET CLN=$ORDER(^SC(CLN))

               IF 'CLN

                   QUIT 

               Begin DoDot:1

 +27               SET DATE=0

                   FOR 

                       SET DATE=$ORDER(^SC(CLN,"C",DATE))

                       IF 'DATE

                           QUIT 

                       Begin DoDot:2

 +28                       SET I=0

                           FOR 

                               SET I=$ORDER(^SC(CLN,"C",DATE,1,I))

                               IF 'I

                                   QUIT 

                               Begin DoDot:3

 +29                               IF +$GET(^SC(CLN,"C",DATE,1,I,0))=DFN

                                       SET ^SC(CLN,"C",DATE,1,I,0)=XDRMRG("TO")

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +30      ;

 +31       QUIT 

 +32      ;