Routine: BMCP4

BMCP4 ; IHS/PHXAO/TMJ - FIX DB CHR<-->RCIS ;

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

 ;;FIX CHS PO VENDOR PTR VALUES IN RCIS VENDOR

 S U="^"

 S RIEN=0 ;RCIS REF IEN on RCIS Side

 S BMCNOREF=0 ;Counter -No Match of RCIS Ref IEN on CHS Side

 S BMCNOVEN=0 ;Counter -No Match of RCIS Vendor IEN  on CHS Side

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 BMCRPAT=$P(^BMCREF(RIEN,0),U,3) ;.03 RCIS Patient IEN

. ;

 . ;GET PO IEN AND VENDOR VALUES

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

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

 . . ;DO WE HAVE A CHS PO IEN ENTRY?

 . . I '$D(^ACHSF(DUZ(2),"D",RCIEN)) Q  ;Quit if no PO IEN on CHS Side

 . . ;GET THE CHS PATIENT IEN

 . . S BMCCHSP=$P(^ACHSF(DUZ(2),"D",RCIEN,0),U,22)

 . . ;DO WE HAVE A CHS LINK VALUE TO IEN OF REFERRAL

 . . I '$D(^ACHSF(DUZ(2),"D",RCIEN,2)) Q  ;Quit no Ref # on CHS side

 . . ;GET THE CHS LINK TO RCIS

 . . S CHSRIEN=$P(^ACHSF(DUZ(2),"D",RCIEN,2),U,7) ;RCIS REF IEN #

 . . Q:'$D(CHSRIEN)

 . . I CHSRIEN="" Q  ; NO BACK POINTER FROM CHS TO RCIS

 . . I CHSRIEN'=RIEN S BMCNOREF=BMCNOREF+1 Q

 . . ;I CHSRIEN'=RIEN W "PO REF # DOES NOT MATCH RCIS REF #:  "_RIEN_"    REF PO IEN: "_RCIEN,! S BMCNOREF=BMCNOREF+1 Q

 . . S BMCCHSV=$P(^ACHSF(DUZ(2),"D",RCIEN,0),U,8) ;CHS VENDOR IEN

 . . S BMCREFV=$P(^BMCREF(RIEN,41,RCIEN,0),U,9) ;RCIS VENDOR IEN

 . . Q:BMCCHSV=BMCREFV  ;Quit if Both Vendors Match-No Fix Needed

 . . S BMCNOVEN=BMCNOVEN+1

 . . D FIX ;Go Re-point the Vendor entries

 W !!,"(1)  No Match on Referral #: ",?30,BMCNOREF,!

 W !,"(2)  No Match on Vendors: ",?30,BMCNOVEN W ?45,"FIXED THESE BAD VENDOR POINTERS"

 W !!,"If Item #1 Count exists, then a previous Patched",!

 W "Routine was NOT ran.  Please contact Package Developer",!

 W "Toni Jarland, Phoenix Area IHS (602) 346-5268",!!

 DO END

 QUIT

FIX ;FIX THE VENDOR POINTERS IN RCIS

 ; OK -- HERE IS THE PLAN:

 ;   1)  RESET ALL BAD VENDOR POINTERS W/DIE CALL

 S DR=""

 S DIE="^BMCREF("_RIEN_",41," S DA(1)=RIEN,DA=RCIEN,DR=".09////"_BMCCHSV D ^DIE K DIE,DR,DA,DIC

 W !,"FIXED REFERRAL #:   "_RIEN

END ;End of Routine

 K RIEN,RCIEN,BMCCHSV,BMCREFV,BMCCHSV,BMCR,BMCRNUM,BMCRPAT,BMCNOREF,BMCNOVEN,D,D0,BMCCHSP,CHSRIEN

BMCP4     ; IHS/PHXAO/TMJ - FIX DB CHR<-->RCIS ;

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

 +2       ;

 +3       ;;FIX CHS PO VENDOR PTR VALUES IN RCIS VENDOR

 +4       ;

 +5        SET U="^"

 +6       ;RCIS REF IEN on RCIS Side

           SET RIEN=0

 +7       ;Counter -No Match of RCIS Ref IEN on CHS Side

           SET BMCNOREF=0

 +8       ;Counter -No Match of RCIS Vendor IEN  on CHS Side

           SET BMCNOVEN=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       ;.03 RCIS Patient IEN

                   SET BMCRPAT=$PIECE(^BMCREF(RIEN,0),U,3)

 +6       ;

 +7       ;GET PO IEN AND VENDOR VALUES

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

                   SET RCIEN=0

 +9                FOR

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

                       IF RCIEN'=+RCIEN

                           QUIT

                       Begin DoDot:2

 +10      ;DO WE HAVE A CHS PO IEN ENTRY?

 +11      ;Quit if no PO IEN on CHS Side

                           IF '$DATA(^ACHSF(DUZ(2),"D",RCIEN))

                               QUIT

 +12      ;GET THE CHS PATIENT IEN

 +13                       SET BMCCHSP=$PIECE(^ACHSF(DUZ(2),"D",RCIEN,0),U,22)

 +14      ;DO WE HAVE A CHS LINK VALUE TO IEN OF REFERRAL

 +15      ;Quit no Ref # on CHS side

                           IF '$DATA(^ACHSF(DUZ(2),"D",RCIEN,2))

                               QUIT

 +16      ;GET THE CHS LINK TO RCIS

 +17      ;RCIS REF IEN #

                           SET CHSRIEN=$PIECE(^ACHSF(DUZ(2),"D",RCIEN,2),U,7)

 +18                       IF '$DATA(CHSRIEN)

                               QUIT

 +19      ; NO BACK POINTER FROM CHS TO RCIS

                           IF CHSRIEN=""

                               QUIT

 +20                       IF CHSRIEN'=RIEN

                               SET BMCNOREF=BMCNOREF+1

                               QUIT

 +21      ;I CHSRIEN'=RIEN W "PO REF # DOES NOT MATCH RCIS REF #:  "_RIEN_"    REF PO IEN: "_RCIEN,! S BMCNOREF=BMCNOREF+1 Q

 +22      ;CHS VENDOR IEN

                           SET BMCCHSV=$PIECE(^ACHSF(DUZ(2),"D",RCIEN,0),U,8)

 +23      ;RCIS VENDOR IEN

                           SET BMCREFV=$PIECE(^BMCREF(RIEN,41,RCIEN,0),U,9)

 +24      ;Quit if Both Vendors Match-No Fix Needed

                           IF BMCCHSV=BMCREFV

                               QUIT

 +25                       SET BMCNOVEN=BMCNOVEN+1

 +26      ;Go Re-point the Vendor entries

                           DO FIX

                       End DoDot:2

               End DoDot:1

 +27       WRITE !!,"(1)  No Match on Referral #: ",?30,BMCNOREF,!

 +28       WRITE !,"(2)  No Match on Vendors: ",?30,BMCNOVEN

           WRITE ?45,"FIXED THESE BAD VENDOR POINTERS"

 +29       WRITE !!,"If Item #1 Count exists, then a previous Patched",!

 +30       WRITE "Routine was NOT ran.  Please contact Package Developer",!

 +31       WRITE "Toni Jarland, Phoenix Area IHS (602) 346-5268",!!

 +32       DO END

 +33       QUIT

 +34      ;

FIX       ;FIX THE VENDOR POINTERS IN RCIS

 +1       ;

 +2       ; OK -- HERE IS THE PLAN:

 +3       ;

 +4       ;   1)  RESET ALL BAD VENDOR POINTERS W/DIE CALL

 +5        SET DR=""

 +6        SET DIE="^BMCREF("_RIEN_",41,"

           SET DA(1)=RIEN

           SET DA=RCIEN

           SET DR=".09////"_BMCCHSV

           DO ^DIE

           KILL DIE,DR,DA,DIC

 +7        WRITE !,"FIXED REFERRAL #:   "_RIEN

 +8        QUIT

 +9       ;

END       ;End of Routine

 +1        KILL RIEN,RCIEN,BMCCHSV,BMCREFV,BMCCHSV,BMCR,BMCRNUM,BMCRPAT,BMCNOREF,BMCNOVEN,D,D0,BMCCHSP,CHSRIEN

BMCP4.m