APCDRPOV.m

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