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
