Routine: BMCPXREF

BMCPXREF ; IHS/PHXAO/TMJ - FIX X-REF FOR PO FISCAL YEAR ;

 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 S U="^"

 S RIEN=0 ;RCIS REF IEN on RCIS Side

 S BMCCT=0 ;Counter -on Re-Index Referrals

START ;START $O OF REFERRALS

 F  S RIEN=$O(^BMCREF(RIEN)) Q:RIEN'=+RIEN  D

 . ;GET THE RCIS PATIENT DEMOGRAPHICS

 . S BMCR=$P(^BMCREF(RIEN,0),U,1)    ;.01 RCIS Date Referral Initiated

 . S BMCRNUM=$P(^BMCREF(RIEN,0),U,2) ;.02 RCIS Referral Number

. ;

 . S RCIEN=0 ;PO IEN on RCIS Side (CHS AUTH Multiple)

 . F  S RCIEN=$O(^BMCREF(RIEN,41,RCIEN)) Q:RCIEN'=+RCIEN  D

 . . D FIX ;Re-Index the PO Authorization Fiscal Year

 W !!,"(1)  Re-Indexed Total Number of Referrals: ",?30,BMCCT,!

 DO END

 QUIT

FIX ;RE-INDEX PO AUTH # FISCAL YEAR TRIGGER

 S BMCFY=$P($G(^BMCREF(RIEN,41,RCIEN,11)),U,1)

 Q:BMCFY'=""  ;Quit if FY Value already exists in PO FY

 S DA=RCIEN

 Q:'DA

 S DA(1)=RIEN

 S DIK="^BMCREF("_DA(1)_",""41"","

 S DIK(1)=".08"

 D EN1^DIK

 S BMCCT=BMCCT+1

 W !,"RE-INDEXED REFERRAL #:   "_RIEN,?50,"PO IEN: "_RCIEN

END ;End of Routine

 W !,"Finished Re-Indexing the PO Authorization Fiscal Year",!

 K RIEN,RCIEN,BMCCT,D,D0,BMCFY

BMCPXREF  ; IHS/PHXAO/TMJ - FIX X-REF FOR PO FISCAL YEAR ;

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 +2       ;

 +3       ;

 +4        SET U="^"

 +5       ;RCIS REF IEN on RCIS Side

           SET RIEN=0

 +6       ;Counter -on Re-Index Referrals

           SET BMCCT=0

START     ;START $O OF REFERRALS

 +1        FOR

               SET RIEN=$ORDER(^BMCREF(RIEN))

               IF RIEN'=+RIEN

                   QUIT

               Begin DoDot:1

 +2       ;GET THE RCIS PATIENT DEMOGRAPHICS

 +3       ;.01 RCIS Date Referral Initiated

                   SET BMCR=$PIECE(^BMCREF(RIEN,0),U,1)

 +4       ;.02 RCIS Referral Number

                   SET BMCRNUM=$PIECE(^BMCREF(RIEN,0),U,2)

 +5       ;

 +6       ;PO IEN on RCIS Side (CHS AUTH Multiple)

                   SET RCIEN=0

 +7                FOR

                       SET RCIEN=$ORDER(^BMCREF(RIEN,41,RCIEN))

                       IF RCIEN'=+RCIEN

                           QUIT

                       Begin DoDot:2

 +8       ;Re-Index the PO Authorization Fiscal Year

                           DO FIX

                       End DoDot:2

               End DoDot:1

 +9       ;

 +10      ;

 +11       WRITE !!,"(1)  Re-Indexed Total Number of Referrals: ",?30,BMCCT,!

 +12       DO END

 +13       QUIT

 +14      ;

FIX       ;RE-INDEX PO AUTH # FISCAL YEAR TRIGGER

 +1        SET BMCFY=$PIECE($GET(^BMCREF(RIEN,41,RCIEN,11)),U,1)

 +2       ;Quit if FY Value already exists in PO FY

           IF BMCFY'=""

               QUIT

 +3        SET DA=RCIEN

 +4        IF 'DA

               QUIT

 +5       ;

 +6        SET DA(1)=RIEN

 +7        SET DIK="^BMCREF("_DA(1)_",""41"","

 +8        SET DIK(1)=".08"

 +9        DO EN1^DIK

 +10       SET BMCCT=BMCCT+1

 +11       WRITE !,"RE-INDEXED REFERRAL #:   "_RIEN,?50,"PO IEN: "_RCIEN

 +12      ;

 +13       QUIT

 +14      ;

END       ;End of Routine

 +1        WRITE !,"Finished Re-Indexing the PO Authorization Fiscal Year",!

 +2        KILL RIEN,RCIEN,BMCCT,D,D0,BMCFY

BMCPXREF.m