BDPIQ.m

BDPIQ ; IHS/CMI/TMJ - Inquire to a Specific Patient Record ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

 ;

 ;

PATIENT2 ; ASK FOR PATIENT UNTIL USER SELECTS OR QUITS

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

 I Y<1 D ^XBFMK,EN^XBVK("BDP") Q

 S BDPDFN=+Y,BDPREC("PAT NAME")=$P(^DPT(+Y,0),U)

 S BDPQ=0

 I $$DOD^AUPNPAT(BDPDFN) D  I 'Y K BDPDFN,BDPREC("PAT NAME") Q

 . W !!,"This patient is deceased."

 . S DIR(0)="YO",DIR("A")="Are you sure you want this patient",DIR("B")="NO" K DA D ^DIR K DIR

 . W !

 . Q

 ;

 D PPEP^BDPLMDSP(BDPDFN,$G(BDPDETL))

 D EN^XBVK("BDP")

 D ^XBFMK

 Q

 ;

 ;

 ;

PROVDISP ;Display if Patient has existing Designated Providers

 W ?10,"**CURRENT DESIGNATED PROVIDERS - BY PROVIDER CATEGORY TYPE**",!

 W !,?15,"Assigned to Patient: "

 W ?35,$P($G(^DPT(BDPDFN,0)),U)

 W !,?10,"**CATEGORY TYPE**",?46,"**CURRENT PROVIDER ASSIGNED**",!

 I '$D(^BDPRECN("AA",BDPDFN)) W !,?20,"**--NO EXISTING DESIGNATED PROVIDERS--**",! S BDPQ=1 Q

 S BDPQ=0

 S BDPTYPE=""

 S BDPCOUNT=0

 F  S BDPTYPE=$O(^BDPRECN("AA",BDPDFN,BDPTYPE)) Q:BDPTYPE=""  S BDPCOUNT=BDPCOUNT+1 D NEXT

 D PAUSE^BDP

 Q

NEXT ;2ND $O

 S BDPRIEN=""

 F  S BDPRIEN=$O(^BDPRECN("AA",BDPDFN,BDPTYPE,BDPRIEN)) Q:BDPRIEN'=+BDPRIEN  D

 . Q:BDPTYPE=""

 . Q:BDPRIEN=""

 . S BDPPTNAM=$P(^DPT(BDPDFN,0),U,1) ;Patient Print Name

 . S BDPTYPNM=$P(^BDPTCAT(BDPTYPE,0),U,1) ;Type Print

 . S BDPCPRV=$P($G(^BDPRECN(BDPRIEN,0)),U,3) ;Current Provider IEN

 . I BDPCPRV="" S BDPCPRVP="<None Currently Assigned>" ;If no current Provider

 . E  S BDPCPRVP=$P(^VA(200,BDPCPRV,0),U,1) ;Provider Print Name

 . W !,?5,BDPCOUNT,?10,$E(BDPTYPNM,1,30),?50,$E(BDPCPRVP,1,35)

 . S I=I+1 ; increment outer loop counter to limit display to 10 Designated Providers

 . Q

 ;D PAUSE^BDP

 Q

 ;

 ;

BDPIQ     ; IHS/CMI/TMJ - Inquire to a Specific Patient Record ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

 +3       ;

 +4       ;

PATIENT2  ; ASK FOR PATIENT UNTIL USER SELECTS OR QUITS

 +1        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO DIC^BDPFMC

           KILL DIC

 +2        IF Y<1

               DO ^XBFMK

               DO EN^XBVK("BDP")

               QUIT 

 +3        SET BDPDFN=+Y

           SET BDPREC("PAT NAME")=$PIECE(^DPT(+Y,0),U)

 +4        SET BDPQ=0

 +5        IF $$DOD^AUPNPAT(BDPDFN)

               Begin DoDot:1

 +6                WRITE !!,"This patient is deceased."

 +7                SET DIR(0)="YO"

                   SET DIR("A")="Are you sure you want this patient"

                   SET DIR("B")="NO"

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +8                WRITE !

 +9                QUIT 

               End DoDot:1

               IF 'Y

                   KILL BDPDFN,BDPREC("PAT NAME")

                   QUIT 

 +10      ;

 +11       DO PPEP^BDPLMDSP(BDPDFN,$GET(BDPDETL))

 +12       DO EN^XBVK("BDP")

 +13       DO ^XBFMK

 +14       QUIT 

 +15      ;

 +16      ;

 +17      ;

PROVDISP  ;Display if Patient has existing Designated Providers

 +1        WRITE ?10,"**CURRENT DESIGNATED PROVIDERS - BY PROVIDER CATEGORY TYPE**",!

 +2        WRITE !,?15,"Assigned to Patient: "

 +3        WRITE ?35,$PIECE($GET(^DPT(BDPDFN,0)),U)

 +4        WRITE !,?10,"**CATEGORY TYPE**",?46,"**CURRENT PROVIDER ASSIGNED**",!

 +5        IF '$DATA(^BDPRECN("AA",BDPDFN))

               WRITE !,?20,"**--NO EXISTING DESIGNATED PROVIDERS--**",!

               SET BDPQ=1

               QUIT 

 +6        SET BDPQ=0

 +7        SET BDPTYPE=""

 +8        SET BDPCOUNT=0

 +9        FOR 

               SET BDPTYPE=$ORDER(^BDPRECN("AA",BDPDFN,BDPTYPE))

               IF BDPTYPE=""

                   QUIT 

               SET BDPCOUNT=BDPCOUNT+1

               DO NEXT

 +10       DO PAUSE^BDP

 +11       QUIT 

NEXT      ;2ND $O

 +1        SET BDPRIEN=""

 +2        FOR 

               SET BDPRIEN=$ORDER(^BDPRECN("AA",BDPDFN,BDPTYPE,BDPRIEN))

               IF BDPRIEN'=+BDPRIEN

                   QUIT 

               Begin DoDot:1

 +3                IF BDPTYPE=""

                       QUIT 

 +4                IF BDPRIEN=""

                       QUIT 

 +5       ;Patient Print Name

                   SET BDPPTNAM=$PIECE(^DPT(BDPDFN,0),U,1)

 +6       ;Type Print

                   SET BDPTYPNM=$PIECE(^BDPTCAT(BDPTYPE,0),U,1)

 +7       ;Current Provider IEN

                   SET BDPCPRV=$PIECE($GET(^BDPRECN(BDPRIEN,0)),U,3)

 +8       ;If no current Provider

                   IF BDPCPRV=""

                       SET BDPCPRVP="<None Currently Assigned>"

 +9       ;Provider Print Name

                  IF '$TEST

                       SET BDPCPRVP=$PIECE(^VA(200,BDPCPRV,0),U,1)

 +10               WRITE !,?5,BDPCOUNT,?10,$EXTRACT(BDPTYPNM,1,30),?50,$EXTRACT(BDPCPRVP,1,35)

 +11      ; increment outer loop counter to limit display to 10 Designated Providers

                   SET I=I+1

 +12               QUIT 

               End DoDot:1

 +13      ;D PAUSE^BDP

 +14       QUIT 

 +15      ;

 +16      ;