- 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
