AQAOVST.m

AQAOVST ; IHS/ORDC/LJF - UPDATE OCC UPON VISIT MERGE ;

 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995

 ;

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

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

 ;                          APCDVMT - Merge to visit ifn

 ;

 ;This routine finds the patient involved, scans for this merged visit

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

 ;

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

 N DIE,DA,DR,AQAOPT,AQAOV,AQAOIFN,X,Y

 Q:'$D(APCDVMF)  Q:'$D(APCDVMT)

 S AQAOPT=$P($G(^AUPNVSIT(APCDVMT,0)),U,5) Q:AQAOPT=""

 S AQAOV=0

 F  S AQAOV=$O(^AQAOC("AE",AQAOPT,AQAOV)) Q:AQAOV=""  I AQAOV=APCDVMF D

 .S DIE=9002167,DR=".03////"_APCDVMT,AQAOIFN=0

 .F  S AQAOIFN=$O(^AQAOC("AE",AQAOPT,AQAOV,AQAOIFN)) Q:AQAOIFN=""  D

 ..S DA=AQAOIFN D ^DIE

 ;

EXIT Q

AQAOVST   ; IHS/ORDC/LJF - UPDATE OCC UPON VISIT MERGE ;

 +1       ;;1.01;QAI MANAGEMENT;;OCT 05, 1995

 +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       ;This routine finds the patient involved, scans for this merged visit

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

 +9       ;

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

 +1        NEW DIE,DA,DR,AQAOPT,AQAOV,AQAOIFN,X,Y

 +2        IF '$DATA(APCDVMF)

               QUIT 

           IF '$DATA(APCDVMT)

               QUIT 

 +3        SET AQAOPT=$PIECE($GET(^AUPNVSIT(APCDVMT,0)),U,5)

           IF AQAOPT=""

               QUIT 

 +4        SET AQAOV=0

 +5        FOR 

               SET AQAOV=$ORDER(^AQAOC("AE",AQAOPT,AQAOV))

               IF AQAOV=""

                   QUIT 

               IF AQAOV=APCDVMF

                   Begin DoDot:1

 +6                    SET DIE=9002167

                       SET DR=".03////"_APCDVMT

                       SET AQAOIFN=0

 +7                    FOR 

                           SET AQAOIFN=$ORDER(^AQAOC("AE",AQAOPT,AQAOV,AQAOIFN))

                           IF AQAOIFN=""

                               QUIT 

                           Begin DoDot:2

 +8                            SET DA=AQAOIFN

                               DO ^DIE

                           End DoDot:2

                   End DoDot:1

 +9       ;

EXIT       QUIT