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

AMHLEIC.m

Go to the documentation of this file.
  1. AMHLEIC ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;
  1. ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
  1. ;
  1. ;info/contact RDE mode
  1. IC ;EP
  1. D HEADER^AMHLEA
  1. W !,"Entering Info/Contact Record type",!
  1. I '$D(AMHPATCE) K AMHPAT
  1. W !,"Creating new record..." K DD,D0,DO,DINUM,DIC,DA,DR S DIC(0)="EL",DIC="^AMHREC(",DLAYGO=9002011,DIADD=1,X=AMHDATE,DIC("DR")="1111////1" D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
  1. I Y=-1 W !!,$C(7),$C(7),"Behavioral Health Record is NOT complete!! Deleting Record.",! D PAUSE Q
  1. S AMHR=+Y,DIE="^AMHREC(",DA=AMHR,DR="5100///NOW",DR(2,9002011.5101)=".02////^S X=DUZ" D ^DIE K DIE,DA,DR
  1. D GETPROV ;get primary provider
  1. I '$$PPINT^AMHUTIL(AMHR) W !,"No PRIMARY PROVIDER entered!! - Required element" D DEL^AMHLEA Q
  1. D GETPAT^AMHLEA D:'$G(AMHPAT) DEL^AMHLEA Q:'$G(AMHPAT) S DA=AMHR,DR=".08////"_AMHPAT,DIE="^AMHREC(" D CALLDIE^AMHLEIN
  1. W ! S DIE="^AMHREC(",DR="3101INFORMATION",DA=AMHR D CALLDIE^AMHLEIN
  1. D ^AMHLEPOV
  1. I '$D(^AMHRPRO("AD",AMHR)) W !!,"No Purpose of Visit.. Incomplete record!! Deleting record!!" D DEL^AMHLEA Q
  1. S DIE("NO^")="",DA=AMHR,DIE="^AMHREC(",DR="[AMH ADD INFO/CONTACT]" D CALLDIE^AMHLEIN
  1. S AMHOKAY=0 D RECCHECK^AMHLE2 I AMHOKAY W !,"Incomplete record!! Deleting record!!" D DEL^AMHLEA Q
  1. D REGULAR^AMHLEP2
  1. I $P(^AMHREC(AMHR,0),U,8)]"" D OTHER^AMHLEA
  1. D PCCLINK^AMHLEA
  1. Q
  1. GETPROV ;get providers
  1. W !!
  1. K DIR,DIC,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR("B")=$P(^VA(200,DUZ,0),U),DIR(0)="9002011.02,.01O",DIR("A")="Enter PRIMARY PROVIDER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. Q:$D(DIRUT)
  1. Q:Y=""
  1. S X=+Y,DIC("DR")=".02////"_$G(AMHPAT)_";.03////"_AMHR_";.04///PRIMARY",DIC="^AMHRPROV(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.02 K DD,DO D FILE^DICN K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
  1. I Y=-1 W !!,"Creating Primary Provider entry failed!!!",$C(7),$C(7) H 2
  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