Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCDETP1

APCDETP1.m

Go to the documentation of this file. 
  1. APCDETP1 ; IHS/CMI/LAB - treatment plan update ; 
  1.  ;;2.0;IHS PCC SUITE;**2,11**;MAY 14, 2009;Build 58
  1.  ;
  1. PL ;EP
  1.  D EN1^APCDPL
  1.  D EXIT
  1.  Q
  1. HS ;EP - Display Patient Profile
  1.  D FULL^VALM1
  1.  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)
  1.  I $D(^DISV(DUZ,"^APCHSCTL(")) S Y=^("^APCHSCTL(") I $D(^APCHSCTL(Y,0)) S X=$P(^(0),U,1)
  1.  S:X="" X="ADULT REGULAR"
  1.  K DIC,DR,DD S DIC("B")=X,DIC="^APCHSCTL(",DIC(0)="AEMQ" D ^DIC K DIC,DA,DD,D0,D1,DQ
  1.  I Y=-1 D PAUSE,EXIT Q
  1.  S APCDPLPT=DFN
  1.  S APCHSTYP=+Y,APCHSPAT=DFN
  1.  S APCDHDR="PCC Health Summary for "_$P(^DPT(APCDPLPT,0),U)
  1.  D VIEWR^XBLM("EN^APCHS",APCDHDR)
  1.  S (DFN,Y)=APCDPLPT D ^AUPNPAT
  1.  K APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,APCDHDR
  1.  D EXIT
  1.  Q
  1. ADD ;EP
  1.  D FULL^VALM1
  1.  I '$D(DFN) W !!,"Patient not entered." H 5 Q
  1.  NEW APCDTPT,APCDTDI,APCDTRP,APCDTDX,APCDTPTN,APCDTRPN,APCDTP
  1.  D HEADER
  1.  W !,"Creating new Treatment Plan..."
  1. TYPE ;
  1.  K DIR
  1.  S APCDTPT="",APCDTPTN=""
  1.  W !!,"Enter Treatment Plan Type"
  1.  K DIC
  1.  S DIC="^AUTTTPL(",DIC(0)="AEMQ" D ^DIC K DIC
  1.  I Y=-1 D EXIT Q
  1.  S APCDTPT=+Y,APCDTPTN=$P(Y,U,2)
  1.  S APCDOTHT=""
  1.  I APCDTPTN'="OTHER" G DI
  1. TYPEO ;
  1.  S DIR(0)="9000094,.15",DIR("A")="Enter OTHER Type" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G TYPE
  1.  I Y="" W !!,"Required!" G TYPE
  1.  S APCDOTHT=Y
  1. DI ;
  1.  W !!
  1.  S APCDTDI=""
  1.  S DIR(0)="D^:"_DT_":EP",DIR("A")="Enter Date Initiated" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G TYPE
  1.  S APCDTDI=Y
  1. RP ;
  1.  W !!
  1.  K DIC
  1.  S APCDTRP="",APCDTRPN=""
  1.  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)="""""
  1.  D ^DIC
  1.  I Y=-1 G DI
  1.  S APCDTRP=+Y,APCDTRPN=$P(Y,U,2)
  1. DX ;
  1.  K DIC
  1.  S APCDTDX=""
  1.  W !!,"Please enter the diagnosis associated with this treatment plan.",!
  1.  ;K DIC,DIADD,DLAYGO
  1.  ;S DIC="^ICD9(",DIC(0)="AEMQ",APCDDATE=APCDTDI,DIC("S")="D ICD^AUPNCIX(+Y,,$G(APCDTDI))" D ^DIC K DIC
  1.  ;I Y=-1 G RP
  1.  ;S APCDTDX=+Y
  1.  D ^APCDETPD
  1.  I $D(APCDTERR) W !,"A valid code was not selected." G DX
  1.  I '$G(APCDTDX) W !,"A valid code was not selected." D PAUSE G RP
  1. CONT ;
  1.  W !!!,"A Treatment Plan is going to be added for ",$P(^DPT(DFN,0),U)
  1.  W !,"with the following data:"
  1.  W !?5,"Type: ",APCDTPTN I APCDOTHT]"" W ?40,APCDOTHT
  1.  W !?5,"Date Initiated: ",$$FMTE^XLFDT(APCDTDI)
  1.  W !?5,"Responsible Provider: ",APCDTRPN
  1.  W !?5,"Diagnosis: ",$P($$ICDDX^ICDEX(APCDTDX,APCDTDI),U,2)
  1.  W !
  1.  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
  1.  I $D(DIRUT) D EXIT Q
  1.  I 'Y D EXIT Q
  1.  Q:'Y
  1.  S X=APCDTPT
  1.  K DD,D0,DO,DINUM,DIC,DA,DR S DIC(0)="EALMQ",DIC="^AUPNTP(",DLAYGO=9000094,DIADD=1
  1.  S DIC("DR")=".02////"_DFN_";.03////"_APCDTDI_";.06////"_APCDTDX_";.07////"_APCDTRP_";.08////"_DT_";.09////"_DUZ_";.15///"_APCDOTHT
  1.  D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
  1.  I Y=-1 W !!,"Error creating treatment plan." H 2 D EXIT Q
  1.  S APCDTP=+Y
  1.  S DA=APCDTP,DDSFILE=9000094,DR="[APCD EDIT TREATMENT PLAN]" D ^DDS K DDSFILE,DR,DA
  1.  D EXIT
  1.  Q
  1. EDITR ;EP
  1.  NEW APCDTPN,APCDTP
  1.  K DIR S DIR(0)="N^1:"_APCDRCNT_":0",DIR("A")="Select Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) W !,"No treatment plan selected." D EXIT Q
  1.  S APCDTPN=+Y I 'APCDTPN K APCDTP,VALMY,XQORNOD W !,"No treatment plan selected." D EXIT Q
  1.  S APCDTP=$O(APCDPTP("IDX",APCDTPN,0)) I 'APCDTP K APCDTP D PAUSE,EXIT Q
  1.  S APCDTP=APCDPTP("IDX",APCDTPN,APCDTP) I 'APCDTP K APCDTP D PAUSE,EXIT Q
  1.  I '$D(^AUPNTP(APCDTP,0)) W !,"Not a valid TREATMENT PLAN." D PAUSE,EXIT Q
  1.  D FULL^VALM1
  1. EDIT ;
  1.  W:$D(IOF) @IOF
  1.  D EDT
  1.  D EXIT
  1.  Q
  1. EDT ;
  1.  S DA=APCDTP,DIE="^AUPNTP(",DR=".08////"_DT_".09////"_DUZ D ^DIE K DIE,DR,DA
  1.  S DA=APCDTP,DDSFILE=9000094,DR="[APCD EDIT TREATMENT PLAN]" D ^DDS K DDSFILE,DR,DA
  1.  Q
  1. DISP ;EP
  1.  K DIR S DIR(0)="N^1:"_APCDRCNT_":0",DIR("A")="Select Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) W !,"No treatment plan selected." G EXIT
  1.  S APCDTPN=+Y I 'APCDTPN K APCDTP,VALMY,XQORNOD W !,"No treatment plan selected." G EXIT
  1.  S APCDTP=$O(APCDPTP("IDX",APCDTPN,0)) I 'APCDTP K APCDTDEL,APCDTP D PAUSE,EXIT Q
  1.  S APCDTP=APCDPTP("IDX",APCDTPN,APCDTP) I 'APCDTP K APCDTP D PAUSE,EXIT Q
  1.  I '$D(^AUPNTP(APCDTP,0)) W !,"Not a valid TREATMENT PLAN." K APCDTDEL,APCDTP D PAUSE,EXIT Q
  1.  D FULL^VALM1
  1.  D DIQ^XBLM(9000094,APCDTP) K DIC,DA
  1.  D EXIT
  1.  Q
  1. REV ;EP
  1.  NEW APCDTP,APCDTPN,APCDTRP
  1.  K DIR S DIR(0)="N^1:"_APCDRCNT_":0",DIR("A")="Select Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) W !,"No treatment plan selected." G EXIT
  1.  S APCDTPN=+Y I 'APCDTPN K APCDTP,VALMY,XQORNOD W !,"No treatment plan selected." G EXIT
  1.  S APCDTP=$O(APCDPTP("IDX",APCDTPN,0)) I 'APCDTP K APCDTP D PAUSE,EXIT Q
  1.  S APCDTP=APCDPTP("IDX",APCDTPN,APCDTP) I 'APCDTP K APCDTP D PAUSE,EXIT Q
  1.  I '$D(^AUPNTP(APCDTP,0)) W !,"Not a valid TREATMENT PLAN." K APCDTDEL,APCDTP D PAUSE,EXIT Q
  1.  D FULL^VALM1
  1.  W:$D(IOF) @IOF
  1. REV1 ;
  1.  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
  1.  I $D(DIRUT) D EXIT Q
  1.  I Y="E" D EDT G REV1
  1.  I Y="D" D DIQ^XBLM(9000094,APCDTP) K DIC,DA D FULL^VALM1 G REV1
  1.  I Y="X" D EXIT Q
  1.  W !!,"Reviews currently on file:"
  1.  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)
  1.  W !
  1.  S APCDTRP=$P(^AUPNTP(APCDTP,0),U,7)
  1.  S DA=APCDTP,DIE="^AUPNTP(",DR="[APCD TP REVIEW]",DIE("NO^")=1 D ^DIE K DIE,DR,DA
  1.  D EXIT
  1.  Q
  1. DISC ;EP
  1.  NEW APCDTP,APCDTPN,APCDTRP
  1.  K DIR S DIR(0)="N^1:"_APCDRCNT_":0",DIR("A")="Select Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) W !,"No treatment plan selected." G EXIT
  1.  S APCDTPN=+Y I 'APCDTPN K APCDTP,VALMY,XQORNOD W !,"No treatment plan selected." G EXIT
  1.  S APCDTP=$O(APCDPTP("IDX",APCDTPN,0)) I 'APCDTP K APCDTP D PAUSE,EXIT Q
  1.  S APCDTP=APCDPTP("IDX",APCDTPN,APCDTP) I 'APCDTP K APCDTP D PAUSE,EXIT Q
  1.  I '$D(^AUPNTP(APCDTP,0)) W !,"Not a valid TREATMENT PLAN." K APCDTDEL,APCDTP D PAUSE,EXIT Q
  1.  D FULL^VALM1
  1.  W:$D(IOF) @IOF
  1. DISC1 ;
  1.  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
  1.  I $D(DIRUT) D EXIT Q
  1.  I Y="E" D EDT G DISC1
  1.  I Y="D" D DIQ^XBLM(9000094,APCDTP) D FULL^VALM1 K DIC,DA G DISC1
  1.  I Y="X" D EXIT Q
  1.  W !
  1.  S APCDTRP=$P(^AUPNTP(APCDTP,0),U,7)
  1.  S DA=APCDTP,DIE="^AUPNTP(",DR="[APCD TP DISCONTINUED]",DIE("NO^")=1 D ^DIE K DIE,DR,DA
  1.  D EXIT
  1.  Q
  1. DELETE ;EP
  1.  NEW APCDTP,APCDTPN
  1.  K DIR S DIR(0)="N^1:"_APCDRCNT_":0",DIR("A")="Select Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) W !,"No treatment plan selected." G EXIT
  1.  S APCDTPN=+Y I 'APCDTPN K APCDTP,VALMY,XQORNOD W !,"No treatment plan selected." G EXIT
  1.  S APCDTP=$O(APCDPTP("IDX",APCDTPN,0)) I 'APCDTP K APCDTDEL,APCDTP D PAUSE,EXIT Q
  1.  S APCDTP=APCDPTP("IDX",APCDTPN,APCDTP) I 'APCDTP K APCDTP D PAUSE,EXIT Q
  1.  I '$D(^AUPNTP(APCDTP,0)) W !,"Not a valid TREATMENT PLAN." K APCDTP D PAUSE,EXIT Q
  1.  D FULL^VALM1
  1. DEL ;
  1.  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
  1.  Q:$D(DIRUT)
  1.  Q:'Y
  1.  W !,"Deleting Treatment Plan..." S DA=APCDTP,DIK="^AUPNTP(" D ^DIK K DA,DIK
  1.  W !!,"Treatment Plan for ",$P(^DPT(DFN,0),U)," DELETED." D PAUSE
  1.  D EXIT
  1.  Q
  1. PAUSE ;EP
  1.  S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q
  1.  W:$D(IOF) @IOF
  1.  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)," ","-")
  1.  Q
  1. EXIT ;
  1.  D TERM^VALM0
  1.  S VALMBCK="R"
  1.  D GATHER^APCDETP
  1.  S VALMCNT=APCDLINE
  1.  D HDR^APCDETP
  1.  Q