APCDVM2.m

APCDVM2 ; IHS/CMI/LAB - VISIT MERGE ;

 ;;2.0;IHS PCC SUITE;**8**;MAY 14, 2009;Build 2

 ;

 ; Given the 'from' visit DFN in APCDVMF and the 'to' visit DFN in

 ; APCDVMT merge two visits.  Variables passed are left alone.  If

 ; an error is encountered APCDVMQF will exist upon exit.  VISITs must

 ; be for the same patient.

 ;

 K APCDVMQF

 S U="^"

 I '$D(APCDVMF)!('$D(APCDVMT)) S APCDVMQF=21 Q

 I 'APCDVMF!('APCDVMT)!(APCDVMF=APCDVMT) S APCDVMQF=22 Q

 I '$D(^AUPNVSIT(APCDVMF,0)) S APCDVMQF=23 Q

 I '$D(^AUPNVSIT(APCDVMT,0)) S APCDVMQF=24 Q

 I $P(^AUPNVSIT(APCDVMF,0),U,5)'=$P(^AUPNVSIT(APCDVMT,0),U,5) S APCDVMQF=25 Q

 S APCDVMUX=1  ;for trigger cross references

 S APCDVMFL=9000010 F APCDVML=0:0 S APCDVMFL=$O(^DIC(APCDVMFL)) Q:APCDVMFL>9000010.99!(APCDVMFL'=+APCDVMFL)  D PROCESS

 S AUPNVSIT=APCDVMT D MOD^AUPNVSIT

 I $T(A42^BTSEVENT)]"" S APCDHLER=$$A42^BTSEVENT(APCDVMF,APCDVMT) K APCDHLER  ;IHS/Daou/CJS - for HL7

 K APCDVMFL,APCDVMG,APCDVML,APCDVMN,APCDVMX,APCDVMUX

 Q

 ;

PROCESS ; PROCESS ONE V FILE

 S APCDVMG=^DIC(APCDVMFL,0,"GL")

 Q:'$D(@(APCDVMG_"""AD"","_APCDVMF_")"))

 W:'$D(ZTQUEUED) !,APCDVMFL

 S APCDVMN="" F APCDVML=0:0 S APCDVMN=$O(@(APCDVMG_"""AD"","_APCDVMF_",APCDVMN)")) Q:APCDVMN=""  D PROCESS2

 Q

PROCESS2 ; PROCESS ONE V FILE ENTRY

 W:'$D(ZTQUEUED) "."

 S DIK=APCDVMG,DA=APCDVMN,X=2 D DD^DIK,1^DIK1 K DIK,DA

 S $P(@(APCDVMG_APCDVMN_",0)"),U,3)=APCDVMT

 S DIK=APCDVMG,DA=APCDVMN,X=1 D DD^DIK,1^DIK1 K DIK,DA

 ;S APCDVMX=0 F APCDVML=0:0 S APCDVMX=$O(^DD(APCDVMFL,.03,1,APCDVMX)) Q:APCDVMX'=+APCDVMX  S DA=APCDVMN,X=APCDVMF X ^DD(APCDVMFL,.03,1,APCDVMX,2)

 ;S $P(@(APCDVMG_APCDVMN_",0)"),U,3)=APCDVMT

 ;S APCDVMX=0 F APCDVML=0:0 S APCDVMX=$O(^DD(APCDVMFL,.03,1,APCDVMX)) Q:APCDVMX'=+APCDVMX  S DA=APCDVMN,X=APCDVMT X ^DD(APCDVMFL,.03,1,APCDVMX,1)

 Q

APCDVM2   ; IHS/CMI/LAB - VISIT MERGE ;

 +1       ;;2.0;IHS PCC SUITE;**8**;MAY 14, 2009;Build 2

 +2       ;

 +3       ; Given the 'from' visit DFN in APCDVMF and the 'to' visit DFN in

 +4       ; APCDVMT merge two visits.  Variables passed are left alone.  If

 +5       ; an error is encountered APCDVMQF will exist upon exit.  VISITs must

 +6       ; be for the same patient.

 +7       ;

 +8        KILL APCDVMQF

 +9        SET U="^"

 +10       IF '$DATA(APCDVMF)!('$DATA(APCDVMT))

               SET APCDVMQF=21

               QUIT 

 +11       IF 'APCDVMF!('APCDVMT)!(APCDVMF=APCDVMT)

               SET APCDVMQF=22

               QUIT 

 +12       IF '$DATA(^AUPNVSIT(APCDVMF,0))

               SET APCDVMQF=23

               QUIT 

 +13       IF '$DATA(^AUPNVSIT(APCDVMT,0))

               SET APCDVMQF=24

               QUIT 

 +14       IF $PIECE(^AUPNVSIT(APCDVMF,0),U,5)'=$PIECE(^AUPNVSIT(APCDVMT,0),U,5)

               SET APCDVMQF=25

               QUIT 

 +15      ;for trigger cross references

           SET APCDVMUX=1

 +16       SET APCDVMFL=9000010

           FOR APCDVML=0:0

               SET APCDVMFL=$ORDER(^DIC(APCDVMFL))

               IF APCDVMFL>9000010.99!(APCDVMFL'=+APCDVMFL)

                   QUIT 

               DO PROCESS

 +17       SET AUPNVSIT=APCDVMT

           DO MOD^AUPNVSIT

 +18      ;IHS/Daou/CJS - for HL7

           IF $TEXT(A42^BTSEVENT)]""

               SET APCDHLER=$$A42^BTSEVENT(APCDVMF,APCDVMT)

               KILL APCDHLER

 +19       KILL APCDVMFL,APCDVMG,APCDVML,APCDVMN,APCDVMX,APCDVMUX

 +20       QUIT 

 +21      ;

PROCESS   ; PROCESS ONE V FILE

 +1        SET APCDVMG=^DIC(APCDVMFL,0,"GL")

 +2        IF '$DATA(@(APCDVMG_"""AD"","_APCDVMF_")"))

               QUIT 

 +3        IF '$DATA(ZTQUEUED)

               WRITE !,APCDVMFL

 +4        SET APCDVMN=""

           FOR APCDVML=0:0

               SET APCDVMN=$ORDER(@(APCDVMG_"""AD"","_APCDVMF_",APCDVMN)"))

               IF APCDVMN=""

                   QUIT 

               DO PROCESS2

 +5        QUIT 

PROCESS2  ; PROCESS ONE V FILE ENTRY

 +1        IF '$DATA(ZTQUEUED)

               WRITE "."

 +2        SET DIK=APCDVMG

           SET DA=APCDVMN

           SET X=2

           DO DD^DIK

           DO 1^DIK1

           KILL DIK,DA

 +3        SET $PIECE(@(APCDVMG_APCDVMN_",0)"),U,3)=APCDVMT

 +4        SET DIK=APCDVMG

           SET DA=APCDVMN

           SET X=1

           DO DD^DIK

           DO 1^DIK1

           KILL DIK,DA

 +5       ;S APCDVMX=0 F APCDVML=0:0 S APCDVMX=$O(^DD(APCDVMFL,.03,1,APCDVMX)) Q:APCDVMX'=+APCDVMX  S DA=APCDVMN,X=APCDVMF X ^DD(APCDVMFL,.03,1,APCDVMX,2)

 +6       ;S $P(@(APCDVMG_APCDVMN_",0)"),U,3)=APCDVMT

 +7       ;S APCDVMX=0 F APCDVML=0:0 S APCDVMX=$O(^DD(APCDVMFL,.03,1,APCDVMX)) Q:APCDVMX'=+APCDVMX  S DA=APCDVMN,X=APCDVMT X ^DD(APCDVMFL,.03,1,APCDVMX,1)

 +8        QUIT