APCDEH1.m

APCDEH1 ; IHS/CMI/LAB - UPDATE VISIT W/LIST MAN ;

 ;;2.0;IHS PCC SUITE;**17,20**;MAY 14, 2009;Build 25

 ;

 ;

 ;

HS ;EP - called from protocol to display health summary

 D FULL^VALM1

 K DIC,DR,DD S DIC="^APCHSCTL(",DIC(0)="AEMQ",DIC("B")="ADULT REGULAR" D ^DIC K DIC,DA,DD,D0,D1,DQ

 I Y=-1 D PAUSE,BACK Q

 S APCHSTYP=+Y,APCHSPAT=APCDPAT

 S APCDHDR="PCC Health Summary for "_$P(^DPT(APCDPAT,0),U)

 D VIEWR^XBLM("EN^APCHS",APCDHDR)

 S (DFN,Y)=APCDPAT D ^AUPNPAT

 K APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,APCDHDR,APCDSEL,APCDHIGH,APCDSEL,APCHSCCL,APCHSDCL,APCHSICD,APCHSICL,APCHSNRQ,APCHSQT

 D BACK

 Q

OTHER ;EP - called from protocol to process other mnemonics

 D EN^VALM("APCD EL SECONDARY ITEMS")

 D CLEAR^VALM1

 K APCDDISP,APCDSEL,^TMP("APCDEH",$J),C,X,I,K,J,APCDHIGH,APCDCUT,APCDCSEL,APCDCNTL,APCDC,APCDANS,APCDI,APCDCRIT,APCDTEXT

 K VALMHDR,VALMCNT

 D BACK

 Q

HIST ;EP - called from protocol

 D EN^VALM("APCD EL HISTORICAL ITEMS")

 D CLEAR^VALM1

 K APCDDISP,APCDSEL,^TMP("APCDEH",$J),C,X,I,K,J,APCDHIGH,APCDCUT,APCDCSEL,APCDCNTL,APCDC,APCDANS,APCDI,APCDCRIT,APCDTEXT

 K VALMHDR,VALMCNT

 D BACK

 Q

DISP ;

 D FULL^VALM1

 D ^APCDVD

 S (DFN,Y)=APCDPAT

 D ^AUPNPAT

 D BACK

 Q

PROB ;EP called from protocol

 D FULL^VALM1

 S DFN=APCDPAT,APCDSLOC=APCDLOC,APCDSDAT=APCDDATE,APCDSPAT=APCDPAT

 D EN1^APCDPL

 S APCDPAT=APCDSPAT,APCDLOC=APCDSLOC,APCDDATE=APCDSDAT

 K APCDSPAT,APCDSLOC,APCDSDAT

 S (DFN,Y)=APCDPAT

 D ^AUPNPAT

 D BACK

 Q

ADD ;EP - add an item to the selected list - called from a protocol

 W ! S DIR(0)="LO^1:"_APCDHIGH,DIR("A")="Add which visit item(s)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !,"No items selected." G ADDX

 I $D(DIRUT) W !,"No items selected." G ADDX

 D FULL^VALM1 W:$D(IOF) @IOF

 D ADDPROC

ADDX ;

 W !! S DIR(0)="EO",DIR("A")="Press return to continue..." K DA D ^DIR K DIR

 K APCDANS,APCDC,APCDI,APCDCRIT,APCDTEXT

 D BACK

 Q

ADDPROC ;process add items

 S APCDANS=Y,APCDC="" F APCDI=1:1 S APCDC=$P(APCDANS,",",APCDI) Q:APCDC=""  S APCDCRIT=APCDSEL(APCDC) D

 .S APCDTEXT=$P(^APCDTKW(APCDCRIT,0),U,12)

 .I $P(^APCDTKW(APCDCRIT,0),U,11)=999 D MNEPROC^APCDEH1 Q

 .S APCDMNE=APCDCRIT,APCDMNE("NAME")=$P(^APCDTKW(APCDCRIT,0),U,1)

 .S APCDMODE="A"

 .K APCDMOD

 .W !!,"Adding ",APCDTEXT,!

 .D ^APCDEA3

 .Q

 Q

MODIFY ;

 W ! S DIR(0)="LO^1:"_APCDHIGH,DIR("A")="Modify which visit item(s)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !,"No items selected." G ADDX

 I $D(DIRUT) W !,"No items selected." G ADDX

 D FULL^VALM1 W:$D(IOF) @IOF

 D MODPROC

MODIFYX ;

 W !! S DIR(0)="EO",DIR("A")="Press return to continue..." K DA D ^DIR K DIR

 K APCDANS,APCDC,APCDI,APCDCRIT,APCDTEXT

 D BACK

 Q

MODPROC ;

 S APCDANS=Y,APCDC="" F APCDI=1:1 S APCDC=$P(APCDANS,",",APCDI) Q:APCDC=""  S APCDCRIT=APCDSEL(APCDC) D

 .S APCDTEXT=$P(^APCDTKW(APCDCRIT,0),U,12)

 .I $P(^APCDTKW(APCDCRIT,0),U,11)=999 D MNEPROC Q

 .S APCDMNE=APCDCRIT,APCDMNE("NAME")=$P(^APCDTKW(APCDCRIT,0),U,1)

 .S APCDMODE="M",APCDVLK=$G(APCDVSIT)

 .K APCDMOD

 .W !!,"Modifying ",APCDTEXT,!

 .D ^APCDEA3

 .Q

 Q

DELETE ;

 W ! S DIR(0)="LO^1:"_APCDHIGH,DIR("A")="Modify which visit item(s)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !,"No items selected." G DELETEX

 I $D(DIRUT) W !,"No items selected." G DELETEX

 D FULL^VALM1 W:$D(IOF) @IOF

 D DELPROC

DELETEX ;

 W !! S DIR(0)="EO",DIR("A")="Press return to continue..." K DA D ^DIR K DIR

 K APCDANS,APCDC,APCDI,APCDCRIT,APCDTEXT,APCDSEL,APCDHIGH,APCDVLK

 D BACK

 Q

DELPROC ;

 S APCDANS=Y,APCDC="" F APCDI=1:1 S APCDC=$P(APCDANS,",",APCDI) Q:APCDC=""  S APCDCRIT=APCDSEL(APCDC) D

 .S APCDTEXT=$P(^APCDTKW(APCDCRIT,0),U,12)

 .I $P(^APCDTKW(APCDCRIT,0),U,11)=999 D MNEPROC Q

 .S APCDMNE=APCDCRIT,APCDMNE("NAME")=$P(^APCDTKW(APCDCRIT,0),U,1)

 .S APCDMODE="M",APCDVLK=$G(APCDVSIT) ;IHS/CMI/LAB - added $G

 .K APCDMOD

 .W !!,"Deleting ",APCDTEXT,!,"After you select the ",APCDTEXT," that you want to delete, ",!,"you MUST enter an '@' to confirm the desire to delete the item.",!

 .D ^APCDEA3

 .Q

 Q

BACK ;EP go back to listman

 D TERM^VALM0

 S VALMBCK="R"

 D INIT3^APCDEH

 D HDR^APCDEH

 K DIR

 D KDIE

 K X,Y,Z,I

 Q

PAUSE ;EP

 S DIR(0)="EO",DIR("A")="Press return to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q

KDIE ;kill all vars used by DIE

 K DIE,DR,DA,DIU,DIV,DQ,D0,DO,DI,DIW,DIY,%,DQ

 Q

MNEPROC ;EP - PROCESS MNEMONICS UNTIL DONE

 S APCDMPQ=0

 F  D GETMNE D:$D(APCDEQX) CHKEHR2^APCDVCHK I APCDMPQ Q

 D GETMNEK

 K APCDMPQ

 Q

 ;

GETMNE ; GET MNEMONIC

 W !

 S DIC="^APCDTKW(",DIC(0)="AEMQ",DIC("A")="MNEMONIC: ",DIC("S")="I $L($P(^(0),U))<5" D ^DIC K DIC("A"),DIC("S")

 I Y<0 S APCDMPQ=1 Q

 S APCDMNE=+Y,APCDMNE("NAME")=$P(Y,U,2)

 K APCDMOD

 D ^APCDEA3

 I $D(APCDEQX) D ^APCDEQX I $D(APCDEQX) S APCDMPQ=1 Q

 I $D(APCDMOD) W !!,"Switching to Modify Mode for ONE Mnemonic ONLY!" S APCDMODE="M",APCDVLK=APCDVSIT D GETMNE K APCDVLK,APCDMOD S APCDMODE="A" W !!,"Switching back to ENTER Mode!" Q

 Q

 ;

GETMNEK ; KILL GETMNE SPECIFIC VARIABLES

 K APCDEGX,APCDEQX,APCDMNE

 Q

APCDEH1   ; IHS/CMI/LAB - UPDATE VISIT W/LIST MAN ;

 +1       ;;2.0;IHS PCC SUITE;**17,20**;MAY 14, 2009;Build 25

 +2       ;

 +3       ;

 +4       ;

HS        ;EP - called from protocol to display health summary

 +1        DO FULL^VALM1

 +2        KILL DIC,DR,DD

           SET DIC="^APCHSCTL("

           SET DIC(0)="AEMQ"

           SET DIC("B")="ADULT REGULAR"

           DO ^DIC

           KILL DIC,DA,DD,D0,D1,DQ

 +3        IF Y=-1

               DO PAUSE

               DO BACK

               QUIT 

 +4        SET APCHSTYP=+Y

           SET APCHSPAT=APCDPAT

 +5        SET APCDHDR="PCC Health Summary for "_$PIECE(^DPT(APCDPAT,0),U)

 +6        DO VIEWR^XBLM("EN^APCHS",APCDHDR)

 +7        SET (DFN,Y)=APCDPAT

           DO ^AUPNPAT

 +8        KILL APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,APCDHDR,APCDSEL,APCDHIGH,APCDSEL,APCHSCCL,APCHSDCL,APCHSICD,APCHSICL,APCHSNRQ,APCHSQT

 +9        DO BACK

 +10       QUIT 

OTHER     ;EP - called from protocol to process other mnemonics

 +1        DO EN^VALM("APCD EL SECONDARY ITEMS")

 +2        DO CLEAR^VALM1

 +3        KILL APCDDISP,APCDSEL,^TMP("APCDEH",$JOB),C,X,I,K,J,APCDHIGH,APCDCUT,APCDCSEL,APCDCNTL,APCDC,APCDANS,APCDI,APCDCRIT,APCDTEXT

 +4        KILL VALMHDR,VALMCNT

 +5        DO BACK

 +6        QUIT 

HIST      ;EP - called from protocol

 +1        DO EN^VALM("APCD EL HISTORICAL ITEMS")

 +2        DO CLEAR^VALM1

 +3        KILL APCDDISP,APCDSEL,^TMP("APCDEH",$JOB),C,X,I,K,J,APCDHIGH,APCDCUT,APCDCSEL,APCDCNTL,APCDC,APCDANS,APCDI,APCDCRIT,APCDTEXT

 +4        KILL VALMHDR,VALMCNT

 +5        DO BACK

 +6        QUIT 

DISP      ;

 +1        DO FULL^VALM1

 +2        DO ^APCDVD

 +3        SET (DFN,Y)=APCDPAT

 +4        DO ^AUPNPAT

 +5        DO BACK

 +6        QUIT 

PROB      ;EP called from protocol

 +1        DO FULL^VALM1

 +2        SET DFN=APCDPAT

           SET APCDSLOC=APCDLOC

           SET APCDSDAT=APCDDATE

           SET APCDSPAT=APCDPAT

 +3        DO EN1^APCDPL

 +4        SET APCDPAT=APCDSPAT

           SET APCDLOC=APCDSLOC

           SET APCDDATE=APCDSDAT

 +5        KILL APCDSPAT,APCDSLOC,APCDSDAT

 +6        SET (DFN,Y)=APCDPAT

 +7        DO ^AUPNPAT

 +8        DO BACK

 +9        QUIT 

ADD       ;EP - add an item to the selected list - called from a protocol

 +1        WRITE !

           SET DIR(0)="LO^1:"_APCDHIGH

           SET DIR("A")="Add which visit item(s)"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF Y=""

               WRITE !,"No items selected."

               GOTO ADDX

 +3        IF $DATA(DIRUT)

               WRITE !,"No items selected."

               GOTO ADDX

 +4        DO FULL^VALM1

           IF $DATA(IOF)

               WRITE @IOF

 +5        DO ADDPROC

ADDX      ;

 +1        WRITE !!

           SET DIR(0)="EO"

           SET DIR("A")="Press return to continue..."

           KILL DA

           DO ^DIR

           KILL DIR

 +2        KILL APCDANS,APCDC,APCDI,APCDCRIT,APCDTEXT

 +3        DO BACK

 +4        QUIT 

ADDPROC   ;process add items

 +1        SET APCDANS=Y

           SET APCDC=""

           FOR APCDI=1:1

               SET APCDC=$PIECE(APCDANS,",",APCDI)

               IF APCDC=""

                   QUIT 

               SET APCDCRIT=APCDSEL(APCDC)

               Begin DoDot:1

 +2                SET APCDTEXT=$PIECE(^APCDTKW(APCDCRIT,0),U,12)

 +3                IF $PIECE(^APCDTKW(APCDCRIT,0),U,11)=999

                       DO MNEPROC^APCDEH1

                       QUIT 

 +4                SET APCDMNE=APCDCRIT

                   SET APCDMNE("NAME")=$PIECE(^APCDTKW(APCDCRIT,0),U,1)

 +5                SET APCDMODE="A"

 +6                KILL APCDMOD

 +7                WRITE !!,"Adding ",APCDTEXT,!

 +8                DO ^APCDEA3

 +9                QUIT 

               End DoDot:1

 +10       QUIT 

MODIFY    ;

 +1        WRITE !

           SET DIR(0)="LO^1:"_APCDHIGH

           SET DIR("A")="Modify which visit item(s)"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF Y=""

               WRITE !,"No items selected."

               GOTO ADDX

 +3        IF $DATA(DIRUT)

               WRITE !,"No items selected."

               GOTO ADDX

 +4        DO FULL^VALM1

           IF $DATA(IOF)

               WRITE @IOF

 +5        DO MODPROC

MODIFYX   ;

 +1        WRITE !!

           SET DIR(0)="EO"

           SET DIR("A")="Press return to continue..."

           KILL DA

           DO ^DIR

           KILL DIR

 +2        KILL APCDANS,APCDC,APCDI,APCDCRIT,APCDTEXT

 +3        DO BACK

 +4        QUIT 

MODPROC   ;

 +1        SET APCDANS=Y

           SET APCDC=""

           FOR APCDI=1:1

               SET APCDC=$PIECE(APCDANS,",",APCDI)

               IF APCDC=""

                   QUIT 

               SET APCDCRIT=APCDSEL(APCDC)

               Begin DoDot:1

 +2                SET APCDTEXT=$PIECE(^APCDTKW(APCDCRIT,0),U,12)

 +3                IF $PIECE(^APCDTKW(APCDCRIT,0),U,11)=999

                       DO MNEPROC

                       QUIT 

 +4                SET APCDMNE=APCDCRIT

                   SET APCDMNE("NAME")=$PIECE(^APCDTKW(APCDCRIT,0),U,1)

 +5                SET APCDMODE="M"

                   SET APCDVLK=$GET(APCDVSIT)

 +6                KILL APCDMOD

 +7                WRITE !!,"Modifying ",APCDTEXT,!

 +8                DO ^APCDEA3

 +9                QUIT 

               End DoDot:1

 +10       QUIT 

DELETE    ;

 +1        WRITE !

           SET DIR(0)="LO^1:"_APCDHIGH

           SET DIR("A")="Modify which visit item(s)"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF Y=""

               WRITE !,"No items selected."

               GOTO DELETEX

 +3        IF $DATA(DIRUT)

               WRITE !,"No items selected."

               GOTO DELETEX

 +4        DO FULL^VALM1

           IF $DATA(IOF)

               WRITE @IOF

 +5        DO DELPROC

DELETEX   ;

 +1        WRITE !!

           SET DIR(0)="EO"

           SET DIR("A")="Press return to continue..."

           KILL DA

           DO ^DIR

           KILL DIR

 +2        KILL APCDANS,APCDC,APCDI,APCDCRIT,APCDTEXT,APCDSEL,APCDHIGH,APCDVLK

 +3        DO BACK

 +4        QUIT 

DELPROC   ;

 +1        SET APCDANS=Y

           SET APCDC=""

           FOR APCDI=1:1

               SET APCDC=$PIECE(APCDANS,",",APCDI)

               IF APCDC=""

                   QUIT 

               SET APCDCRIT=APCDSEL(APCDC)

               Begin DoDot:1

 +2                SET APCDTEXT=$PIECE(^APCDTKW(APCDCRIT,0),U,12)

 +3                IF $PIECE(^APCDTKW(APCDCRIT,0),U,11)=999

                       DO MNEPROC

                       QUIT 

 +4                SET APCDMNE=APCDCRIT

                   SET APCDMNE("NAME")=$PIECE(^APCDTKW(APCDCRIT,0),U,1)

 +5       ;IHS/CMI/LAB - added $G

                   SET APCDMODE="M"

                   SET APCDVLK=$GET(APCDVSIT)

 +6                KILL APCDMOD

 +7                WRITE !!,"Deleting ",APCDTEXT,!,"After you select the ",APCDTEXT," that you want to delete, ",!,"you MUST enter an '@' to confirm the desire to delete the item.",!

 +8                DO ^APCDEA3

 +9                QUIT 

               End DoDot:1

 +10       QUIT 

BACK      ;EP go back to listman

 +1        DO TERM^VALM0

 +2        SET VALMBCK="R"

 +3        DO INIT3^APCDEH

 +4        DO HDR^APCDEH

 +5        KILL DIR

 +6        DO KDIE

 +7        KILL X,Y,Z,I

 +8        QUIT 

PAUSE     ;EP

 +1        SET DIR(0)="EO"

           SET DIR("A")="Press return to continue...."

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        QUIT 

KDIE      ;kill all vars used by DIE

 +1        KILL DIE,DR,DA,DIU,DIV,DQ,D0,DO,DI,DIW,DIY,%,DQ

 +2        QUIT 

MNEPROC   ;EP - PROCESS MNEMONICS UNTIL DONE

 +1        SET APCDMPQ=0

 +2        FOR 

               DO GETMNE

               IF $DATA(APCDEQX)

                   DO CHKEHR2^APCDVCHK

               IF APCDMPQ

                   QUIT 

 +3        DO GETMNEK

 +4        KILL APCDMPQ

 +5        QUIT 

 +6       ;

GETMNE    ; GET MNEMONIC

 +1        WRITE !

 +2        SET DIC="^APCDTKW("

           SET DIC(0)="AEMQ"

           SET DIC("A")="MNEMONIC: "

           SET DIC("S")="I $L($P(^(0),U))<5"

           DO ^DIC

           KILL DIC("A"),DIC("S")

 +3        IF Y<0

               SET APCDMPQ=1

               QUIT 

 +4        SET APCDMNE=+Y

           SET APCDMNE("NAME")=$PIECE(Y,U,2)

 +5        KILL APCDMOD

 +6        DO ^APCDEA3

 +7        IF $DATA(APCDEQX)

               DO ^APCDEQX

               IF $DATA(APCDEQX)

                   SET APCDMPQ=1

                   QUIT 

 +8        IF $DATA(APCDMOD)

               WRITE !!,"Switching to Modify Mode for ONE Mnemonic ONLY!"

               SET APCDMODE="M"

               SET APCDVLK=APCDVSIT

               DO GETMNE

               KILL APCDVLK,APCDMOD

               SET APCDMODE="A"

               WRITE !!,"Switching back to ENTER Mode!"

               QUIT 

 +9        QUIT 

 +10      ;

GETMNEK   ; KILL GETMNE SPECIFIC VARIABLES

 +1        KILL APCDEGX,APCDEQX,APCDMNE

 +2        QUIT