APCDRPOV ; IHS/CMI/LAB - DISPLAY VISIT ;
;;2.0;IHS PCC SUITE;**2,10,11,20**;MAY 14, 2009;Build 25
;
W !!,"This option is used to resequence the purpose of visit (diagnoses)"
W !,"on a visit. This allows you to determine which will be the first diagnosis"
W !,"listed which will become the primary diagnosis.",!!
W !,"It is recommended that you query the provider before resequencing POVs.",!!
D GETPAT
I APCDPAT="" W !!,"No PATIENT selected!" D EOJ Q
D GETVISIT
I APCDVSIT="" W !!,"No VISIT selected!" D EOJ Q
D DSPLY
D EOJ
Q
;
GETPAT ;EP GET- PATIENT
W !
S AUPNLK("INAC")=""
S APCDPAT=""
S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC
Q:Y<0
S APCDPAT=+Y
Q
;
GETVISIT ;EP - this entry point called by the BVP package (View patient record)
S APCDLOOK="",APCDVSIT=""
K APCDVLK
D ^APCDVLK
K APCDLOOK
Q
EN(APCDVSIT) ;EP -pass in visit
;
DSPLY ;
W !!,"Visit Information",!
S APCDVR0=^AUPNVSIT(APCDVSIT,0)
S DFN=$P(APCDVR0,U,5)
S Y=DFN D ^AUPNPAT
;W !,"Patient Name: ",$$VAL^XBDIQ1(2,DFN,.01),?50,"HRN: ",$$HRN^AUPNPAT(DFN,DUZ(2))
I '$G(APCDNVDS) S DA=APCDVSIT,DIC="^AUPNVSIT(" D EN^DIQ
D POVDISP
Q
ENDE(VIEN) ;EP CALLED FROM DATA ENTRY TEMPLATE
S APCDNVDS=1
D EN^XBNEW("EN^APCDRPOV(VIEN)","APCDNVDS;VIEN")
K APCDNVDS
Q
;
EOJ ; EP - EOJ HOUSE KEEPING - this ep called by the BVP package (View patient record)
K AUPNLK("INAC")
K %,%DT,%X,%Y,C,DIYS,X,Y
K APCDCLN,APCDCAT,APCDDATE,APCDLOC,APCDPAT,APCDVSIT,APCDLOOK,APCDTYPE
D KILL^AUPNPAT
Q
POVDISP ;
;display current V POV information
S APCDPSN=""
W !?3,"Current Sequence of POV's",!
S APCDX=0,APCDC=0 K APCDPOV F S APCDX=$O(^AUPNVPOV("AD",APCDVSIT,APCDX)) Q:APCDX'=+APCDX D
.S APCDC=APCDC+1,APCDPOV(APCDC)=APCDX
.W !?5,APCDC,")",?10,$$VAL^XBDIQ1(9000010.07,APCDX,.01),?20,$$VAL^XBDIQ1(9000010.07,APCDX,.04)
.I $$GET1^DIQ(9000010.07,APCDX,1103)]"" S APCDPSN=1
.Q
W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to resequence these POV's",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EOJ Q
I 'Y D EOJ Q
;store all V POV info
W !!,"Please jot down the order using the numbers above that you wish the POV's"
W !,"to be in. For example, if there are 3 POV's and you want #3 first, #1 second"
W !,"and #2 third, you would enter 3,1,2.",!
K APCDORD
K DIR S DIR(0)="L^1:"_APCDC,DIR("A")="In what order do you want the POV's resequenced" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G DSPLY
I X="" G DSPLY
S APCDJ=Y
I APCDC'=($L(APCDJ,",")-1) W !!,"You did not select all ",APCDC," POV's. Please sequence all of them.",! D PAUSE^APCDALV1 G POVDISP
K APCDNEWO
S APCDC=0
W !!,"The POV's will be resequenced to the following order:"
F X=1:1 S J=$P(APCDJ,",",X) Q:J="" W !?5,X,")" S APCDX=APCDPOV(J) W ?10,$$VAL^XBDIQ1(9000010.07,APCDX,.01),?20,$$VAL^XBDIQ1(9000010.07,APCDX,.04) S APCDC=APCDC+1,APCDNEWO(APCDC)=APCDX
W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to continue to resequence these POV's",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G DSPLY
I 'Y G DSPLY
;now take povs and re-enter them, then delete the old ones
S APCDC=0 F S APCDC=$O(APCDNEWO(APCDC)) Q:APCDC'=+APCDC S APCDX=APCDNEWO(APCDC) D
.;create new entry with FILE^DICN
.K DD,D0,DO
.S X=$P(^AUPNVPOV(APCDX,0),U),DIC="^AUPNVPOV(",DIADD=1,DLAYGO=9000010.07,DIC(0)="L"
.D FILE^DICN
.I Y=-1 W !!,"ERROR in creating new POV for ",APCDC Q
.S APCDNEW=+Y
.K DIC,DIADD,DLAYGO
.M ^AUPNVPOV(APCDNEW)=^AUPNVPOV(APCDX)
.S DA=APCDNEW,DIK="^AUPNVPOV(" D IX1^DIK K DA,DIK
.S DA=APCDNEW,DR=".12///"_$S(APCDC=1:"P",1:"S") S:APCDPSN DR=DR_";1103///"_$S(APCDC=1:$$PRIMPOV^BCQMAPI(),1:"") S DIE="^AUPNVPOV(" D ^DIE K DA,DR,DIE
.;now delete old one
.S DA=APCDX,DIK="^AUPNVPOV(" D ^DIK K DA,DIK
S AUPNVSIT=APCDVSIT D MOD^AUPNVSIT
G DSPLY
APCDRPOV ; IHS/CMI/LAB - DISPLAY VISIT ;
+1 ;;2.0;IHS PCC SUITE;**2,10,11,20**;MAY 14, 2009;Build 25
+2 ;
+3 WRITE !!,"This option is used to resequence the purpose of visit (diagnoses)"
+4 WRITE !,"on a visit. This allows you to determine which will be the first diagnosis"
+5 WRITE !,"listed which will become the primary diagnosis.",!!
+6 WRITE !,"It is recommended that you query the provider before resequencing POVs.",!!
+7 DO GETPAT
+8 IF APCDPAT=""
WRITE !!,"No PATIENT selected!"
DO EOJ
QUIT
+9 DO GETVISIT
+10 IF APCDVSIT=""
WRITE !!,"No VISIT selected!"
DO EOJ
QUIT
+11 DO DSPLY
+12 DO EOJ
+13 QUIT
+14 ;
GETPAT ;EP GET- PATIENT
+1 WRITE !
+2 SET AUPNLK("INAC")=""
+3 SET APCDPAT=""
+4 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+5 IF Y<0
QUIT
+6 SET APCDPAT=+Y
+7 QUIT
+8 ;
GETVISIT ;EP - this entry point called by the BVP package (View patient record)
+1 SET APCDLOOK=""
SET APCDVSIT=""
+2 KILL APCDVLK
+3 DO ^APCDVLK
+4 KILL APCDLOOK
+5 QUIT
EN(APCDVSIT) ;EP -pass in visit
+1 ;
DSPLY ;
+1 WRITE !!,"Visit Information",!
+2 SET APCDVR0=^AUPNVSIT(APCDVSIT,0)
+3 SET DFN=$PIECE(APCDVR0,U,5)
+4 SET Y=DFN
DO ^AUPNPAT
+5 ;W !,"Patient Name: ",$$VAL^XBDIQ1(2,DFN,.01),?50,"HRN: ",$$HRN^AUPNPAT(DFN,DUZ(2))
+6 IF '$GET(APCDNVDS)
SET DA=APCDVSIT
SET DIC="^AUPNVSIT("
DO EN^DIQ
+7 DO POVDISP
+8 QUIT
ENDE(VIEN) ;EP CALLED FROM DATA ENTRY TEMPLATE
+1 SET APCDNVDS=1
+2 DO EN^XBNEW("EN^APCDRPOV(VIEN)","APCDNVDS;VIEN")
+3 KILL APCDNVDS
+4 QUIT
+5 ;
EOJ ; EP - EOJ HOUSE KEEPING - this ep called by the BVP package (View patient record)
+1 KILL AUPNLK("INAC")
+2 KILL %,%DT,%X,%Y,C,DIYS,X,Y
+3 KILL APCDCLN,APCDCAT,APCDDATE,APCDLOC,APCDPAT,APCDVSIT,APCDLOOK,APCDTYPE
+4 DO KILL^AUPNPAT
+5 QUIT
POVDISP ;
+1 ;display current V POV information
+2 SET APCDPSN=""
+3 WRITE !?3,"Current Sequence of POV's",!
+4 SET APCDX=0
SET APCDC=0
KILL APCDPOV
FOR
SET APCDX=$ORDER(^AUPNVPOV("AD",APCDVSIT,APCDX))
IF APCDX'=+APCDX
QUIT
Begin DoDot:1
+5 SET APCDC=APCDC+1
SET APCDPOV(APCDC)=APCDX
+6 WRITE !?5,APCDC,")",?10,$$VAL^XBDIQ1(9000010.07,APCDX,.01),?20,$$VAL^XBDIQ1(9000010.07,APCDX,.04)
+7 IF $$GET1^DIQ(9000010.07,APCDX,1103)]""
SET APCDPSN=1
+8 QUIT
End DoDot:1
+9 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to resequence these POV's"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+10 IF $DATA(DIRUT)
DO EOJ
QUIT
+11 IF 'Y
DO EOJ
QUIT
+12 ;store all V POV info
+13 WRITE !!,"Please jot down the order using the numbers above that you wish the POV's"
+14 WRITE !,"to be in. For example, if there are 3 POV's and you want #3 first, #1 second"
+15 WRITE !,"and #2 third, you would enter 3,1,2.",!
+16 KILL APCDORD
+17 KILL DIR
SET DIR(0)="L^1:"_APCDC
SET DIR("A")="In what order do you want the POV's resequenced"
KILL DA
DO ^DIR
KILL DIR
+18 IF $DATA(DIRUT)
GOTO DSPLY
+19 IF X=""
GOTO DSPLY
+20 SET APCDJ=Y
+21 IF APCDC'=($LENGTH(APCDJ,",")-1)
WRITE !!,"You did not select all ",APCDC," POV's. Please sequence all of them.",!
DO PAUSE^APCDALV1
GOTO POVDISP
+22 KILL APCDNEWO
+23 SET APCDC=0
+24 WRITE !!,"The POV's will be resequenced to the following order:"
+25 FOR X=1:1
SET J=$PIECE(APCDJ,",",X)
IF J=""
QUIT
WRITE !?5,X,")"
SET APCDX=APCDPOV(J)
WRITE ?10,$$VAL^XBDIQ1(9000010.07,APCDX,.01),?20,$$VAL^XBDIQ1(9000010.07,APCDX,.04)
SET APCDC=APCDC+1
SET APCDNEWO(APCDC)=APCDX
+26 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to continue to resequence these POV's"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+27 IF $DATA(DIRUT)
GOTO DSPLY
+28 IF 'Y
GOTO DSPLY
+29 ;now take povs and re-enter them, then delete the old ones
+30 SET APCDC=0
FOR
SET APCDC=$ORDER(APCDNEWO(APCDC))
IF APCDC'=+APCDC
QUIT
SET APCDX=APCDNEWO(APCDC)
Begin DoDot:1
+31 ;create new entry with FILE^DICN
+32 KILL DD,D0,DO
+33 SET X=$PIECE(^AUPNVPOV(APCDX,0),U)
SET DIC="^AUPNVPOV("
SET DIADD=1
SET DLAYGO=9000010.07
SET DIC(0)="L"
+34 DO FILE^DICN
+35 IF Y=-1
WRITE !!,"ERROR in creating new POV for ",APCDC
QUIT
+36 SET APCDNEW=+Y
+37 KILL DIC,DIADD,DLAYGO
+38 MERGE ^AUPNVPOV(APCDNEW)=^AUPNVPOV(APCDX)
+39 SET DA=APCDNEW
SET DIK="^AUPNVPOV("
DO IX1^DIK
KILL DA,DIK
+40 SET DA=APCDNEW
SET DR=".12///"_$SELECT(APCDC=1:"P",1:"S")
IF APCDPSN
SET DR=DR_";1103///"_$SELECT(APCDC=1:$$PRIMPOV^BCQMAPI(),1:"")
SET DIE="^AUPNVPOV("
DO ^DIE
KILL DA,DR,DIE
+41 ;now delete old one
+42 SET DA=APCDX
SET DIK="^AUPNVPOV("
DO ^DIK
KILL DA,DIK
End DoDot:1
+43 SET AUPNVSIT=APCDVSIT
DO MOD^AUPNVSIT
+44 GOTO DSPLY
