- 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 ;
