Routine: BLRPCCVM

BLRPCCVM ; IHS/ITSC/MKK - UPDATE LAB VA-IHS LINK LOG UPON VISIT MERGE  [ 04/15/2004  1:15 PM ]

 ;;5.2;BLR;**1019**;MAR 25, 2005

 ; This routine is called by the PCC Visit Merge Utility.

 ; The input variables are:  APCDVMF - Merge from visit ifn

 ;                           APCDVMT - Merge to visit ifn

 ; Finds the patient involved, scans for the merged visit among the

 ; the occurrences for this patient, and updates the visit.

MRG ; PEP >> PRIVATE ENTRY POINT between BLR and PCC

 NEW BLRN,DIE,DA,DR,X,Y

 D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER MRG^BLRPCCVM")

 Q:'$G(APCDVMF)  Q:'$G(APCDVMT)   ; Quit if variables non-existent

 S BLRN=0

 F  S BLRN=$O(^LRO(68.999999901,"AC",APCDVMF,BLRN))  Q:'BLRN  D

 . S DA=BLRN

 . S DIE="^LRO(68.999999901,",DR=".02////"_APCDVMT

 . D ^DIE

 D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EXIT MRG^BLRPCCVM")

EXIT Q

BLRPCCVM  ; IHS/ITSC/MKK - UPDATE LAB VA-IHS LINK LOG UPON VISIT MERGE  [ 04/15/2004  1:15 PM ]

 +1       ;;5.2;BLR;**1019**;MAR 25, 2005

 +2       ;

 +3       ; This routine is called by the PCC Visit Merge Utility.

 +4       ; The input variables are:  APCDVMF - Merge from visit ifn

 +5       ;                           APCDVMT - Merge to visit ifn

 +6       ;

 +7       ; Finds the patient involved, scans for the merged visit among the

 +8       ; the occurrences for this patient, and updates the visit.

 +9       ;

MRG       ; PEP >> PRIVATE ENTRY POINT between BLR and PCC

 +1        NEW BLRN,DIE,DA,DR,X,Y

 +2       ;

 +3        IF $GET(SNAPSHOT)

               DO ENTRYAUD^BLRUTIL("ENTER MRG^BLRPCCVM")

 +4       ;

 +5       ; Quit if variables non-existent

           IF '$GET(APCDVMF)

               QUIT

           IF '$GET(APCDVMT)

               QUIT

 +6       ;

 +7        SET BLRN=0

 +8        FOR

               SET BLRN=$ORDER(^LRO(68.999999901,"AC",APCDVMF,BLRN))

               IF 'BLRN

                   QUIT

               Begin DoDot:1

 +9                SET DA=BLRN

 +10               SET DIE="^LRO(68.999999901,"

                   SET DR=".02////"_APCDVMT

 +11               DO ^DIE

               End DoDot:1

 +12      ;

 +13       IF $GET(SNAPSHOT)

               DO ENTRYAUD^BLRUTIL("EXIT MRG^BLRPCCVM")

 +14      ;

EXIT       QUIT

BLRPCCVM.m