APCDETP1 ; IHS/CMI/LAB - treatment plan update ;
;;2.0;IHS PCC SUITE;**2,11**;MAY 14, 2009;Build 58
;
PL ;EP
D EN1^APCDPL
D EXIT
Q
HS ;EP - Display Patient Profile
D FULL^VALM1
S X="" I DUZ(2),$D(^APCCCTRL(DUZ(2),0))#2 S X=$P(^(0),U,3) I X,$D(^APCHSCTL(X,0)) S X=$P(^APCHSCTL(X,0),U)
I $D(^DISV(DUZ,"^APCHSCTL(")) S Y=^("^APCHSCTL(") I $D(^APCHSCTL(Y,0)) S X=$P(^(0),U,1)
S:X="" X="ADULT REGULAR"
K DIC,DR,DD S DIC("B")=X,DIC="^APCHSCTL(",DIC(0)="AEMQ" D ^DIC K DIC,DA,DD,D0,D1,DQ
I Y=-1 D PAUSE,EXIT Q
S APCDPLPT=DFN
S APCHSTYP=+Y,APCHSPAT=DFN
S APCDHDR="PCC Health Summary for "_$P(^DPT(APCDPLPT,0),U)
D VIEWR^XBLM("EN^APCHS",APCDHDR)
S (DFN,Y)=APCDPLPT D ^AUPNPAT
K APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,APCDHDR
D EXIT
Q
ADD ;EP
D FULL^VALM1
I '$D(DFN) W !!,"Patient not entered." H 5 Q
NEW APCDTPT,APCDTDI,APCDTRP,APCDTDX,APCDTPTN,APCDTRPN,APCDTP
D HEADER
W !,"Creating new Treatment Plan..."
TYPE ;
K DIR
S APCDTPT="",APCDTPTN=""
W !!,"Enter Treatment Plan Type"
K DIC
S DIC="^AUTTTPL(",DIC(0)="AEMQ" D ^DIC K DIC
I Y=-1 D EXIT Q
S APCDTPT=+Y,APCDTPTN=$P(Y,U,2)
S APCDOTHT=""
I APCDTPTN'="OTHER" G DI
TYPEO ;
S DIR(0)="9000094,.15",DIR("A")="Enter OTHER Type" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G TYPE
I Y="" W !!,"Required!" G TYPE
S APCDOTHT=Y
DI ;
W !!
S APCDTDI=""
S DIR(0)="D^:"_DT_":EP",DIR("A")="Enter Date Initiated" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G TYPE
S APCDTDI=Y
RP ;
W !!
K DIC
S APCDTRP="",APCDTRPN=""
S DIC=200,DIC("A")="Enter Responsible Provider: ",DIC(0)="AEMQ",DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U),+Y)),$P($G(^VA(200,+Y,""PS"")),U,4)="""""
D ^DIC
I Y=-1 G DI
S APCDTRP=+Y,APCDTRPN=$P(Y,U,2)
DX ;
K DIC
S APCDTDX=""
W !!,"Please enter the diagnosis associated with this treatment plan.",!
;K DIC,DIADD,DLAYGO
;S DIC="^ICD9(",DIC(0)="AEMQ",APCDDATE=APCDTDI,DIC("S")="D ICD^AUPNCIX(+Y,,$G(APCDTDI))" D ^DIC K DIC
;I Y=-1 G RP
;S APCDTDX=+Y
D ^APCDETPD
I $D(APCDTERR) W !,"A valid code was not selected." G DX
I '$G(APCDTDX) W !,"A valid code was not selected." D PAUSE G RP
CONT ;
W !!!,"A Treatment Plan is going to be added for ",$P(^DPT(DFN,0),U)
W !,"with the following data:"
W !?5,"Type: ",APCDTPTN I APCDOTHT]"" W ?40,APCDOTHT
W !?5,"Date Initiated: ",$$FMTE^XLFDT(APCDTDI)
W !?5,"Responsible Provider: ",APCDTRPN
W !?5,"Diagnosis: ",$P($$ICDDX^ICDEX(APCDTDX,APCDTDI),U,2)
W !
W !! S DIR(0)="Y",DIR("A")="Do you want to continue to add this Treatment Plan",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) D EXIT Q
I 'Y D EXIT Q
Q:'Y
S X=APCDTPT
K DD,D0,DO,DINUM,DIC,DA,DR S DIC(0)="EALMQ",DIC="^AUPNTP(",DLAYGO=9000094,DIADD=1
S DIC("DR")=".02////"_DFN_";.03////"_APCDTDI_";.06////"_APCDTDX_";.07////"_APCDTRP_";.08////"_DT_";.09////"_DUZ_";.15///"_APCDOTHT
D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
I Y=-1 W !!,"Error creating treatment plan." H 2 D EXIT Q
S APCDTP=+Y
S DA=APCDTP,DDSFILE=9000094,DR="[APCD EDIT TREATMENT PLAN]" D ^DDS K DDSFILE,DR,DA
D EXIT
Q
EDITR ;EP
NEW APCDTPN,APCDTP
K DIR S DIR(0)="N^1:"_APCDRCNT_":0",DIR("A")="Select Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) W !,"No treatment plan selected." D EXIT Q
S APCDTPN=+Y I 'APCDTPN K APCDTP,VALMY,XQORNOD W !,"No treatment plan selected." D EXIT Q
S APCDTP=$O(APCDPTP("IDX",APCDTPN,0)) I 'APCDTP K APCDTP D PAUSE,EXIT Q
S APCDTP=APCDPTP("IDX",APCDTPN,APCDTP) I 'APCDTP K APCDTP D PAUSE,EXIT Q
I '$D(^AUPNTP(APCDTP,0)) W !,"Not a valid TREATMENT PLAN." D PAUSE,EXIT Q
D FULL^VALM1
EDIT ;
W:$D(IOF) @IOF
D EDT
D EXIT
Q
EDT ;
S DA=APCDTP,DIE="^AUPNTP(",DR=".08////"_DT_".09////"_DUZ D ^DIE K DIE,DR,DA
S DA=APCDTP,DDSFILE=9000094,DR="[APCD EDIT TREATMENT PLAN]" D ^DDS K DDSFILE,DR,DA
Q
DISP ;EP
K DIR S DIR(0)="N^1:"_APCDRCNT_":0",DIR("A")="Select Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) W !,"No treatment plan selected." G EXIT
S APCDTPN=+Y I 'APCDTPN K APCDTP,VALMY,XQORNOD W !,"No treatment plan selected." G EXIT
S APCDTP=$O(APCDPTP("IDX",APCDTPN,0)) I 'APCDTP K APCDTDEL,APCDTP D PAUSE,EXIT Q
S APCDTP=APCDPTP("IDX",APCDTPN,APCDTP) I 'APCDTP K APCDTP D PAUSE,EXIT Q
I '$D(^AUPNTP(APCDTP,0)) W !,"Not a valid TREATMENT PLAN." K APCDTDEL,APCDTP D PAUSE,EXIT Q
D FULL^VALM1
D DIQ^XBLM(9000094,APCDTP) K DIC,DA
D EXIT
Q
REV ;EP
NEW APCDTP,APCDTPN,APCDTRP
K DIR S DIR(0)="N^1:"_APCDRCNT_":0",DIR("A")="Select Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) W !,"No treatment plan selected." G EXIT
S APCDTPN=+Y I 'APCDTPN K APCDTP,VALMY,XQORNOD W !,"No treatment plan selected." G EXIT
S APCDTP=$O(APCDPTP("IDX",APCDTPN,0)) I 'APCDTP K APCDTP D PAUSE,EXIT Q
S APCDTP=APCDPTP("IDX",APCDTPN,APCDTP) I 'APCDTP K APCDTP D PAUSE,EXIT Q
I '$D(^AUPNTP(APCDTP,0)) W !,"Not a valid TREATMENT PLAN." K APCDTDEL,APCDTP D PAUSE,EXIT Q
D FULL^VALM1
W:$D(IOF) @IOF
REV1 ;
S DIR(0)="S^E:Edit the Plan;D:Display the Plan;R:Continue on to enter the Review Information;X:Exit",DIR("A")="Choose an Action",DIR("B")="R" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EXIT Q
I Y="E" D EDT G REV1
I Y="D" D DIQ^XBLM(9000094,APCDTP) K DIC,DA D FULL^VALM1 G REV1
I Y="X" D EXIT Q
W !!,"Reviews currently on file:"
S X=0 F S X=$O(^AUPNTP(APCDTP,18,X)) Q:X'=+X W !?5,$$FMTE^XLFDT($P(^AUPNTP(APCDTP,18,X,0),U)),?40,"Reviewed by: " I $P(^AUPNTP(APCDTP,18,X,0),U,2) W $P(^VA(200,$P(^AUPNTP(APCDTP,18,X,0),U,2),0),U)
W !
S APCDTRP=$P(^AUPNTP(APCDTP,0),U,7)
S DA=APCDTP,DIE="^AUPNTP(",DR="[APCD TP REVIEW]",DIE("NO^")=1 D ^DIE K DIE,DR,DA
D EXIT
Q
DISC ;EP
NEW APCDTP,APCDTPN,APCDTRP
K DIR S DIR(0)="N^1:"_APCDRCNT_":0",DIR("A")="Select Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) W !,"No treatment plan selected." G EXIT
S APCDTPN=+Y I 'APCDTPN K APCDTP,VALMY,XQORNOD W !,"No treatment plan selected." G EXIT
S APCDTP=$O(APCDPTP("IDX",APCDTPN,0)) I 'APCDTP K APCDTP D PAUSE,EXIT Q
S APCDTP=APCDPTP("IDX",APCDTPN,APCDTP) I 'APCDTP K APCDTP D PAUSE,EXIT Q
I '$D(^AUPNTP(APCDTP,0)) W !,"Not a valid TREATMENT PLAN." K APCDTDEL,APCDTP D PAUSE,EXIT Q
D FULL^VALM1
W:$D(IOF) @IOF
DISC1 ;
S DIR(0)="S^E:Edit the Plan;D:Display the Plan;R:Continue on to enter the Discontinue Information;X:Exit",DIR("A")="Choose an Action",DIR("B")="R" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EXIT Q
I Y="E" D EDT G DISC1
I Y="D" D DIQ^XBLM(9000094,APCDTP) D FULL^VALM1 K DIC,DA G DISC1
I Y="X" D EXIT Q
W !
S APCDTRP=$P(^AUPNTP(APCDTP,0),U,7)
S DA=APCDTP,DIE="^AUPNTP(",DR="[APCD TP DISCONTINUED]",DIE("NO^")=1 D ^DIE K DIE,DR,DA
D EXIT
Q
DELETE ;EP
NEW APCDTP,APCDTPN
K DIR S DIR(0)="N^1:"_APCDRCNT_":0",DIR("A")="Select Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) W !,"No treatment plan selected." G EXIT
S APCDTPN=+Y I 'APCDTPN K APCDTP,VALMY,XQORNOD W !,"No treatment plan selected." G EXIT
S APCDTP=$O(APCDPTP("IDX",APCDTPN,0)) I 'APCDTP K APCDTDEL,APCDTP D PAUSE,EXIT Q
S APCDTP=APCDPTP("IDX",APCDTPN,APCDTP) I 'APCDTP K APCDTP D PAUSE,EXIT Q
I '$D(^AUPNTP(APCDTP,0)) W !,"Not a valid TREATMENT PLAN." K APCDTP D PAUSE,EXIT Q
D FULL^VALM1
DEL ;
W !! S DIR(0)="Y",DIR("A")="Are you sure you want to DELETE this Treatment Plan",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
Q:'Y
W !,"Deleting Treatment Plan..." S DA=APCDTP,DIK="^AUPNTP(" D ^DIK K DA,DIK
W !!,"Treatment Plan for ",$P(^DPT(DFN,0),U)," DELETED." D PAUSE
D EXIT
Q
PAUSE ;EP
S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
W:$D(IOF) @IOF
W !,$TR($J(" ",80)," ","-"),!,"Patient Name: ",$P(^DPT(DFN,0),U)," DOB: ",$$FTIME^VALM1($P(^DPT(DFN,0),U,3))," Sex: ",$$VAL^XBDIQ1(2,DFN,.02),!,$TR($J(" ",80)," ","-")
Q
EXIT ;
D TERM^VALM0
S VALMBCK="R"
D GATHER^APCDETP
S VALMCNT=APCDLINE
D HDR^APCDETP
Q
APCDETP1 ; IHS/CMI/LAB - treatment plan update ;
+1 ;;2.0;IHS PCC SUITE;**2,11**;MAY 14, 2009;Build 58
+2 ;
PL ;EP
+1 DO EN1^APCDPL
+2 DO EXIT
+3 QUIT
HS ;EP - Display Patient Profile
+1 DO FULL^VALM1
+2 SET X=""
IF DUZ(2)
IF $DATA(^APCCCTRL(DUZ(2),0))#2
SET X=$PIECE(^(0),U,3)
IF X
IF $DATA(^APCHSCTL(X,0))
SET X=$PIECE(^APCHSCTL(X,0),U)
+3 IF $DATA(^DISV(DUZ,"^APCHSCTL("))
SET Y=^("^APCHSCTL(")
IF $DATA(^APCHSCTL(Y,0))
SET X=$PIECE(^(0),U,1)
+4 IF X=""
SET X="ADULT REGULAR"
+5 KILL DIC,DR,DD
SET DIC("B")=X
SET DIC="^APCHSCTL("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA,DD,D0,D1,DQ
+6 IF Y=-1
DO PAUSE
DO EXIT
QUIT
+7 SET APCDPLPT=DFN
+8 SET APCHSTYP=+Y
SET APCHSPAT=DFN
+9 SET APCDHDR="PCC Health Summary for "_$PIECE(^DPT(APCDPLPT,0),U)
+10 DO VIEWR^XBLM("EN^APCHS",APCDHDR)
+11 SET (DFN,Y)=APCDPLPT
DO ^AUPNPAT
+12 KILL APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,APCDHDR
+13 DO EXIT
+14 QUIT
ADD ;EP
+1 DO FULL^VALM1
+2 IF '$DATA(DFN)
WRITE !!,"Patient not entered."
HANG 5
QUIT
+3 NEW APCDTPT,APCDTDI,APCDTRP,APCDTDX,APCDTPTN,APCDTRPN,APCDTP
+4 DO HEADER
+5 WRITE !,"Creating new Treatment Plan..."
TYPE ;
+1 KILL DIR
+2 SET APCDTPT=""
SET APCDTPTN=""
+3 WRITE !!,"Enter Treatment Plan Type"
+4 KILL DIC
+5 SET DIC="^AUTTTPL("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+6 IF Y=-1
DO EXIT
QUIT
+7 SET APCDTPT=+Y
SET APCDTPTN=$PIECE(Y,U,2)
+8 SET APCDOTHT=""
+9 IF APCDTPTN'="OTHER"
GOTO DI
TYPEO ;
+1 SET DIR(0)="9000094,.15"
SET DIR("A")="Enter OTHER Type"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO TYPE
+3 IF Y=""
WRITE !!,"Required!"
GOTO TYPE
+4 SET APCDOTHT=Y
DI ;
+1 WRITE !!
+2 SET APCDTDI=""
+3 SET DIR(0)="D^:"_DT_":EP"
SET DIR("A")="Enter Date Initiated"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO TYPE
+5 SET APCDTDI=Y
RP ;
+1 WRITE !!
+2 KILL DIC
+3 SET APCDTRP=""
SET APCDTRPN=""
+4 SET DIC=200
SET DIC("A")="Enter Responsible Provider: "
SET DIC(0)="AEMQ"
SET DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U),+Y)),$P($G(^VA(200,+Y,""PS"")),U,4)="""""
+5 DO ^DIC
+6 IF Y=-1
GOTO DI
+7 SET APCDTRP=+Y
SET APCDTRPN=$PIECE(Y,U,2)
DX ;
+1 KILL DIC
+2 SET APCDTDX=""
+3 WRITE !!,"Please enter the diagnosis associated with this treatment plan.",!
+4 ;K DIC,DIADD,DLAYGO
+5 ;S DIC="^ICD9(",DIC(0)="AEMQ",APCDDATE=APCDTDI,DIC("S")="D ICD^AUPNCIX(+Y,,$G(APCDTDI))" D ^DIC K DIC
+6 ;I Y=-1 G RP
+7 ;S APCDTDX=+Y
+8 DO ^APCDETPD
+9 IF $DATA(APCDTERR)
WRITE !,"A valid code was not selected."
GOTO DX
+10 IF '$GET(APCDTDX)
WRITE !,"A valid code was not selected."
DO PAUSE
GOTO RP
CONT ;
+1 WRITE !!!,"A Treatment Plan is going to be added for ",$PIECE(^DPT(DFN,0),U)
+2 WRITE !,"with the following data:"
+3 WRITE !?5,"Type: ",APCDTPTN
IF APCDOTHT]""
WRITE ?40,APCDOTHT
+4 WRITE !?5,"Date Initiated: ",$$FMTE^XLFDT(APCDTDI)
+5 WRITE !?5,"Responsible Provider: ",APCDTRPN
+6 WRITE !?5,"Diagnosis: ",$PIECE($$ICDDX^ICDEX(APCDTDX,APCDTDI),U,2)
+7 WRITE !
+8 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Do you want to continue to add this Treatment Plan"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+9 IF $DATA(DIRUT)
DO EXIT
QUIT
+10 IF 'Y
DO EXIT
QUIT
+11 IF 'Y
QUIT
+12 SET X=APCDTPT
+13 KILL DD,D0,DO,DINUM,DIC,DA,DR
SET DIC(0)="EALMQ"
SET DIC="^AUPNTP("
SET DLAYGO=9000094
SET DIADD=1
+14 SET DIC("DR")=".02////"_DFN_";.03////"_APCDTDI_";.06////"_APCDTDX_";.07////"_APCDTRP_";.08////"_DT_";.09////"_DUZ_";.15///"_APCDOTHT
+15 DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0
+16 IF Y=-1
WRITE !!,"Error creating treatment plan."
HANG 2
DO EXIT
QUIT
+17 SET APCDTP=+Y
+18 SET DA=APCDTP
SET DDSFILE=9000094
SET DR="[APCD EDIT TREATMENT PLAN]"
DO ^DDS
KILL DDSFILE,DR,DA
+19 DO EXIT
+20 QUIT
EDITR ;EP
+1 NEW APCDTPN,APCDTP
+2 KILL DIR
SET DIR(0)="N^1:"_APCDRCNT_":0"
SET DIR("A")="Select Treatment Plan"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
WRITE !,"No treatment plan selected."
DO EXIT
QUIT
+4 SET APCDTPN=+Y
IF 'APCDTPN
KILL APCDTP,VALMY,XQORNOD
WRITE !,"No treatment plan selected."
DO EXIT
QUIT
+5 SET APCDTP=$ORDER(APCDPTP("IDX",APCDTPN,0))
IF 'APCDTP
KILL APCDTP
DO PAUSE
DO EXIT
QUIT
+6 SET APCDTP=APCDPTP("IDX",APCDTPN,APCDTP)
IF 'APCDTP
KILL APCDTP
DO PAUSE
DO EXIT
QUIT
+7 IF '$DATA(^AUPNTP(APCDTP,0))
WRITE !,"Not a valid TREATMENT PLAN."
DO PAUSE
DO EXIT
QUIT
+8 DO FULL^VALM1
EDIT ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 DO EDT
+3 DO EXIT
+4 QUIT
EDT ;
+1 SET DA=APCDTP
SET DIE="^AUPNTP("
SET DR=".08////"_DT_".09////"_DUZ
DO ^DIE
KILL DIE,DR,DA
+2 SET DA=APCDTP
SET DDSFILE=9000094
SET DR="[APCD EDIT TREATMENT PLAN]"
DO ^DDS
KILL DDSFILE,DR,DA
+3 QUIT
DISP ;EP
+1 KILL DIR
SET DIR(0)="N^1:"_APCDRCNT_":0"
SET DIR("A")="Select Treatment Plan"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
WRITE !,"No treatment plan selected."
GOTO EXIT
+3 SET APCDTPN=+Y
IF 'APCDTPN
KILL APCDTP,VALMY,XQORNOD
WRITE !,"No treatment plan selected."
GOTO EXIT
+4 SET APCDTP=$ORDER(APCDPTP("IDX",APCDTPN,0))
IF 'APCDTP
KILL APCDTDEL,APCDTP
DO PAUSE
DO EXIT
QUIT
+5 SET APCDTP=APCDPTP("IDX",APCDTPN,APCDTP)
IF 'APCDTP
KILL APCDTP
DO PAUSE
DO EXIT
QUIT
+6 IF '$DATA(^AUPNTP(APCDTP,0))
WRITE !,"Not a valid TREATMENT PLAN."
KILL APCDTDEL,APCDTP
DO PAUSE
DO EXIT
QUIT
+7 DO FULL^VALM1
+8 DO DIQ^XBLM(9000094,APCDTP)
KILL DIC,DA
+9 DO EXIT
+10 QUIT
REV ;EP
+1 NEW APCDTP,APCDTPN,APCDTRP
+2 KILL DIR
SET DIR(0)="N^1:"_APCDRCNT_":0"
SET DIR("A")="Select Treatment Plan"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
WRITE !,"No treatment plan selected."
GOTO EXIT
+4 SET APCDTPN=+Y
IF 'APCDTPN
KILL APCDTP,VALMY,XQORNOD
WRITE !,"No treatment plan selected."
GOTO EXIT
+5 SET APCDTP=$ORDER(APCDPTP("IDX",APCDTPN,0))
IF 'APCDTP
KILL APCDTP
DO PAUSE
DO EXIT
QUIT
+6 SET APCDTP=APCDPTP("IDX",APCDTPN,APCDTP)
IF 'APCDTP
KILL APCDTP
DO PAUSE
DO EXIT
QUIT
+7 IF '$DATA(^AUPNTP(APCDTP,0))
WRITE !,"Not a valid TREATMENT PLAN."
KILL APCDTDEL,APCDTP
DO PAUSE
DO EXIT
QUIT
+8 DO FULL^VALM1
+9 IF $DATA(IOF)
WRITE @IOF
REV1 ;
+1 SET DIR(0)="S^E:Edit the Plan;D:Display the Plan;R:Continue on to enter the Review Information;X:Exit"
SET DIR("A")="Choose an Action"
SET DIR("B")="R"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
DO EXIT
QUIT
+3 IF Y="E"
DO EDT
GOTO REV1
+4 IF Y="D"
DO DIQ^XBLM(9000094,APCDTP)
KILL DIC,DA
DO FULL^VALM1
GOTO REV1
+5 IF Y="X"
DO EXIT
QUIT
+6 WRITE !!,"Reviews currently on file:"
+7 SET X=0
FOR
SET X=$ORDER(^AUPNTP(APCDTP,18,X))
IF X'=+X
QUIT
WRITE !?5,$$FMTE^XLFDT($PIECE(^AUPNTP(APCDTP,18,X,0),U)),?40,"Reviewed by: "
IF $PIECE(^AUPNTP(APCDTP,18,X,0),U,2)
WRITE $PIECE(^VA(200,$PIECE(^AUPNTP(APCDTP,18,X,0),U,2),0),U)
+8 WRITE !
+9 SET APCDTRP=$PIECE(^AUPNTP(APCDTP,0),U,7)
+10 SET DA=APCDTP
SET DIE="^AUPNTP("
SET DR="[APCD TP REVIEW]"
SET DIE("NO^")=1
DO ^DIE
KILL DIE,DR,DA
+11 DO EXIT
+12 QUIT
DISC ;EP
+1 NEW APCDTP,APCDTPN,APCDTRP
+2 KILL DIR
SET DIR(0)="N^1:"_APCDRCNT_":0"
SET DIR("A")="Select Treatment Plan"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
WRITE !,"No treatment plan selected."
GOTO EXIT
+4 SET APCDTPN=+Y
IF 'APCDTPN
KILL APCDTP,VALMY,XQORNOD
WRITE !,"No treatment plan selected."
GOTO EXIT
+5 SET APCDTP=$ORDER(APCDPTP("IDX",APCDTPN,0))
IF 'APCDTP
KILL APCDTP
DO PAUSE
DO EXIT
QUIT
+6 SET APCDTP=APCDPTP("IDX",APCDTPN,APCDTP)
IF 'APCDTP
KILL APCDTP
DO PAUSE
DO EXIT
QUIT
+7 IF '$DATA(^AUPNTP(APCDTP,0))
WRITE !,"Not a valid TREATMENT PLAN."
KILL APCDTDEL,APCDTP
DO PAUSE
DO EXIT
QUIT
+8 DO FULL^VALM1
+9 IF $DATA(IOF)
WRITE @IOF
DISC1 ;
+1 SET DIR(0)="S^E:Edit the Plan;D:Display the Plan;R:Continue on to enter the Discontinue Information;X:Exit"
SET DIR("A")="Choose an Action"
SET DIR("B")="R"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
DO EXIT
QUIT
+3 IF Y="E"
DO EDT
GOTO DISC1
+4 IF Y="D"
DO DIQ^XBLM(9000094,APCDTP)
DO FULL^VALM1
KILL DIC,DA
GOTO DISC1
+5 IF Y="X"
DO EXIT
QUIT
+6 WRITE !
+7 SET APCDTRP=$PIECE(^AUPNTP(APCDTP,0),U,7)
+8 SET DA=APCDTP
SET DIE="^AUPNTP("
SET DR="[APCD TP DISCONTINUED]"
SET DIE("NO^")=1
DO ^DIE
KILL DIE,DR,DA
+9 DO EXIT
+10 QUIT
DELETE ;EP
+1 NEW APCDTP,APCDTPN
+2 KILL DIR
SET DIR(0)="N^1:"_APCDRCNT_":0"
SET DIR("A")="Select Treatment Plan"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
WRITE !,"No treatment plan selected."
GOTO EXIT
+4 SET APCDTPN=+Y
IF 'APCDTPN
KILL APCDTP,VALMY,XQORNOD
WRITE !,"No treatment plan selected."
GOTO EXIT
+5 SET APCDTP=$ORDER(APCDPTP("IDX",APCDTPN,0))
IF 'APCDTP
KILL APCDTDEL,APCDTP
DO PAUSE
DO EXIT
QUIT
+6 SET APCDTP=APCDPTP("IDX",APCDTPN,APCDTP)
IF 'APCDTP
KILL APCDTP
DO PAUSE
DO EXIT
QUIT
+7 IF '$DATA(^AUPNTP(APCDTP,0))
WRITE !,"Not a valid TREATMENT PLAN."
KILL APCDTP
DO PAUSE
DO EXIT
QUIT
+8 DO FULL^VALM1
DEL ;
+1 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to DELETE this Treatment Plan"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
QUIT
+3 IF 'Y
QUIT
+4 WRITE !,"Deleting Treatment Plan..."
SET DA=APCDTP
SET DIK="^AUPNTP("
DO ^DIK
KILL DA,DIK
+5 WRITE !!,"Treatment Plan for ",$PIECE(^DPT(DFN,0),U)," DELETED."
DO PAUSE
+6 DO EXIT
+7 QUIT
PAUSE ;EP
+1 SET DIR(0)="EO"
SET DIR("A")="Press enter to continue...."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 QUIT
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-"),!,"Patient Name: ",$PIECE(^DPT(DFN,0),U)," DOB: ",$$FTIME^VALM1($PIECE(^DPT(DFN,0),U,3))," Sex: ",$$VAL^XBDIQ1(2,DFN,.02),!,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+3 QUIT
EXIT ;
+1 DO TERM^VALM0
+2 SET VALMBCK="R"
+3 DO GATHER^APCDETP
+4 SET VALMCNT=APCDLINE
+5 DO HDR^APCDETP
+6 QUIT
