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

AMHDPEE.m

Go to the documentation of this file. 
  1. AMHDPEE ; IHS/CMI/LAB - BROWSE VISITS ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
  1.  ;
  1.  ;
  1. START ;
  1.  NEW AMHX,AMHY,AMHR0,DFN,AUPNPAT,AUPNDOB,AUPNDOD,AUPNDAYS,AUPNSEX,AMHV,AMHBD,AMHED
  1.  NEW D,R
  1.  K AMHV
  1.  W:$D(IOF) @IOF
  1.  W $$CTR("View/Update Designated Provider List",80)
  1. PROV ;
  1.  D ^XBFMK
  1.  S AMHDP=""
  1.  W !! S DIC("A")="Enter Designated Provider Name: ",DIC="^VA(200,",DIC(0)="AEMQ",DIC("B")=$P(^VA(200,DUZ,0),U) D ^DIC K DIC,DA,DR,DLAYGO,DIADD
  1.  I Y<0 W !,"No Provider Selected." Q
  1.  S AMHPROV=+Y
  1. DEMO ;
  1.  D DEMOCHK^AMHUTIL1(.AMHDEMO)
  1.  I AMHDEMO=-1 G PROV
  1.  D EN
  1. END ;
  1.  D EOJ
  1.  K AMHP,AMHQUIT,AMHW
  1.  Q
  1.  ;
  1. EN ; -- main entry point for AMH UPDATE PATIENT CASE DATA
  1.  D EN^VALM("AMH VIEW/UPDATE DP LIST")
  1.  K AMHCASE,AMHX,AMHD,AMHRCNT,AMHLINE,AMHCDATE
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  S VALMHDR(1)=$TR($J(" ",80)," ","-")
  1.  S VALMHDR(2)="Patients with Designated Provider: "_IORVON_$P(^VA(200,AMHPROV,0),U)_IOINORM
  1.  S VALMHDR(3)=$TR($J(" ",80)," ","-")
  1.  S VALMHDR(4)="#    HRN    PATIENT NAME              DOB          SEX LAST VISIT    PROV TYPE"
  1.  Q
  1.  ;
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. LVD(P,I) ;EP
  1.  I $G(I)="" S I="D"
  1.  I '$G(P) Q ""
  1.  NEW D,A,B,C,G
  1.  S G="",A=0 F  S A=$O(^AMHREC("AE",P,A)) Q:A'=+A!(G)  D
  1.  .S (B,F)=0 F  S B=$O(^AMHREC("AE",P,A,B)) Q:B'=+B!(G)  D
  1.  ..Q:'$D(^AMHREC(B,0))
  1.  ..Q:'$$ALLOWVI^AMHUTIL(DUZ,B)
  1.  ..S (F,C)=0 F  S C=$O(^AMHRPRO("AD",B,C)) Q:C'=+C  D
  1.  ...S E=$P(^AMHRPRO(C,0),U),E=$S(E:$P(^AMHPROB(E,0),U),1:"")
  1.  ...Q:E=""
  1.  ...Q:E<8!(E>8.99999)
  1.  ...S F=1 ;got a DNKA
  1.  ...Q
  1.  ..I 'F S G=B
  1.  ..Q
  1.  .Q
  1.  I 'G Q ""
  1.  I I="I" Q G
  1.  S D=$P($P(^AMHREC(G,0),U),".") I I="ID" Q D
  1.  Q $$FMTE^XLFDT(D)
  1. INIT ; -- init variables and list array
  1.  S VALMSG="?? for more actions  + next screen  - prev screen"
  1.  D GATHER ;gather up all records for display
  1.  S VALMCNT=AMHLINE
  1.  Q
  1.  ;
  1. GATHER ;
  1.  K ^TMP("AMHDPEE",$J),^TMP($J,"AMHDPEE")
  1.  S AMHD=0 F  S AMHD=$O(^AMHPATR("AMH",AMHPROV,AMHD)) Q:AMHD'=+AMHD  I '$$DEMO^AMHUTIL1(AMHD,$G(AMHDEMO)) S ^TMP($J,"AMHDPEE",$P(^DPT(AMHD,0),U),AMHD,1)=""
  1.  S AMHD=0 F  S AMHD=$O(^AMHPATR("ASS",AMHPROV,AMHD)) Q:AMHD'=+AMHD  I '$$DEMO^AMHUTIL1(AMHD,$G(AMHDEMO)) S ^TMP($J,"AMHDPEE",$P(^DPT(AMHD,0),U),AMHD,2)=""
  1.  S AMHD=0 F  S AMHD=$O(^AMHPATR("AOT",AMHPROV,AMHD)) Q:AMHD'=+AMHD  I '$$DEMO^AMHUTIL1(AMHD,$G(AMHDEMO)) S ^TMP($J,"AMHDPEE",$P(^DPT(AMHD,0),U),AMHD,3)=""
  1.  S AMHD=0 F  S AMHD=$O(^AMHPATR("AOTH",AMHPROV,AMHD)) Q:AMHD'=+AMHD  I '$$DEMO^AMHUTIL1(AMHD,$G(AMHDEMO)) S ^TMP($J,"AMHDPEE",$P(^DPT(AMHD,0),U),AMHD,4)=""
  1.  ;S AMHD=0 F  S AMHD=$O(^AMHPATR("AOP",AMHPROV,AMHD)) Q:AMHD'=+AMHD  S ^TMP($J,"AMHDPEE",$P(^DPT(AMHD,0),U),AMHD,5)=""
  1.  S AMHRCNT=0,AMHLINE=0
  1.  S AMHNAME=0 F  S AMHNAME=$O(^TMP($J,"AMHDPEE",AMHNAME)) Q:AMHNAME=""  D
  1.  .S AMHD=0 F  S AMHD=$O(^TMP($J,"AMHDPEE",AMHNAME,AMHD)) Q:AMHD'=+AMHD  D
  1.  ..S AMHT=0 F  S AMHT=$O(^TMP($J,"AMHDPEE",AMHNAME,AMHD,AMHT)) Q:AMHT'=+AMHT  D
  1.  ...S AMHRCNT=AMHRCNT+1,AMHLINE=AMHLINE+1,Y=AMHRCNT
  1.  ...S $E(Y,6)=$$HRN^AUPNPAT(AMHD,DUZ(2)),$E(Y,13)=$E($P(^DPT(AMHD,0),U),1,25),$E(Y,39)=$$DOB^AUPNPAT(AMHD,"E"),$E(Y,52)=$P(^DPT(AMHD,0),U,2),$E(Y,56)=$$LVD(AMHD)
  1.  ...S $E(Y,69)=$S(AMHT=1:"MENTAL HLTH",AMHT=2:"SOC SERV",AMHT=3:"CD/OTH",AMHT=4:"OTHER",AMHT=5:"OTHER 2",1:"")
  1.  ...S ^TMP("AMHDPEE",$J,AMHLINE,0)=Y,^TMP("AMHDPEE",$J,"IDX",AMHLINE,AMHRCNT)=AMHD
  1.  Q  ;new 
  1.  S AMHD=0 F  S AMHD=$O(^AMHPATR("ASS",AMHPROV,AMHD)) Q:AMHD'=+AMHD  D
  1.  .S AMHRCNT=AMHRCNT+1,AMHLINE=AMHLINE+1,Y=AMHRCNT
  1.  .S $E(Y,6)=$$HRN^AUPNPAT(AMHD,DUZ(2)),$E(Y,13)=$E($P(^DPT(AMHD,0),U),1,25),$E(Y,39)=$$DOB^AUPNPAT(AMHD,"E"),$E(Y,52)=$P(^DPT(AMHD,0),U,2),$E(Y,56)=$$LVD(AMHD),$E(Y,69)="SOC SERV"
  1.  .S ^TMP("AMHDPEE",$J,AMHLINE,0)=Y,^TMP("AMHDPEE",$J,"IDX",AMHLINE,AMHRCNT)=AMHD
  1.  S AMHD=0 F  S AMHD=$O(^AMHPATR("AOT",AMHPROV,AMHD)) Q:AMHD'=+AMHD  D
  1.  .S AMHRCNT=AMHRCNT+1,AMHLINE=AMHLINE+1,Y=AMHRCNT
  1.  .S $E(Y,6)=$$HRN^AUPNPAT(AMHD,DUZ(2)),$E(Y,13)=$E($P(^DPT(AMHD,0),U),1,25),$E(Y,39)=$$DOB^AUPNPAT(AMHD,"E"),$E(Y,52)=$P(^DPT(AMHD,0),U,2),$E(Y,56)=$$LVD(AMHD),$E(Y,69)="CD/OTH"
  1.  .S ^TMP("AMHDPEE",$J,AMHLINE,0)=Y,^TMP("AMHDPEE",$J,"IDX",AMHLINE,AMHRCNT)=AMHD
  1.  S AMHD=0 F  S AMHD=$O(^AMHPATR("AOTH",AMHPROV,AMHD)) Q:AMHD'=+AMHD  D
  1.  .S AMHRCNT=AMHRCNT+1,AMHLINE=AMHLINE+1,Y=AMHRCNT
  1.  .S $E(Y,6)=$$HRN^AUPNPAT(AMHD,DUZ(2)),$E(Y,13)=$E($P(^DPT(AMHD,0),U),1,25),$E(Y,39)=$$DOB^AUPNPAT(AMHD,"E"),$E(Y,52)=$P(^DPT(AMHD,0),U,2),$E(Y,56)=$$LVD(AMHD),$E(Y,69)="OTHER"
  1.  .S ^TMP("AMHDPEE",$J,AMHLINE,0)=Y,^TMP("AMHDPEE",$J,"IDX",AMHLINE,AMHRCNT)=AMHD
  1.  ;S AMHD=0 F  S AMHD=$O(^AMHPATR("AOP",AMHPROV,AMHD)) Q:AMHD'=+AMHD  D
  1.  ;.S AMHRCNT=AMHRCNT+1,AMHLINE=AMHLINE+1,Y=AMHRCNT
  1.  ;.S $E(Y,6)=$$HRN^AUPNPAT(AMHD,DUZ(2)),$E(Y,13)=$E($P(^DPT(AMHD,0),U),1,25),$E(Y,39)=$$DOB^AUPNPAT(AMHD,"E"),$E(Y,52)=$P(^DPT(AMHD,0),U,2),$E(Y,56)=$$LVD(AMHD),$E(Y,69)="OTH 2"
  1.  ;.S ^TMP("AMHDPEE",$J,AMHLINE,0)=Y,^TMP("AMHDPEE",$J,"IDX",AMHLINE,AMHRCNT)=AMHD
  1.  Q
  1. EDDP ;EP - called from protocol
  1.  D EN^VALM2(XQORNOD(0),"OS")
  1.  I '$D(VALMY) W !,"No records selected." G EXIT
  1.  S AMHR=$O(VALMY(0)) I 'AMHR K AMHR,VALMY,XQORNOD W !,"No record selected." G EXIT
  1.  S AMHR=^TMP("AMHDPEE",$J,"IDX",AMHR,AMHR) I 'AMHR K AMHRDEL,AMHR D PAUSE^AMHLEA D EXIT Q
  1.  I '$D(^AMHPATR(AMHR,0)) W !,"Not a valid PATIENT RECORD." K AMHRDEL,AMHR D PAUSE^AMHLEA D EXIT Q
  1.  D FULL^VALM1
  1.  W !,"Editing Designated Provider....."
  1.  S DA=AMHR,DIE="^AMHPATR(",DR=".02;.03;.04;.12;.13" D ^DIE
  1.  D EXIT
  1.  Q
  1. RMDP ;EP - called from protocol to remove DP entry
  1.  D EN^VALM2(XQORNOD(0),"OS")
  1.  I '$D(VALMY) W !,"No records selected." G EXIT
  1.  S AMHR=$O(VALMY(0)) I 'AMHR K AMHR,VALMY,XQORNOD W !,"No record selected." G EXIT
  1.  S AMHR=^TMP("AMHDPEE",$J,"IDX",AMHR,AMHR) I 'AMHR K AMHRDEL,AMHR D PAUSE^AMHLEA D EXIT Q
  1.  I '$D(^AMHPATR(AMHR,0)) W !,"Not a valid PATIENT RECORD." K AMHRDEL,AMHR D PAUSE^AMHLEA D EXIT Q
  1.  D FULL^VALM1
  1.  W !,"Removing ",$P(^VA(200,AMHPROV,0),U)," as Designated Provider for ",!,$P(^DPT($P(^AMHPATR(AMHR,0),U),0),U)," ..."
  1.  I $P(^AMHPATR(AMHR,0),U,2)=AMHPROV S DA=AMHR,DIE="^AMHPATR(",DR=".02///@" D ^DIE
  1.  I $P(^AMHPATR(AMHR,0),U,3)=AMHPROV S DA=AMHR,DIE="^AMHPATR(",DR=".03///@" D ^DIE
  1.  I $P(^AMHPATR(AMHR,0),U,4)=AMHPROV S DA=AMHR,DIE="^AMHPATR(",DR=".04///@" D ^DIE
  1.  I $P(^AMHPATR(AMHR,0),U,12)=AMHPROV S DA=AMHR,DIE="^AMHPATR(",DR=".12///@" D ^DIE
  1.  ;I $P(^AMHPATR(AMHR,0),U,13)=AMHPROV S DA=AMHR,DIE="^AMHPATR(",DR=".13///@" D ^DIE
  1. CD ;
  1.  S DIR(0)="Y",DIR("A")="Do you want to update the Case Status?",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) D EXIT Q
  1.  I 'Y D EXIT Q
  1.  D EP1^AMHLCD(AMHR)
  1.  D EXIT
  1.  Q
  1. BV ;
  1.  D ^AMHVD
  1.  D EXIT
  1.  Q
  1. HS ;EP called from protocol to generate hs
  1.  S DFN=""
  1.  S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DLAYGO,DIADD
  1.  I Y<0 W !,"No Patient Selected." Q
  1.  S DFN=+Y
  1.  S Y=DFN D ^AUPNPAT
  1.  I $G(AUPNDOD)]"" W !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!! H 2
  1.  D GETTYPE
  1.  I '$G(APCHSTYP) D EN^XBVK("APCH") Q
  1.  S APCHSPAT=DFN
  1.  S %="PCC Health Summary for "_$P(^DPT(APCHSPAT,0),U)
  1.  D VIEWR^XBLM("EN^APCHS",%)
  1.  D EN^XBVK("APCH") K AMCHDAYS,AMCHDOB,%
  1.  D EXIT
  1.  Q
  1. GETTYPE ;
  1.  I $G(^AMHSITE(DUZ(2),0))="" D DEFAULT Q
  1.  S APCHSTYP=$P(^AMHSITE(DUZ(2),0),U,4) I APCHSTYP="" D DEFAULT Q
  1.  I '$D(^APCHSCTL(APCHSTYP)) W !,"Error in Site Parameter File!",$C(7),$C(7) S APCHSTYP="" Q
  1.  Q
  1. DEFAULT ;
  1.  S APCHSTYP=""
  1.  S X="BEHAVIORAL HEALTH",DIC(0)="",DIC="^APCHSCTL(" D ^DIC K DIC,DA
  1.  I Y=-1 W !!,"PCC MENTAL HEALTH HEALTH SUMMARY TYPE IS MISSING!!  NOTIFY YOUR SUPERVISOR OR SITE MANAGER.",!! Q
  1.  S APCHSTYP=+Y
  1.  Q
  1. ADDDP ;EP called from protocol to open a new case
  1.  D FULL^VALM1
  1.  W:$D(IOF) @IOF
  1.  S AMHPAT=""
  1.  S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DLAYGO,DIADD
  1.  I Y<0 W !,"No Patient Selected." Q
  1.  S AMHPAT=+Y
  1.  I '$D(^AMHPATR(AMHPAT)) S DIC="^AMHPATR(",DIC(0)="L",DLAYGO=9002011.55,X="`"_AMHPAT D ^DIC I Y=-1 D ^XBFMK K DLAYGO,DIADD W !!,"FAILED TO ADD PATIENT TO MHSS PATIENT DATA FILE" Q
  1.  S DA=AMHPAT,DDSFILE=9002011.55,DR="[AMH PATIENT RELATED DATA]" D ^DDS
  1.  I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!!  ***NOTIFY PROGRAMMER***" S AMHQUIT=1 K DIMSG Q
  1.  D EXIT
  1.  Q
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K AMHX,AMHCASE,AMHPC,AMHR1,AMHPAT,DFN
  1.  D TERM^VALM0
  1.  S VALMBCK="R"
  1.  D GATHER
  1.  S VALMCNT=AMHLINE
  1.  D HDR
  1.  K X,Y,Z,I
  1.  Q
  1. EOJ ;
  1.  D EN^XBVK("AMH")
  1.  K DFN
  1.  K DDSFILE,DIPGM,Y
  1.  K X,Y,%,DR,DDS,DA,DIC
  1.  K AMHCASE,AMHX,AMHD,AMHRCNT,AMHLINE,AMHCDATE
  1.  D:$D(VALMWD) CLEAR^VALM1
  1.  K VALM,VALMHDR,VALMKEY,VALMMENU,VALMSGR,VALMUP,VALMWD,VALMLST,VALMVAR,VALMLFT,VALMBCK,VALMCC,VALMAR,VALMBG,VALMCAP,VALMCOFF,VALMCNT,VALMCON,BALMON,VALMEVL,VALMIOXY
  1.  D KILL^AUPNPAT
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. AV ;EP add visit
  1.  D FULL^VALM1
  1.  D GETPAT^AMHLEA
  1.  I 'AMHPAT W !,"NO Patient selected!",! D PAUSE^AMHLEA D EXIT Q
  1.  S DFN=AMHPAT
  1.  S AMHDPEEP=AMHPROV
  1.  D CONTACT^AMHLEP1(AMHPAT,1)
  1.  S AMHPROV=AMHDPEEP
  1.  D PAUSE^AMHLEA
  1.  D EXIT
  1.  Q