BDPLMDSP ; IHS/CMI/TMJ - UPDATE USING LISTMAN ;
;;2.0;IHS PCC SUITE;**10,21**;MAY 14, 2009;Build 34
;
;
START ;
W:$D(IOF) @IOF
W $$CTR("View Designated Provider List",80)
PROV ;
D ^XBFMK
S BDPPAT=""
W !! S DIC("A")="Enter Patient Name: ",DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DLAYGO,DIADD
I Y<0 W !,"No Patient Selected." Q
S BDPPAT=+Y
D EN
END ;
D EOJ
K BDPP,BDPQUIT,BDPW
Q
;
PPEP(BDPPAT,BDPDETL) ;PEP - entry point to view/update one provider's panel
I '$G(BDPPAT) Q
S BDPDETL=$G(BDPDETL)
;D EN^XBNEW("EN^BDPLMDSP","BDPPAT")
D EN
Q
EN ; -- main entry point for BDP UPDATE PATIENT CASE DATA
D EN^VALM("BDP DESG PROV DISP - 1 PAT")
D EN^XBVK("BDP")
Q
;
HDR ; -- header code
S VALMHDR(1)=$TR($J(" ",80)," ","-")
S VALMHDR(2)="Designated Provider List for: "_IORVON_$P(^DPT(BDPPAT,0),U)_IORVOFF_" HRN: "_$$HRN^AUPNPAT(BDPPAT,DUZ(2),2)
S VALMHDR(3)=$TR($J(" ",80)," ","-")
S VALMHDR(4)="Category",$E(VALMHDR(4),32)="Current Provider",$E(VALMHDR(4),57)="Updated",$E(VALMHDR(4),66)="Updated by"
Q
;
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
INIT ; -- init variables and list array
S VALMSG="?? for more actions + next screen - prev screen"
D GATHER ;gather up all records for display
S VALMCNT=BDPLINE
Q
;
GATHER ;
K BDPLIST
S BDPRCNT=0,BDPLINE=0
S BDPD=0 F S BDPD=$O(^BDPRECN("AA",BDPPAT,BDPD)) Q:BDPD'=+BDPD D
.S BDPX=$O(^BDPRECN("AA",BDPPAT,BDPD,0))
.;Q:$P($G(^BDPRECN(BDPX,0)),U,3)=""
.S BDPRCNT=BDPRCNT+1,BDPLINE=BDPLINE+1,Y=""
.S $E(Y,1)=$E($$VAL^XBDIQ1(90360.1,BDPX,.01),1,30)
.S $E(Y,32)=$E($$VAL^XBDIQ1(90360.1,BDPX,.03),1,25)
.;S BDPY=$P(^BDPRECN(BDPX,0),U,3)
.;S $E(Y,57)=$E($$VAL^XBDIQ1(200,BDPY,53.5),1,13)
.S $E(Y,57)=$$DATE($P(^BDPRECN(BDPX,0),U,5))
.S $E(Y,66)=$$VAL^XBDIQ1(90360.1,BDPX,.04)
.S BDPLIST(BDPLINE,0)=Y,BDPLIST("IDX",BDPLINE,BDPRCNT)=BDPX
.Q:'$G(BDPDETL)
.S BDPLINE=BDPLINE+1
.S BDPLIST(BDPLINE,0)=IORVON_" History Detail:"_IORVOFF,BDPLIST("IDX",BDPLINE,BDPRCNT)=BDPX
.S BDPLINE=BDPLINE+1
.S BDPLIST(BDPLINE,0)=" Previous Provider",$E(BDPLIST(BDPLINE,0),34)="Start Date",$E(BDPLIST(BDPLINE,0),45)="Stop Date",$E(BDPLIST(BDPLINE,0),57)="Updated",$E(BDPLIST(BDPLINE,0),66)="Updated by",BDPLIST("IDX",BDPLINE,BDPRCNT)=BDPX
.S BDPZ=0 F S BDPZ=$O(^BDPRECN(BDPX,1,BDPZ)) Q:BDPZ'=+BDPZ D
..S BDPN=^BDPRECN(BDPX,1,BDPZ,0)
..S BDPLINE=BDPLINE+1
..S BDPY="",$E(BDPY,2)=$E($P(^VA(200,$P(BDPN,U),0),U),1,22)
..S $E(BDPY,34)=$S($P(BDPN,U,4):$$DATE($P(BDPN,U,4)),1:"Unknown")
..S $E(BDPY,45)=$S($P(BDPN,U,5):$$DATE($P(BDPN,U,5)),1:"")
..I $P(BDPN,U,3) S $E(BDPY,57)=$$DATE($P(BDPN,U,3))
..I $P(BDPN,U,2) S $E(BDPY,66)=$E($P(^VA(200,$P(BDPN,U,2),0),U),1,20)
..S BDPLIST(BDPLINE,0)=BDPY,BDPLIST("IDX",BDPLINE,BDPRCNT)=BDPX
.S BDPLINE=BDPLINE+1,BDPLIST(BDPLINE,0)=" ",BDPLIST("IDX",BDPLINE,BDPRCNT)=BDPX
Q
;
EOJ ;
D EN^XBVK("BDP")
K DFN
K DDSFILE,DIPGM,Y
K X,Y,%,DR,DDS,DA,DIC
K BDPCASE,BDPX,BDPD,BDPRCNT,BDPLINE,BDPCDATE
D:$D(VALMWD) CLEAR^VALM1
K VALM,VALMHDR,VALMKEY,VALMMENU,VALMSGR,VALMUP,VALMWD,VALMLST,VALMVAR,VALMLFT,VALMBCK,VALMCC,VALMAR,VALMBG,VALMCAP,VALMCOFF,VALMCNT,VALMCON,VALMON,VALMEVL,VALMIOXY
D KILL^AUPNPAT
Q
;
EXPND ; -- expand code
Q
;
EXIT ;
Q
HELP ;EP -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
DATE(D) ;EP
I D="" Q ""
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
;
BDPLMDSP ; IHS/CMI/TMJ - UPDATE USING LISTMAN ;
+1 ;;2.0;IHS PCC SUITE;**10,21**;MAY 14, 2009;Build 34
+2 ;
+3 ;
START ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE $$CTR("View Designated Provider List",80)
PROV ;
+1 DO ^XBFMK
+2 SET BDPPAT=""
+3 WRITE !!
SET DIC("A")="Enter Patient Name: "
SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA,DR,DLAYGO,DIADD
+4 IF Y<0
WRITE !,"No Patient Selected."
QUIT
+5 SET BDPPAT=+Y
+6 DO EN
END ;
+1 DO EOJ
+2 KILL BDPP,BDPQUIT,BDPW
+3 QUIT
+4 ;
PPEP(BDPPAT,BDPDETL) ;PEP - entry point to view/update one provider's panel
+1 IF '$GET(BDPPAT)
QUIT
+2 SET BDPDETL=$GET(BDPDETL)
+3 ;D EN^XBNEW("EN^BDPLMDSP","BDPPAT")
+4 DO EN
+5 QUIT
EN ; -- main entry point for BDP UPDATE PATIENT CASE DATA
+1 DO EN^VALM("BDP DESG PROV DISP - 1 PAT")
+2 DO EN^XBVK("BDP")
+3 QUIT
+4 ;
HDR ; -- header code
+1 SET VALMHDR(1)=$TRANSLATE($JUSTIFY(" ",80)," ","-")
+2 SET VALMHDR(2)="Designated Provider List for: "_IORVON_$PIECE(^DPT(BDPPAT,0),U)_IORVOFF_" HRN: "_$$HRN^AUPNPAT(BDPPAT,DUZ(2),2)
+3 SET VALMHDR(3)=$TRANSLATE($JUSTIFY(" ",80)," ","-")
+4 SET VALMHDR(4)="Category"
SET $EXTRACT(VALMHDR(4),32)="Current Provider"
SET $EXTRACT(VALMHDR(4),57)="Updated"
SET $EXTRACT(VALMHDR(4),66)="Updated by"
+5 QUIT
+6 ;
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
INIT ; -- init variables and list array
+1 SET VALMSG="?? for more actions + next screen - prev screen"
+2 ;gather up all records for display
DO GATHER
+3 SET VALMCNT=BDPLINE
+4 QUIT
+5 ;
GATHER ;
+1 KILL BDPLIST
+2 SET BDPRCNT=0
SET BDPLINE=0
+3 SET BDPD=0
FOR
SET BDPD=$ORDER(^BDPRECN("AA",BDPPAT,BDPD))
IF BDPD'=+BDPD
QUIT
Begin DoDot:1
+4 SET BDPX=$ORDER(^BDPRECN("AA",BDPPAT,BDPD,0))
+5 ;Q:$P($G(^BDPRECN(BDPX,0)),U,3)=""
+6 SET BDPRCNT=BDPRCNT+1
SET BDPLINE=BDPLINE+1
SET Y=""
+7 SET $EXTRACT(Y,1)=$EXTRACT($$VAL^XBDIQ1(90360.1,BDPX,.01),1,30)
+8 SET $EXTRACT(Y,32)=$EXTRACT($$VAL^XBDIQ1(90360.1,BDPX,.03),1,25)
+9 ;S BDPY=$P(^BDPRECN(BDPX,0),U,3)
+10 ;S $E(Y,57)=$E($$VAL^XBDIQ1(200,BDPY,53.5),1,13)
+11 SET $EXTRACT(Y,57)=$$DATE($PIECE(^BDPRECN(BDPX,0),U,5))
+12 SET $EXTRACT(Y,66)=$$VAL^XBDIQ1(90360.1,BDPX,.04)
+13 SET BDPLIST(BDPLINE,0)=Y
SET BDPLIST("IDX",BDPLINE,BDPRCNT)=BDPX
+14 IF '$GET(BDPDETL)
QUIT
+15 SET BDPLINE=BDPLINE+1
+16 SET BDPLIST(BDPLINE,0)=IORVON_" History Detail:"_IORVOFF
SET BDPLIST("IDX",BDPLINE,BDPRCNT)=BDPX
+17 SET BDPLINE=BDPLINE+1
+18 SET BDPLIST(BDPLINE,0)=" Previous Provider"
SET $EXTRACT(BDPLIST(BDPLINE,0),34)="Start Date"
SET $EXTRACT(BDPLIST(BDPLINE,0),45)="Stop Date"
SET $EXTRACT(BDPLIST(BDPLINE,0),57)="Updated"
SET $EXTRACT(BDPLIST(BDPLINE,0),66)="Updated by"
SET BDPLIST("IDX",BDPLINE,BDPRCNT)=BDPX
+19 SET BDPZ=0
FOR
SET BDPZ=$ORDER(^BDPRECN(BDPX,1,BDPZ))
IF BDPZ'=+BDPZ
QUIT
Begin DoDot:2
+20 SET BDPN=^BDPRECN(BDPX,1,BDPZ,0)
+21 SET BDPLINE=BDPLINE+1
+22 SET BDPY=""
SET $EXTRACT(BDPY,2)=$EXTRACT($PIECE(^VA(200,$PIECE(BDPN,U),0),U),1,22)
+23 SET $EXTRACT(BDPY,34)=$SELECT($PIECE(BDPN,U,4):$$DATE($PIECE(BDPN,U,4)),1:"Unknown")
+24 SET $EXTRACT(BDPY,45)=$SELECT($PIECE(BDPN,U,5):$$DATE($PIECE(BDPN,U,5)),1:"")
+25 IF $PIECE(BDPN,U,3)
SET $EXTRACT(BDPY,57)=$$DATE($PIECE(BDPN,U,3))
+26 IF $PIECE(BDPN,U,2)
SET $EXTRACT(BDPY,66)=$EXTRACT($PIECE(^VA(200,$PIECE(BDPN,U,2),0),U),1,20)
+27 SET BDPLIST(BDPLINE,0)=BDPY
SET BDPLIST("IDX",BDPLINE,BDPRCNT)=BDPX
End DoDot:2
+28 SET BDPLINE=BDPLINE+1
SET BDPLIST(BDPLINE,0)=" "
SET BDPLIST("IDX",BDPLINE,BDPRCNT)=BDPX
End DoDot:1
+29 QUIT
+30 ;
EOJ ;
+1 DO EN^XBVK("BDP")
+2 KILL DFN
+3 KILL DDSFILE,DIPGM,Y
+4 KILL X,Y,%,DR,DDS,DA,DIC
+5 KILL BDPCASE,BDPX,BDPD,BDPRCNT,BDPLINE,BDPCDATE
+6 IF $DATA(VALMWD)
DO CLEAR^VALM1
+7 KILL VALM,VALMHDR,VALMKEY,VALMMENU,VALMSGR,VALMUP,VALMWD,VALMLST,VALMVAR,VALMLFT,VALMBCK,VALMCC,VALMAR,VALMBG,VALMCAP,VALMCOFF,VALMCNT,VALMCON,VALMON,VALMEVL,VALMIOXY
+8 DO KILL^AUPNPAT
+9 QUIT
+10 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
EXIT ;
+1 QUIT
HELP ;EP -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
DATE(D) ;EP
+1 IF D=""
QUIT ""
+2 QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)
+3 ;
