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

AMHLEIN.m

Go to the documentation of this file. 
  1. AMHLEIN ; IHS/CMI/LAB - INITIALIZE AND SET UP PARAMETERS ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
  1.  ;
  1.  ;ss/mh narratives
  1.  ;
  1.  ;
  1. START ;EP - called from AMHLE
  1.  I '$D(IOF) D HOME^%ZIS
  1.  S AMHDASH="-------------------------------------------------------------------------------"
  1.  S APCDOVRR="" ;FOR PROVIDER NARRATIVE LOOKUP
  1.  S AMHLEIN="" ;variable to let system know we're in BH DE
  1.  S AMHBEEP=$C(7)_$C(7)
  1.  I '$G(DUZ(2)) W !!,AMHBEEP,AMHBEEP,"Site not set in DUZ(2) - please login to Kernel first!!" S AMHQUIT=1 Q
  1.  I $G(^AMHSITE(DUZ(2),0))="" W !!,AMHBEEP,AMHBEEP,"Site Parameter file not established for this Location ",$P(^DIC(4,DUZ(2),0),U),".",!,"NOTIFY S MANAGER.  CANNOT CONTINUE." S AMHQUIT=1 Q
  1. PCCCHECK ;check to see if link to pcc active, set AMHLPCC IF SO
  1.  K AMHLPCC
  1.  S (AMHLPCC,AMHLPCCT)=$P(^AMHSITE(DUZ(2),0),U,12) I AMHLPCC S AMHLPCC=AMHLPCC-1
  1.  I AMHLPCC="" W !,AMHBEEP,AMHBEEP,"PCC Link Type NOT defined in BH Site Parameter file.",!,"No PCC LINK will OCCUR!!  NOTIFY SYSTEM ADMINISTRATOR",! S AMHLPCC=0
  1.  Q:'AMHLPCC
  1.  I $D(^AUTTSITE(1,0)),$P(^(0),U,8)="Y",'$D(^APCCCTRL(DUZ(2),0))#2 W !,$C(7),"ENTRY MUST BE MADE IN THE PCC MASTER CONTROL FILE FOR THIS LOCATION",!,"PLEASE NOTIFY YOUR S MANAGER ... NO LINKAGE TO PCC IS OCCURRING !" H 5 S AMHLPCC=0
  1.  S AMHPKG=$O(^DIC(9.4,"C","AMH",""))
  1.  I '$D(^APCCCTRL(DUZ(2),11,AMHPKG,0))#2 W !,$C(7),"ENTRY MUST BE MADE IN THE PCC MASTER CONTROL FILE FOR THIS PACKAGE !",!,"PLEASE NOTIFY YOUR S MANAGER ... NO LINKAGE TO PCC IS OCCURRING !"  S AMHLPCC=0 H 4
  1.  I $D(^AUTTSITE(1,0)),$P(^(0),U,8)="Y",$D(^APCCCTRL(DUZ(2),0))#2,$D(^APCCCTRL(DUZ(2),11,AMHPKG,0))#2,$P(^(0),U,2) S AMHLPCC=AMHLPCC
  1.  E  S AMHLPCC=0
  1.  K AMHPKG
  1.  Q
  1. CALLDIE ;EP
  1.  Q:'$D(DA)
  1.  Q:'$D(DIE)
  1.  K DIV,DIU,DIY,DIW,DIG,DIH
  1.  NEW AMHG S AMHG=DIE_DA_")" L +(@AMHG):10 E  W !!,"Can't lock global",! Q
  1.  Q:'$D(DR)
  1.  D ^DIE
  1.  L -(@AMHG):10
  1.  K DIE,DIC,DR,DA,D0,D,D1,DO,%X,%Y,X,A,Z,DIU,DIV,DIY,DIW,DIADD,DLAYGO,%,%E,%D,%W,DI,DIFLD,DIG,DIH,DK,DL,DISYS,AMHG
  1.  Q
  1. PAUSE ;EP
  1.  Q:$E(IOST)'="C"!(IO'=IO(0))
  1.  W ! S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q
  1. DONE ;ENTRY POINT - END OF REPORT TIME DISPLAY
  1.  I $D(AMHET) S AMHTS=(86400*($P(AMHET,",")-$P(AMHBT,",")))+($P(AMHET,",",2)-$P(AMHBT,",",2)),AMHH=$P(AMHTS/3600,".") S:AMHH="" AMHH=0 D
  1.  .S AMHTS=AMHTS-(AMHH*3600),AMHM=$P(AMHTS/60,".") S:AMHM="" AMHM=0 S AMHTS=AMHTS-(AMHM*60),AMHS=AMHTS W !!,"RUN TIME (H.M.S): ",AMHH,".",AMHM,".",AMHS
  1.  I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report.  PRESS ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  W:$D(IOF) @IOF
  1.  K AMHTS,AMHS,AMHH,AMHM,AMHET
  1.  D ^AMHEKL
  1.  Q
  1. GETCOMM(S,P,F) ;EP  - return default community
  1.  NEW AMHX
  1.  I $G(F)="" S F="I"
  1.  S AMHX="" I "MSCO"'[P Q AMHX
  1.  I '$D(^AMHSITE(S,0)) Q AMHX
  1.  S AMHX=$S(P="M":$P(^AMHSITE(S,0),U,6),P="C":$P(^AMHSITE(S,0),U,29),P="S":$P(^AMHSITE(S,0),U,21),1:$P($G(^AMHSITE(S,18)),U,2))
  1.  I F="I"!(AMHX="") Q AMHX
  1.  ;I F="E" S AMHX=$P(^AUTTCOM(AMHX,0),U)
  1.  I F="E" S AMHX="`"_AMHX
  1.  Q AMHX
  1. GETTOC(S,F) ;EP - return default type of visit
  1.  I $G(F)="" S F="I"
  1.  I '$D(^AMHSITE(S,0)) Q ""
  1.  Q $S(F="I":$P(^AMHSITE(S,0),U,9),1:$$VAL^XBDIQ1(9002013,S,.09))
  1. GETAWI(S,F) ;EP - return default appt/wi
  1.  I $G(F)="" S F="I"
  1.  I '$D(^AMHSITE(S,0)) Q ""
  1.  Q $S(F="I":$P(^AMHSITE(S,0),U,24),1:$$VAL^XBDIQ1(9002013,S,.24))
  1. GETLOC(S,P,F) ;EP - return default location
  1.  NEW AMHX
  1.  S AMHX="" I "MSCO"'[P Q AMHX
  1.  I $G(F)="" S F="I"
  1.  I '$D(^AMHSITE(S,0)) Q AMHX
  1.  S AMHX=$S(P="M":$P(^AMHSITE(S,0),U,5),P="C":$P(^AMHSITE(S,0),U,28),P="S":$P(^AMHSITE(S,0),U,19),1:$P($G(^AMHSITE(S,18)),U,1))
  1.  I F="I" Q AMHX
  1.  I AMHX="" Q AMHX
  1.  I F="E" S AMHX=$P(^DIC(4,AMHX,0),U)
  1.  Q AMHX
  1. ASKINT(S) ;EP return 1 if should ask interpretor
  1.  NEW AMHX
  1.  S AMHX=""
  1.  I '$D(^AMHSITE(S,0)) Q AMHX
  1.  S AMHX=$P(^AMHSITE(S,0),U,11)
  1.  Q AMHX
  1. UNIVSITE(AMHSITE) ;EP return U or S
  1.  NEW AMHX
  1.  S AMHX=""
  1.  I '$D(^AMHSITE(AMHSITE,0)) Q AMHX
  1.  S AMHX=$P(^AMHSITE(AMHSITE,0),U,15)
  1.  Q AMHX
  1. ASKCC(AMHSITE) ;EP return 1 or 0 if should ask chief complaint
  1.  NEW AMHX
  1.  S AMHX=""
  1.  I '$D(^AMHSITE(AMHSITE,0)) Q AMHX
  1.  S AMHX=$P(^AMHSITE(AMHSITE,0),U,16)
  1.  Q AMHX
  1. GETCLN(S,P,F) ;EP return default clinic
  1.  NEW AMHX
  1.  S AMHX=""
  1.  I $G(P)="" Q AMHX
  1.  I $G(F)="" S F="I"
  1.  S AMHX="" I "MSCO"'[P Q AMHX
  1.  I '$D(^AMHSITE(S,0)) Q AMHX
  1.  S AMHX=$S(P="M":$P(^AMHSITE(S,0),U,17),P="C":$P(^AMHSITE(S,0),U,31),P="S":$P(^AMHSITE(S,0),U,22),1:$P($G(^AMHSITE(S,18)),U,3))
  1.  I AMHX="" Q AMHX
  1.  I F="I" Q AMHX
  1.  S AMHX=$P(^DIC(40.7,AMHX,0),U)
  1.  Q AMHX
  1. ASKPCC(AMHSITE) ;EP ask about pcc problem list?
  1.  NEW AMHX
  1.  S AMHX=""
  1.  I '$D(^AMHSITE(AMHSITE,0)) Q AMHX
  1.  S AMHX=$P(^AMHSITE(AMHSITE,0),U,18)
  1.  Q AMHX
  1. MHNARR(AMHSITE) ;EP get mh default narrative
  1.  NEW AMHX
  1.  S AMHX=""
  1.  I '$D(^AMHSITE(AMHSITE,0)) Q AMHX
  1.  S AMHX=$P(^AMHSITE(AMHSITE,0),U,14)
  1.  Q AMHX
  1. CDNARR(AMHSITE) ;EP
  1.  NEW AMHX
  1.  S AMHX=""
  1.  I '$D(^AMHSITE(AMHSITE,12)) Q AMHX
  1.  S AMHX=$P(^AMHSITE(AMHSITE,12),U,2)
  1.  Q AMHX
  1. OTNARR(AMHSITE) ;EP
  1.  NEW AMHX
  1.  S AMHX=""
  1.  I '$D(^AMHSITE(AMHSITE,12)) Q AMHX
  1.  S AMHX=$P(^AMHSITE(AMHSITE,12),U,3)
  1.  Q AMHX
  1. SSNARR(AMHSITE) ;EP get mh default narrative
  1.  NEW AMHX
  1.  S AMHX=""
  1.  I '$D(^AMHSITE(AMHSITE,12)) Q AMHX
  1.  S AMHX=$P(^AMHSITE(AMHSITE,12),U)
  1.  Q AMHX
  1.  ;ss/mh narratives
  1. C(X,X2,X3) ;EP
  1.  D COMMA^%DTC
  1.  Q $$STRIP^XLFSTR(X," ")
  1.  ;
  1. D(D) ;EP
  1.  I $G(D)="" Q ""
  1.  Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
  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. EOP ;EP - End of page.
  1.  Q:$E(IOST)'="C"
  1.  Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
  1.  NEW DIR
  1.  K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  S DIR("A")="End of report.  Press Enter",DIR(0)="E" D ^DIR
  1.  Q
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1.  ;----------