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

ADEGRL.m

Go to the documentation of this file. 
  1. ADEGRL ; IHS/HQT/MJL - DENTAL DATA ENTRY PT 1 ; [ 03/24/1999   9:04 AM ]
  1.  ;;6.0;ADE;;APRIL 1999
  1.  ;V4.31 ORIG 5-14-88
  1.  ;------->INITIALIZE
  1.  D INIT^ADEGRL0 G:'Y END
  1. ONE ;------->RESET CONSTANT VALUES
  1.  D RESET^ADEGRL1 G:Y<1 END
  1. TWO ;------->LOOK UP A PATIENT
  1.  W !!,"Press RETURN to change LOCATION of ENCOUNTER"
  1.  W !,?15,"-OR-"
  1.  D PTLOOK^ADEGRL1 G:Y<1 ONE
  1. THREE ;------->GET A VISIT DATE
  1.  D ^ADEGRL2 I Y<1 K ^ADEUTL("ADELOCK",ADEPAT) G TWO
  1. FOUR ;------->LOAD LOCAL VARIABLES WITH CURRENT VISIT DATA
  1.  D MOD
  1. FIVE ;------->COLLECT VISIT INFO
  1.  D ^ADEGRL3
  1. SIX ;------->WRITE DATA TO DISK
  1.  D ^ADEGRL6
  1. SEVEN ;------->GET ANOTHER PATIENT
  1.  K ADETCH,ADETCHF G TWO
  1. END ;EP
  1.  S:$D(ADEDUZ(2)) DUZ(2)=ADEDUZ(2) ;IHS/MFD added set, U lookup IHS/HMW added condition
  1.  I $D(^ADEUTL($J,"DUZ2")) S DUZ(2)=^ADEUTL($J,"DUZ2")
  1.  K ^ADEUTL($J,"DUZ2")
  1.  K ADE,ADECNT,ADECOD,ADECON,ADED0,ADEDEF,ADEDEL,ADEDENT,ADEDES,ADEDFN,ADEDIC,ADEDICS,ADEDIR,ADEDUP,ADEFAC,ADEFACD,ADEFAST,ADEFEE,ADEFLG,ADEHOLD
  1.  K ADEHRN,ADEI,ADEJ,ADEK,ADELIN,ADELN,ADELOE,ADELOED,ADEMOD,ADENEW,ADENEWPT,ADENEWVS,ADENOOP,ADENOTE,ADENOUPD,ADEODFN,ADEOP,ADEPAT,ADEPC,ADEPNM,ADEPRO
  1.  K ADEPROD,ADEPVNM,ADEPVNMD,ADEQTY,ADERDNM,ADERDNMD,ADEREB,ADEREP,ADEREPD,ADES,ADESTR,ADESVC,ADETCH,ADETCHF,ADETFE,ADETITL,ADETMP,ADEV,ADEVCNT,ADEVDATE
  1.  K ADEVDFN,ADEVFM,ADEVIS,ADEX,ADEY,ADEQUIT,ADELOCSI,ADELOCFC,ADEDUZ,AUPNLK("ALL")
  1.  Q
  1. MOD ;EP
  1.  I ADENEWVS S ADELOE=ADEFAC,ADEPVNM=ADEPRO,ADERDNM=ADEREP,ADELOED=ADEFACD,ADEPVNMD=ADEPROD,ADERDNMD=ADEREPD,ADENOTE="",ADETCH=0,ADETCHF=0
  1.  E  D LOAD(ADEDFN)
  1.  Q
  1. LOAD(ADEDFN) ;Given ADEDFN, loads local arrays with visit data
  1.  N ADEJ,ADEOP,ADEK,ADESFC,ADETFE,ADEX,ADEY,ADEZ,ADENONR,ADENOD
  1. MOD0 S ADEJ=0,ADEOP=""
  1. MOD1 S ADEJ=$O(^ADEPCD(ADEDFN,"ADA","B",ADEJ)) I ADEJ="" K ADECNT,ADEK,ADEOP G MOD4
  1.  G:'$D(^AUTTADA(ADEJ)) MOD1
  1.  S (ADECNT,ADEK,ADETFE)=0,ADEOP="",ADESFC="",ADENONR=""
  1. MOD2 S ADEK=$O(^ADEPCD(ADEDFN,"ADA","B",ADEJ,ADEK))
  1.  I ADEK="" S ADEK=$P(^AUTTADA(ADEJ,0),U),ADEV(ADEK)=ADECNT_U_ADEOP,ADEDES(ADEK)=$P(^AUTTADA(ADEJ,0),U,6) S:ADECON ADEV(ADEK)=ADEV(ADEK)_U_ADETFE S $P(ADEV(ADEK),U,4)=ADESFC,$P(ADEV(ADEK),U,5)=ADENONR G MOD1
  1.  S ADECNT=ADECNT+1
  1.  S ADENOD=^ADEPCD(ADEDFN,"ADA",ADEK,0)
  1. A I ADECON,'ADETFE S ADETFE=+$P(ADENOD,U,3)
  1.  S ADEX=$P(ADENOD,U,2)
  1.  S ADEZ=$P(ADENOD,U,5)
  1.  S $P(ADENONR,",",ADECNT)=ADEZ G:ADEX="" MOD2
  1. Z S ADEY=$P(ADENOD,U,4)
  1.  G:'$D(^ADEOPS(ADEX,88)) MOD2
  1.  S $P(ADEOP,",",ADECNT)=ADEX
  1.  S $P(ADESFC,",",ADECNT)=ADEY
  1.  G MOD2
  1. MOD4 ;------->Get Location, Provider, etc.
  1.  K ADELOE,ADEPVNM,ADERDNM,ADELOED,ADEPVNMD,ADERDNMD
  1.  I $P(^ADEPCD(ADEDFN,0),U,3)]"",$D(^DIC(4,$P(^ADEPCD(ADEDFN,0),U,3),0)) S ADELOE=$P(^(0),U),ADELOED=$P(^ADEPCD(ADEDFN,0),U,3)
  1.  S:'$D(ADELOE) (ADELOE,ADELOED)=""
  1.  I $P(^ADEPCD(ADEDFN,0),U,5)]"",$D(^DIC(16,$P(^ADEPCD(ADEDFN,0),U,5),0)) S ADEPVNM=$P(^(0),U),ADEPVNMD=$P(^ADEPCD(ADEDFN,0),U,5)
  1.  S:'$D(ADEPVNM) (ADEPVNM,ADEPVNMD)=""
  1.  I $P(^ADEPCD(ADEDFN,0),U,4)]"",$D(^DIC(16,$P(^ADEPCD(ADEDFN,0),U,4),0)) S ADERDNM=$P(^(0),U),ADERDNMD=$P(^ADEPCD(ADEDFN,0),U,4)
  1.  S:'$D(ADERDNM) (ADERDNM,ADERDNMD)=""
  1.  I $P(^ADEPCD(ADEDFN,0),U,7)]"" S ADENOTE=$P(^(0),U,7)
  1.  S:'$D(ADENOTE) ADENOTE=""
  1.  S ADETCHF=1,ADETCH=+$P(^ADEPCD(ADEDFN,0),U,8)
  1.  Q
  1. CHKQ S Y=1 Q:'$D(^ADEPOST)
  1.  I $O(^ADEPOST(0))&('$D(^ADEUTL("ADEDQUE"))) S Y=0 W !,*7,"ERROR DETECTED -- DENTAL RECORDS ARE IN THE QUEUE WHICH ARE NOT BEING",!,"POSTED.  CONTACT SITE MANAGER OR DENTAL HEADQUARTERS FOR ASSISTANCE BEFORE",!,"ENTERING MORE DATA" Q
  1.  S Y=1 Q