BMCSPDSP.m

BMCSPDSP ; IHS/PHXAO/TMJ - BMC - DISPLAY SECONDARY PROVIDER RECORDS FOR A SPECIFIC PT ;  

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

 ;

 ; This routine displays a RCIS REFERRAL record with subordinate

 ; file entries.

 ;4.0 FCJ Changed to pull SR info fr RCIS REF file AND prt sec ref #

 ;

START ;

 ;

GETPAT ;EP GET-  PATIENT

 W !

 S APCDPAT=""

 S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC

 Q:Y<0

 S BMCPAT=+Y

 ;

ASK ;Ask for All Referrals or a Specific Referral

 S DIR(0)="SO^A:Display ALL Referrals;S:Display a Specific Referral",DIR("A")="Report should include: "

 S DIR("?")="If you wish to include only a Specific Referral - enter 'S'.  To include ALL Referrals enter an 'A'.  All Secondary Referrals will be Display for each Referral printed." D ^DIR K DIR

 I $D(DIRUT) S BMCQUIT="" G EOJ

 ;I Y<0 G EOJ

 I Y="A" S BMCALL=""

 I Y="S" S BMCSPEC=""

 I $D(BMCSPEC) D  G EOJ

 . D GETREF

 . I $D(BMCQUIT) Q

 . D DSPSPEC

 I $D(BMCALL) D DSPALL G EOJ

 ;

 Q

 ;

 ;

GETREF ; GET REFERRAL

 S BMCQ=1

 W !

 S DIC="^BMCREF(",DIC(0)="AEMQ",DIC("A")="Select RCIS REFERRAL by Patient or by Referral Date or #: "

 S DIC("S")="I $$FILTER^BMCFLTR(0,0,1)"

 D ^DIC K DIC

 I $D(DIRUT) S BMCQUIT="" G EOJ

 I Y<0 G EOJ

 S BMCRIEN=+Y

 S BMCQ=0

 Q

 ;

 ;

DSPALL ; DISPLAY ALL SECONDARY PROVIDERS FOR ALL REFERRALS FOR THIS PT

 ; 4.0 IHS/ITSC/FCJ;REWROTE SECTION

 S BMCRIEN=0,BMCT=0

 F  S BMCRIEN=$O(^BMCREF("D",BMCPAT,BMCRIEN)) Q:BMCRIEN'?1N.N  D

 .S BMCRNUMB=$P(^BMCREF(BMCRIEN,0),U,2)

 .Q:'$D(^BMCREF("S",BMCRNUMB))!$D(BMCTMP(BMCRNUMB))

 .S BMCY=0,BMCT=1,BMCTMP(BMCRNUMB)=""

 .F  S BMCY=$O(^BMCREF("S",BMCRNUMB,BMCY)) Q:BMCY'?1A.1N  D  Q:$D(DIRUT)

 ..S BMCSRIEN=0

 ..S BMCSRIEN=$O(^BMCREF("S",BMCRNUMB,BMCY,BMCSRIEN))

 .. S DIC="^BMCREF(",DA=BMCSRIEN,DIQ(0)="C"

 ..W !,"SECONDARY REFERRAL #:",$P(^BMCREF(DA,0),U,2),$P(^BMCREF(DA,1),U)

 .. D DIQ^BMCFMC

 .. I $E(IOST,1,2)'="P-" D PAUSE^BMC

 I BMCT=0 W !!,?10,"**NO SECONDARY REFERRALS ATTACHED TO THIS PATIENT'S REFERRALS**",!! D PAUSE^BMC Q

 Q

 ;

DSPSPEC ; DISPLAY SPECIFIC REFERRAL FOR A SPECIFIC PATIENT

 ; 4.0 IHS/ITSC/FCJ;REWROTE SECTION

 Q:'$D(BMCRIEN)

 S DIC="^BMCREF(",DA=BMCRIEN,DIQ(0)="C"

 W !,"SECONDARY REFERRAL #:",$P(^BMCREF(DA,0),U,2),$P(^BMCREF(DA,1),U)

 D DIQ^BMCFMC

 I $E(IOST,1,2)'="P-" D PAUSE^BMC

 Q

 ;

 ;

EOJ ;

 D:IO'=IO(0) ^%ZISC

 K BMCALL,BMCSPEC,BMCPAT,BMCQUIT,BMCRIEN,BMCSRIEN,BMCT,BMCTMP

 D ^BMCKILL

 Q

BMCSPDSP  ; IHS/PHXAO/TMJ - BMC - DISPLAY SECONDARY PROVIDER RECORDS FOR A SPECIFIC PT ;  

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

 +2       ;

 +3       ; This routine displays a RCIS REFERRAL record with subordinate

 +4       ; file entries.

 +5       ;4.0 FCJ Changed to pull SR info fr RCIS REF file AND prt sec ref #

 +6       ;

START     ;

 +1       ;

GETPAT    ;EP GET-  PATIENT

 +1        WRITE !

 +2        SET APCDPAT=""

 +3        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +4        IF Y<0

               QUIT 

 +5        SET BMCPAT=+Y

 +6       ;

ASK       ;Ask for All Referrals or a Specific Referral

 +1        SET DIR(0)="SO^A:Display ALL Referrals;S:Display a Specific Referral"

           SET DIR("A")="Report should include: "

 +2        SET DIR("?")="If you wish to include only a Specific Referral - enter 'S'.  To include ALL Referrals enter an 'A'.  All Secondary Referrals will be Display for each Referral printed."

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               SET BMCQUIT=""

               GOTO EOJ

 +4       ;I Y<0 G EOJ

 +5        IF Y="A"

               SET BMCALL=""

 +6        IF Y="S"

               SET BMCSPEC=""

 +7        IF $DATA(BMCSPEC)

               Begin DoDot:1

 +8                DO GETREF

 +9                IF $DATA(BMCQUIT)

                       QUIT 

 +10               DO DSPSPEC

               End DoDot:1

               GOTO EOJ

 +11       IF $DATA(BMCALL)

               DO DSPALL

               GOTO EOJ

 +12      ;

 +13       QUIT 

 +14      ;

 +15      ;

GETREF    ; GET REFERRAL

 +1        SET BMCQ=1

 +2        WRITE !

 +3        SET DIC="^BMCREF("

           SET DIC(0)="AEMQ"

           SET DIC("A")="Select RCIS REFERRAL by Patient or by Referral Date or #: "

 +4        SET DIC("S")="I $$FILTER^BMCFLTR(0,0,1)"

 +5        DO ^DIC

           KILL DIC

 +6        IF $DATA(DIRUT)

               SET BMCQUIT=""

               GOTO EOJ

 +7        IF Y<0

               GOTO EOJ

 +8        SET BMCRIEN=+Y

 +9        SET BMCQ=0

 +10       QUIT 

 +11      ;

 +12      ;

DSPALL    ; DISPLAY ALL SECONDARY PROVIDERS FOR ALL REFERRALS FOR THIS PT

 +1       ; 4.0 IHS/ITSC/FCJ;REWROTE SECTION

 +2        SET BMCRIEN=0

           SET BMCT=0

 +3        FOR 

               SET BMCRIEN=$ORDER(^BMCREF("D",BMCPAT,BMCRIEN))

               IF BMCRIEN'?1N.N

                   QUIT 

               Begin DoDot:1

 +4                SET BMCRNUMB=$PIECE(^BMCREF(BMCRIEN,0),U,2)

 +5                IF '$DATA(^BMCREF("S",BMCRNUMB))!$DATA(BMCTMP(BMCRNUMB))

                       QUIT 

 +6                SET BMCY=0

                   SET BMCT=1

                   SET BMCTMP(BMCRNUMB)=""

 +7                FOR 

                       SET BMCY=$ORDER(^BMCREF("S",BMCRNUMB,BMCY))

                       IF BMCY'?1A.1N

                           QUIT 

                       Begin DoDot:2

 +8                        SET BMCSRIEN=0

 +9                        SET BMCSRIEN=$ORDER(^BMCREF("S",BMCRNUMB,BMCY,BMCSRIEN))

 +10                       SET DIC="^BMCREF("

                           SET DA=BMCSRIEN

                           SET DIQ(0)="C"

 +11                       WRITE !,"SECONDARY REFERRAL #:",$PIECE(^BMCREF(DA,0),U,2),$PIECE(^BMCREF(DA,1),U)

 +12                       DO DIQ^BMCFMC

 +13                       IF $EXTRACT(IOST,1,2)'="P-"

                               DO PAUSE^BMC

                       End DoDot:2

                       IF $DATA(DIRUT)

                           QUIT 

               End DoDot:1

 +14       IF BMCT=0

               WRITE !!,?10,"**NO SECONDARY REFERRALS ATTACHED TO THIS PATIENT'S REFERRALS**",!!

               DO PAUSE^BMC

               QUIT 

 +15       QUIT 

 +16      ;

DSPSPEC   ; DISPLAY SPECIFIC REFERRAL FOR A SPECIFIC PATIENT

 +1       ; 4.0 IHS/ITSC/FCJ;REWROTE SECTION

 +2        IF '$DATA(BMCRIEN)

               QUIT 

 +3        SET DIC="^BMCREF("

           SET DA=BMCRIEN

           SET DIQ(0)="C"

 +4        WRITE !,"SECONDARY REFERRAL #:",$PIECE(^BMCREF(DA,0),U,2),$PIECE(^BMCREF(DA,1),U)

 +5        DO DIQ^BMCFMC

 +6        IF $EXTRACT(IOST,1,2)'="P-"

               DO PAUSE^BMC

 +7        QUIT 

 +8       ;

 +9       ;

EOJ       ;

 +1        IF IO'=IO(0)

               DO ^%ZISC

 +2        KILL BMCALL,BMCSPEC,BMCPAT,BMCQUIT,BMCRIEN,BMCSRIEN,BMCT,BMCTMP

 +3        DO ^BMCKILL

 +4        QUIT