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

ADEGRL0.m

Go to the documentation of this file.
  1. ADEGRL0 ; IHS/HQT/MJL - DENTAL ENTRY PART 1.5 ;04:55 PM [ 03/24/1999 9:04 AM ]
  1. ;;6.0;ADE;;APRIL 1999
  1. INIT ;EP
  1. S Y=0
  1. I '$D(ADEDIR) S ADEDIR=1,ADECON=0
  1. I '$D(DUZ(2)) W !!,"SIGN-ON FACILITY NOT SET IN USER FILE. CONTACT SITE MANAGER" Q
  1. S ^ADEUTL($J,"DUZ2")=DUZ(2)
  1. D ^XBKVAR I '$D(DUZ(2))!(DUZ(2)="") W !,"DIVISION NOT SET IN USER FILE -- CONTACT SITE MANAGER OR ISC" Q
  1. I DUZ(2)=0 S DUZ(2)=+^AUTTSITE(1,0) ;Reset to RPMS SITE
  1. I '$D(^ADEPARAM(+^AUTTSITE(1,0),0)) D WARN(+^AUTTSITE(1,0)) Q
  1. I '$D(^ADEPARAM(DUZ(2),0)) D WARN(DUZ(2)) Q
  1. I '$P(^ADEPARAM(DUZ(2),0),U)!($P(^(0),U,2)="")!($P(^(0),U,4)="")!($P(^(0),U,5)="")!($P(^(0),U,6)="")!('$P(^(0),U,7))!('$P(^(0),U,8))!($P(^(0),U,9)="") D WARN(DUZ(2)) Q
  1. I $P(^AUTTSITE(1,0),U,13)="" W !,*7,"UNIVERSAL LOOKUP FOR VISITS field in the RPMS SITE file",!,"has no entry. Contact your site manager." Q
  1. I '$D(DUZ(0)) W !,"FileMan Access Undefined. Contact site manger." Q
  1. I DUZ(0)'="@",DUZ(0)'["M"!(DUZ(0)'["[") W !,"FileMan Access denied. Contact site manager." Q
  1. K ADELIN S ADEFAST=0,$P(ADELIN,"-",79)=""
  1. S Y=1
  1. Q
  1. UNIV(ADEFACD) ;EP - Returns 0 if local facility has no entry in UNIVERSAL LOOKUP
  1. ;;otw, returns 1 and resets DUZ(2) to dfn of Local Facility
  1. ;S Y=0
  1. ;S ADEDUZ(2)=DUZ(2),ADETMP=DUZ(2)
  1. N ADEDFN,ADESITE
  1. S ADESITE=+^AUTTSITE(1,0)
  1. I '$D(^ADEPARAM("AB",ADEFACD)) D WARN(ADEFACD) Q 0
  1. I '$D(^ADEPARAM("AB",ADEFACD,ADESITE)) D WARN(ADEFACD) Q 0
  1. S ADEDFN=$O(^ADEPARAM("AB",ADEFACD,ADESITE,0))
  1. I $P(^ADEPARAM(ADESITE,1,ADEDFN,0),U,2)']"" W !,*7,"UNIVERSAL LOOKUP field value for this local facility not entered." Q 0
  1. K AUPNLK("ALL")
  1. I $P(^ADEPARAM(ADESITE,1,ADEDFN,0),U,2) S AUPNLK("ALL")=""
  1. S DUZ(2)=ADEFACD
  1. Q 1
  1. ;
  1. WARN(ADEFACD) ;
  1. W *7,!!,"Dental Site Parameter File has not been set up properly or fully"
  1. I ADEFACD]"",$D(^AUTTLOC(ADEFACD,0)) W !,"for ",$P(^AUTTLOC(ADEFACD,0),U,2)
  1. W ".",!,"Consult the DDS Documentation, the Help Frames, or your Site Manager.",!!
  1. H 1
  1. Q