BDPPOST.m

BDPPOST ; IHS/CMI/TMJ - Post Init to Populate File ;  

 ;;1.0;DESIGNATED PROVIDER MGT SYSTEM;;SEP 10, 2004

 ;

 ;This routine $O's through the Patient File, the MHSS Patient

 ;File, and the BW Patient File to pick up existing Desg. Providers

 ;for the new Desg. Provider Mgt System

 ;

START ;Begin Post Init

 S BDPCONV=""

 S BDPCONV=$O(^BDPPARM("B",DUZ(2),""))

 ;Q:BDPCONV=""

 ;S BDPCONV1=$P($G(^BDPPARM(BDPCONV,0)),U,2) ;Conversion Field

 I BDPCONV'="" W !!,"Conversion already ran - Quit ",!! Q  ;Converison Check

 ;

 D PCP ;Designated Primary Care Provider

 D MH ;Mental Health Primary Care Provider

 D SS ;Social Services Primary Care Provider

 D CD ;Chemical Dependency Primary Care Provider

 D WH ;Womens Health Case Manager

 D EOJ

 Q

 ;

PCP ;Populate DPCP

 S BDPPROV=0 F  S BDPPROV=$O(^AUPNPAT("AK",BDPPROV)) Q:BDPPROV'=+BDPPROV  D

 .S BDPDFN=0 F  S BDPDFN=$O(^AUPNPAT("AK",BDPPROV,BDPDFN)) Q:BDPDFN'=+BDPDFN  D

 .. Q:'$P(^AUPNPAT(BDPDFN,0),U,14)  ;Quit if no Record

 .. Q:BDPPROV=""

 .. S BDPTYPE=1 ;DPCP Category

 .. D ADD ;Populate DPCP

 ;

 Q

 ;

MH ;Populate MH Provider

 S BDPPROV=0 F  S BDPPROV=$O(^AMHPATR("AMH",BDPPROV)) Q:BDPPROV'=+BDPPROV  D

 .S BDPDFN=0 F  S BDPDFN=$O(^AMHPATR("AMH",BDPPROV,BDPDFN)) Q:BDPDFN'=+BDPDFN  D

 .. Q:'$P(^AMHPATR(BDPDFN,0),U,2)  ;Quit if no Current Provider

 .. Q:BDPPROV=""

 .. S BDPTYPE=2 ;DPCP Category

 .. D ADD ;Populate MH Provider

 ;

 Q

 ;

 ;

SS ;Populate the Social Service Provider

 S BDPPROV=0 F  S BDPPROV=$O(^AMHPATR("ASS",BDPPROV)) Q:BDPPROV'=+BDPPROV  D

 .S BDPDFN=0 F  S BDPDFN=$O(^AMHPATR("ASS",BDPPROV,BDPDFN)) Q:BDPDFN'=+BDPDFN  D

 .. Q:'$P(^AMHPATR(BDPDFN,0),U,3)  ;Quit if no Current Provider

 .. Q:BDPPROV=""

 .. S BDPTYPE=3 ;SS Category

 .. D ADD ;Populate SS Provider

 ;

 Q

 ;

 ;

CD ;Populate the Chemical Dependency Provider

 S BDPPROV=0 F  S BDPPROV=$O(^AMHPATR("AOT",BDPPROV)) Q:BDPPROV'=+BDPPROV  D

 .S BDPDFN=0 F  S BDPDFN=$O(^AMHPATR("AOT",BDPPROV,BDPDFN)) Q:BDPDFN'=+BDPDFN  D

 .. Q:'$P(^AMHPATR(BDPDFN,0),U,4)  ;Quit if no Current Provider

 .. Q:BDPPROV=""

 .. S BDPTYPE=4 ;CD Category

 .. D ADD ;Populate CD Provider

 ;

 Q

 ;

WH ;Populate Case Mgr from Women's Health

 S BDPPROV=0 F  S BDPPROV=$O(^BWP("C",BDPPROV)) Q:BDPPROV'=+BDPPROV  D

 .S BDPDFN=0 F  S BDPDFN=$O(^BWP("C",BDPPROV,BDPDFN)) Q:BDPDFN'=+BDPDFN  D

 .. Q:'$P(^BWP(BDPDFN,0),U,10)  ;Quit if no Current Provider

 .. Q:BDPPROV=""

 .. S BDPTYPE=8 ;WH Category

 .. D ADD ;Populate WOMENS HEALTH Provider

 ;

 Q

 ;

 ;

ADD ;Populate the BDP DESG PROV PACKAGE

 Q:'$D(BDPDFN)

 Q:'$D(BDPTYPE)

 Q:'$D(BDPPROV)

 ;

 S X=$$CREATE^BDPPASS(BDPDFN,BDPTYPE,BDPPROV) Q

 ;

 ;

EOJ ;End of Job

 ;

 ;D ^XBFMK S DIE="^BDPPARM(",DA=DUZ(2),DR=".01///"_DUZ(2);".02///"_1 D ^DIE,XBFMK

 D ^XBFMK K DIADD,DINUM

 S X=DUZ(2),DIC="^BDPPARM(",DIC(0)="L",DLAYGO=90360.4

 S DIC("DR")=".02///"_1

 D FILE^DICN D ^XBFMK K DIADD,DINUM

 W !!,"Finished adding the MH SS CD WH Case Managers",!,"to the  Desg Specialty Provider Package ",!!

 K BDPPROV,BDPPAT,BDPTYPE,BDPDFN,BDPCONV,BDPCONV1

 Q

BDPPOST   ; IHS/CMI/TMJ - Post Init to Populate File ;  

 +1       ;;1.0;DESIGNATED PROVIDER MGT SYSTEM;;SEP 10, 2004

 +2       ;

 +3       ;This routine $O's through the Patient File, the MHSS Patient

 +4       ;File, and the BW Patient File to pick up existing Desg. Providers

 +5       ;for the new Desg. Provider Mgt System

 +6       ;

START     ;Begin Post Init

 +1        SET BDPCONV=""

 +2        SET BDPCONV=$ORDER(^BDPPARM("B",DUZ(2),""))

 +3       ;Q:BDPCONV=""

 +4       ;S BDPCONV1=$P($G(^BDPPARM(BDPCONV,0)),U,2) ;Conversion Field

 +5       ;Converison Check

           IF BDPCONV'=""

               WRITE !!,"Conversion already ran - Quit ",!!

               QUIT 

 +6       ;

 +7       ;Designated Primary Care Provider

           DO PCP

 +8       ;Mental Health Primary Care Provider

           DO MH

 +9       ;Social Services Primary Care Provider

           DO SS

 +10      ;Chemical Dependency Primary Care Provider

           DO CD

 +11      ;Womens Health Case Manager

           DO WH

 +12       DO EOJ

 +13       QUIT 

 +14      ;

PCP       ;Populate DPCP

 +1        SET BDPPROV=0

           FOR 

               SET BDPPROV=$ORDER(^AUPNPAT("AK",BDPPROV))

               IF BDPPROV'=+BDPPROV

                   QUIT 

               Begin DoDot:1

 +2                SET BDPDFN=0

                   FOR 

                       SET BDPDFN=$ORDER(^AUPNPAT("AK",BDPPROV,BDPDFN))

                       IF BDPDFN'=+BDPDFN

                           QUIT 

                       Begin DoDot:2

 +3       ;Quit if no Record

                           IF '$PIECE(^AUPNPAT(BDPDFN,0),U,14)

                               QUIT 

 +4                        IF BDPPROV=""

                               QUIT 

 +5       ;DPCP Category

                           SET BDPTYPE=1

 +6       ;Populate DPCP

                           DO ADD

                       End DoDot:2

               End DoDot:1

 +7       ;

 +8        QUIT 

 +9       ;

MH        ;Populate MH Provider

 +1        SET BDPPROV=0

           FOR 

               SET BDPPROV=$ORDER(^AMHPATR("AMH",BDPPROV))

               IF BDPPROV'=+BDPPROV

                   QUIT 

               Begin DoDot:1

 +2                SET BDPDFN=0

                   FOR 

                       SET BDPDFN=$ORDER(^AMHPATR("AMH",BDPPROV,BDPDFN))

                       IF BDPDFN'=+BDPDFN

                           QUIT 

                       Begin DoDot:2

 +3       ;Quit if no Current Provider

                           IF '$PIECE(^AMHPATR(BDPDFN,0),U,2)

                               QUIT 

 +4                        IF BDPPROV=""

                               QUIT 

 +5       ;DPCP Category

                           SET BDPTYPE=2

 +6       ;Populate MH Provider

                           DO ADD

                       End DoDot:2

               End DoDot:1

 +7       ;

 +8        QUIT 

 +9       ;

 +10      ;

SS        ;Populate the Social Service Provider

 +1        SET BDPPROV=0

           FOR 

               SET BDPPROV=$ORDER(^AMHPATR("ASS",BDPPROV))

               IF BDPPROV'=+BDPPROV

                   QUIT 

               Begin DoDot:1

 +2                SET BDPDFN=0

                   FOR 

                       SET BDPDFN=$ORDER(^AMHPATR("ASS",BDPPROV,BDPDFN))

                       IF BDPDFN'=+BDPDFN

                           QUIT 

                       Begin DoDot:2

 +3       ;Quit if no Current Provider

                           IF '$PIECE(^AMHPATR(BDPDFN,0),U,3)

                               QUIT 

 +4                        IF BDPPROV=""

                               QUIT 

 +5       ;SS Category

                           SET BDPTYPE=3

 +6       ;Populate SS Provider

                           DO ADD

                       End DoDot:2

               End DoDot:1

 +7       ;

 +8        QUIT 

 +9       ;

 +10      ;

CD        ;Populate the Chemical Dependency Provider

 +1        SET BDPPROV=0

           FOR 

               SET BDPPROV=$ORDER(^AMHPATR("AOT",BDPPROV))

               IF BDPPROV'=+BDPPROV

                   QUIT 

               Begin DoDot:1

 +2                SET BDPDFN=0

                   FOR 

                       SET BDPDFN=$ORDER(^AMHPATR("AOT",BDPPROV,BDPDFN))

                       IF BDPDFN'=+BDPDFN

                           QUIT 

                       Begin DoDot:2

 +3       ;Quit if no Current Provider

                           IF '$PIECE(^AMHPATR(BDPDFN,0),U,4)

                               QUIT 

 +4                        IF BDPPROV=""

                               QUIT 

 +5       ;CD Category

                           SET BDPTYPE=4

 +6       ;Populate CD Provider

                           DO ADD

                       End DoDot:2

               End DoDot:1

 +7       ;

 +8        QUIT 

 +9       ;

WH        ;Populate Case Mgr from Women's Health

 +1        SET BDPPROV=0

           FOR 

               SET BDPPROV=$ORDER(^BWP("C",BDPPROV))

               IF BDPPROV'=+BDPPROV

                   QUIT 

               Begin DoDot:1

 +2                SET BDPDFN=0

                   FOR 

                       SET BDPDFN=$ORDER(^BWP("C",BDPPROV,BDPDFN))

                       IF BDPDFN'=+BDPDFN

                           QUIT 

                       Begin DoDot:2

 +3       ;Quit if no Current Provider

                           IF '$PIECE(^BWP(BDPDFN,0),U,10)

                               QUIT 

 +4                        IF BDPPROV=""

                               QUIT 

 +5       ;WH Category

                           SET BDPTYPE=8

 +6       ;Populate WOMENS HEALTH Provider

                           DO ADD

                       End DoDot:2

               End DoDot:1

 +7       ;

 +8        QUIT 

 +9       ;

 +10      ;

ADD       ;Populate the BDP DESG PROV PACKAGE

 +1        IF '$DATA(BDPDFN)

               QUIT 

 +2        IF '$DATA(BDPTYPE)

               QUIT 

 +3        IF '$DATA(BDPPROV)

               QUIT 

 +4       ;

 +5        SET X=$$CREATE^BDPPASS(BDPDFN,BDPTYPE,BDPPROV)

           QUIT 

 +6       ;

 +7       ;

EOJ       ;End of Job

 +1       ;

 +2       ;D ^XBFMK S DIE="^BDPPARM(",DA=DUZ(2),DR=".01///"_DUZ(2);".02///"_1 D ^DIE,XBFMK

 +3        DO ^XBFMK

           KILL DIADD,DINUM

 +4        SET X=DUZ(2)

           SET DIC="^BDPPARM("

           SET DIC(0)="L"

           SET DLAYGO=90360.4

 +5        SET DIC("DR")=".02///"_1

 +6        DO FILE^DICN

           DO ^XBFMK

           KILL DIADD,DINUM

 +7        WRITE !!,"Finished adding the MH SS CD WH Case Managers",!,"to the  Desg Specialty Provider Package ",!!

 +8        KILL BDPPROV,BDPPAT,BDPTYPE,BDPDFN,BDPCONV,BDPCONV1

 +9        QUIT