Routine: APCDSWU

APCDSWU ; IHS/CMI/LAB - SWITCH TO V FILE ;

 ;;2.0;IHS PCC SUITE;**4,5**;MAY 14, 2009

 ; APCDSWD=DICTIONARY NUMBER

 ; APCDSWCR=LINKING CROSS REFERENCE

 ; APCDSWV=VISIT DFN

EP ;

 D EN^XBNEW("EN^APCDSWU","APCDVSIT;APCDMNE")

EN ;

 NEW APCDSWDA,APCDSWMV,APCDVM01,APCDVM04,APCDSWCT,APCDSWA,APCDSWAN,APCDSWX,APCDSWT,APCDSWI,APCDSWVE

 NEW X,Y,DIR

EN0 ;

 W !!,"Please Note:  You are NOT permitted to modify or delete these"

 W !,APCDMNE("NAME")," entries.  You can only mark them as entered in error."

 S APCDSWCT=0

 K APCDSWA

 S APCDSWMV=$O(^AUTTCRA("C",APCDMNE("NAME"),0))

 S APCDSWVE=$P(^AUTTCRA(APCDSWMV,0),U,1)

 S APCDSWDA=0 F  S APCDSWDA=$O(^AUPNVRUP("AD",APCDVSIT,APCDSWDA)) Q:APCDSWDA'=+APCDSWDA  D

 .Q:$P($G(^AUPNVRUP(APCDSWDA,2)),U,1)  ;don't display those entered in error

 .S APCDVM01=$$VALI^XBDIQ1(9000010.54,APCDSWDA,.01)

 .;S APCDVM04=$$VAL^XBDIQ1(9000010.04,APCDSWDA,.04)

 .I APCDSWMV]"",APCDVM01'=APCDSWMV Q

 .S APCDSWCT=APCDSWCT+1

 .S APCDSWA(APCDSWCT)=APCDSWDA

 I '$D(APCDSWA) W !!,"There are no '",APCDSWVE,"' clinical review actions documented on this",!,"visit.  The ",APCDMNE("NAME")," mnemonic has not been used on this visit so there is nothing",!,"to modify." Q

 D SELECTM

SELECTM ;

 ;select the measurement to edit or delete

 W !,"Please choose which clinical review action you would like to"

 W !,"mark 'Entered in Error', if you do not wish to mark any in error, "

 W !,"simply press 'enter' to bypass."

 S APCDSWX=0,APCDSWT=0 F  S APCDSWX=$O(APCDSWA(APCDSWX)) Q:APCDSWX'=+APCDSWX  D

 .S APCDSWDA=APCDSWA(APCDSWX),APCDSWT=APCDSWX

 .S APCDVM01=$$VAL^XBDIQ1(9000010.54,APCDSWDA,.01)

 .S APCDVM04=$$VAL^XBDIQ1(9000010.54,APCDSWDA,1204)

 .W !?2,APCDSWX,")",?7,APCDVM01,?40,"Provider: ",APCDVM04

 K DIR

 S DIR(0)="NO^1:"_APCDSWT_":0",DIR("A")="Which "_APCDSWVE,DIR("?")="Enter a number from the list above (1-"_APCDSWT_" or 'N' to exit." KILL DA D ^DIR KILL DIR

 I $D(DIRUT) Q

 I X="" Q

 I Y="" Q

 I '$D(APCDSWA(X)) W !,"Invalid response.  Please enter a number from 1 to ",APCDSWT," or N." G SELECTM

 S APCDSWI=Y

 S APCDSWDA=APCDSWA(X)

 K DIR

 W !,"You have selected: ",$$VAL^XBDIQ1(9000010.54,APCDSWDA,.01),"   Provider: ",$$VAL^XBDIQ1(9000010.54,APCDSWDA,1204)

 S DIR(0)="Y",DIR("A")="Are you sure you want to mark this item deleted/entered in error",DIR("B")="Y" KILL DA D ^DIR KILL DIR

 Q:'Y

 Q:$D(DIRUT)

 D ENTINERR(APCDSWDA)

 ;if it is a NAM or NAP then also find MLR or PLR for the same date/provider and mark them as entered in error

 I APCDMNE("NAME")="NAM" D REV Q

 I APCDMNE("NAME")="NAP" D REV Q

 I APCDMNE("NAME")="NAA" D REV Q

ENTINERR(APCDSWDA) ;EP

 I '$D(APCDSWDA) Q

 I '$D(^AUPNVRUP(APCDSWDA,0)) W !!,"invalid v updated/reviewed entry...." Q

 S DA=APCDSWDA,DIE("NO^")=1,DIE="^AUPNVRUP(",DR="[APCD VUR ENTERED IN ERROR" D ^DIE K DA,DR,DIE

REV ;delete auto-entered MLR/PLR

 ;FIND MLR/PLR with same provider and same date as the NAM/NAP

 NEW APCDP,APCDDAT,A,B,C,APCDV,G,DA,DR,DIE

 S APCDP=$P($G(^AUPNVRUP(APCDSWDA,12)),U,4)

 S APCDDAT=$P($G(^AUPNVRUP(APCDSWDA,12)),U,1)

 S APCDV=$P(^AUPNVRUP(APCDSWDA,0),U,3)

 I APCDMNE("NAME")="NAM" S A=$O(^AUTTCRA("C","MLR",0))

 I APCDMNE("NAME")="NAP" S A=$O(^AUTTCRA("C","PLR",0))

 I APCDMNE("NAME")="NAA" S A=$O(^AUTTCRA("C","ALR",0))

 S G=""

 S B=0 F  S B=$O(^AUPNVRUP("AD",APCDV,B)) Q:B'=+B!(G)  D

 .Q:$P($G(^AUPNVRUP(B,0)),U,1)'=A

 .Q:$P($G(^AUPNVRUP(B,12)),U,4)'=APCDP

 .Q:$P($G(^AUPNVRUP(B,12)),U,1)'=APCDDAT

 .Q:$P($G(^AUPNVRUP(B,2)),U,1)="Y"  ;already marked as entered in error

 .S DA=B,DIE="^AUPNVRUP(",DR="2.01///"_$P($G(^AUPNVRUP(APCDSWDA,2)),U,1)_";2.02///"_$P($G(^AUPNVRUP(APCDSWDA,2)),U,2)_";2.03///"_$P($G(^AUPNVRUP(APCDSWDA,2)),U,3)_";2.04///"_$P($G(^AUPNVRUP(APCDSWDA,2)),U,4)

 .D ^DIE

 .S G=1

.Q

APCDSWU   ; IHS/CMI/LAB - SWITCH TO V FILE ;

 +1       ;;2.0;IHS PCC SUITE;**4,5**;MAY 14, 2009

 +2       ;

 +3       ; APCDSWD=DICTIONARY NUMBER

 +4       ; APCDSWCR=LINKING CROSS REFERENCE

 +5       ; APCDSWV=VISIT DFN

 +6       ;

EP        ;

 +1        DO EN^XBNEW("EN^APCDSWU","APCDVSIT;APCDMNE")

 +2        QUIT

EN        ;

 +1        NEW APCDSWDA,APCDSWMV,APCDVM01,APCDVM04,APCDSWCT,APCDSWA,APCDSWAN,APCDSWX,APCDSWT,APCDSWI,APCDSWVE

 +2        NEW X,Y,DIR

EN0       ;

 +1        WRITE !!,"Please Note:  You are NOT permitted to modify or delete these"

 +2        WRITE !,APCDMNE("NAME")," entries.  You can only mark them as entered in error."

 +3       ;

 +4        SET APCDSWCT=0

 +5        KILL APCDSWA

 +6        SET APCDSWMV=$ORDER(^AUTTCRA("C",APCDMNE("NAME"),0))

 +7        SET APCDSWVE=$PIECE(^AUTTCRA(APCDSWMV,0),U,1)

 +8        SET APCDSWDA=0

FOR

               SET APCDSWDA=$ORDER(^AUPNVRUP("AD",APCDVSIT,APCDSWDA))

               IF APCDSWDA'=+APCDSWDA

                   QUIT

               Begin DoDot:1

 +9       ;don't display those entered in error

                   IF $PIECE($GET(^AUPNVRUP(APCDSWDA,2)),U,1)

                       QUIT

 +10               SET APCDVM01=$$VALI^XBDIQ1(9000010.54,APCDSWDA,.01)

 +11      ;S APCDVM04=$$VAL^XBDIQ1(9000010.04,APCDSWDA,.04)

 +12               IF APCDSWMV]""

                       IF APCDVM01'=APCDSWMV

                           QUIT

 +13               SET APCDSWCT=APCDSWCT+1

 +14               SET APCDSWA(APCDSWCT)=APCDSWDA

               End DoDot:1

 +15       IF '$DATA(APCDSWA)

               WRITE !!,"There are no '",APCDSWVE,"' clinical review actions documented on this",!,"visit.  The ",APCDMNE("NAME")," mnemonic has not been used on this visit so there is nothing",!,"to modify."

               QUIT

 +16       DO SELECTM

 +17       QUIT

 +18      ;

SELECTM   ;

 +1       ;select the measurement to edit or delete

 +2        WRITE !,"Please choose which clinical review action you would like to"

 +3        WRITE !,"mark 'Entered in Error', if you do not wish to mark any in error, "

 +4        WRITE !,"simply press 'enter' to bypass."

 +5        SET APCDSWX=0

           SET APCDSWT=0

FOR

               SET APCDSWX=$ORDER(APCDSWA(APCDSWX))

               IF APCDSWX'=+APCDSWX

                   QUIT

               Begin DoDot:1

 +6                SET APCDSWDA=APCDSWA(APCDSWX)

                   SET APCDSWT=APCDSWX

 +7                SET APCDVM01=$$VAL^XBDIQ1(9000010.54,APCDSWDA,.01)

 +8                SET APCDVM04=$$VAL^XBDIQ1(9000010.54,APCDSWDA,1204)

 +9                WRITE !?2,APCDSWX,")",?7,APCDVM01,?40,"Provider: ",APCDVM04

               End DoDot:1

 +10       KILL DIR

 +11       SET DIR(0)="NO^1:"_APCDSWT_":0"

           SET DIR("A")="Which "_APCDSWVE

           SET DIR("?")="Enter a number from the list above (1-"_APCDSWT_" or 'N' to exit."

           KILL DA

           DO ^DIR

           KILL DIR

 +12       IF $DATA(DIRUT)

               QUIT

 +13       IF X=""

               QUIT

 +14       IF Y=""

               QUIT

 +15       IF '$DATA(APCDSWA(X))

               WRITE !,"Invalid response.  Please enter a number from 1 to ",APCDSWT," or N."

               GOTO SELECTM

 +16       SET APCDSWI=Y

 +17       SET APCDSWDA=APCDSWA(X)

 +18       KILL DIR

 +19       WRITE !,"You have selected: ",$$VAL^XBDIQ1(9000010.54,APCDSWDA,.01),"   Provider: ",$$VAL^XBDIQ1(9000010.54,APCDSWDA,1204)

 +20       SET DIR(0)="Y"

           SET DIR("A")="Are you sure you want to mark this item deleted/entered in error"

           SET DIR("B")="Y"

           KILL DA

           DO ^DIR

           KILL DIR

 +21       IF 'Y

               QUIT

 +22       IF $DATA(DIRUT)

               QUIT

 +23       DO ENTINERR(APCDSWDA)

 +24      ;if it is a NAM or NAP then also find MLR or PLR for the same date/provider and mark them as entered in error

 +25       IF APCDMNE("NAME")="NAM"

               DO REV

               QUIT

 +26       IF APCDMNE("NAME")="NAP"

               DO REV

               QUIT

 +27       IF APCDMNE("NAME")="NAA"

               DO REV

               QUIT

 +28       QUIT

ENTINERR(APCDSWDA) ;EP

 +1        IF '$DATA(APCDSWDA)

               QUIT

 +2        IF '$DATA(^AUPNVRUP(APCDSWDA,0))

               WRITE !!,"invalid v updated/reviewed entry...."

               QUIT

 +3        SET DA=APCDSWDA

           SET DIE("NO^")=1

           SET DIE="^AUPNVRUP("

           SET DR="[APCD VUR ENTERED IN ERROR"

           DO ^DIE

           KILL DA,DR,DIE

 +4        QUIT

REV       ;delete auto-entered MLR/PLR

 +1       ;FIND MLR/PLR with same provider and same date as the NAM/NAP

 +2        NEW APCDP,APCDDAT,A,B,C,APCDV,G,DA,DR,DIE

 +3        SET APCDP=$PIECE($GET(^AUPNVRUP(APCDSWDA,12)),U,4)

 +4        SET APCDDAT=$PIECE($GET(^AUPNVRUP(APCDSWDA,12)),U,1)

 +5        SET APCDV=$PIECE(^AUPNVRUP(APCDSWDA,0),U,3)

 +6        IF APCDMNE("NAME")="NAM"

               SET A=$ORDER(^AUTTCRA("C","MLR",0))

 +7        IF APCDMNE("NAME")="NAP"

               SET A=$ORDER(^AUTTCRA("C","PLR",0))

 +8        IF APCDMNE("NAME")="NAA"

               SET A=$ORDER(^AUTTCRA("C","ALR",0))

 +9        SET G=""

 +10       SET B=0

FOR

               SET B=$ORDER(^AUPNVRUP("AD",APCDV,B))

               IF B'=+B!(G)

                   QUIT

               Begin DoDot:1

 +11               IF $PIECE($GET(^AUPNVRUP(B,0)),U,1)'=A

                       QUIT

 +12               IF $PIECE($GET(^AUPNVRUP(B,12)),U,4)'=APCDP

                       QUIT

 +13               IF $PIECE($GET(^AUPNVRUP(B,12)),U,1)'=APCDDAT

                       QUIT

 +14      ;already marked as entered in error

                   IF $PIECE($GET(^AUPNVRUP(B,2)),U,1)="Y"

                       QUIT

 +15               SET DA=B

                   SET DIE="^AUPNVRUP("

                   SET DR="2.01///"_$PIECE($GET(^AUPNVRUP(APCDSWDA,2)),U,1)_";2.02///"_$PIECE($GET(^AUPNVRUP(APCDSWDA,2)),U,2)_";2.03///"_$PIECE($GET(^AUPNVRUP(APCDSWDA,2)),U,3)_";2.04///"_$PIECE($GET(^AUPNVRUP(APCDSWDA,2)),U,4)

 +16               DO ^DIE

 +17               SET G=1

 +18               QUIT

               End DoDot:1

 +19       QUIT

APCDSWU.m