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

ADEDX.m

Go to the documentation of this file. 
  1. ADEDX ; IHS/HQT/MJL  - DENTAL PKG DIAGNOSTICS ;12:47 PM  [ 03/24/1999   9:04 AM ]
  1.  ;;6.0;ADE;;APRIL 1999
  1.  ;
  1.  ;Enter at top to run entire diagnostic set
  1.  ;Enter at specific labels to run a particular component
  1.  S ZTRTN="ALL^ADEDX"
  1.  D INIT
  1.  I POP!($D(IO("Q"))) G END
  1. ALL ;EP
  1.  D HX G END:ADEQIT
  1.  D BK G END:ADEQIT
  1.  D EX
  1.  G END
  1.  ;
  1. HISTORY ;EP Enter here to get installation history & status
  1.  S ZTRTN="HX^ADEDX"
  1.  D INIT
  1.  I POP!($D(IO("Q"))) G END
  1.  D HX
  1.  G END
  1.  ;
  1. BKGRND ;EP Enter here for status of background processor
  1.  S ZTRTN="BK^ADEDX"
  1.  D INIT
  1.  I POP!($D(IO("Q"))) G END
  1.  D BK
  1.  G END
  1.  ;
  1. EXTRACT ;EP Enter here to get extract log & count of unextracted records
  1.  S ZTRTN="EX^ADEDX"
  1.  D INIT
  1.  I POP!($D(IO("Q"))) G END
  1.  D HX
  1.  G END
  1.  ;
  1. HX ;EP
  1.  D EOP Q:ADEQIT
  1.  W !!,"[INSTALLATION HISTORY AND CURRENT STATUS]",!
  1.  D PKG Q:ADEQIT
  1.  D ENTRIES Q:ADEQIT
  1.  ;Get current DENTAL SITE PARAMETER settings
  1.  D PARAM
  1.  ;Check that bulletins are assigned to groups & get names in group
  1.  Q
  1.  ;
  1. BK D DQRUN
  1.  Q
  1.  ;
  1. EX ;Get extract log
  1.  ;Count unextracted entries
  1.  Q
  1. END ;
  1.  D ^%ZISC
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  K ADECNT,ADEJN,ADEQIT,ADEMSG,ADELF,ADELIN,ADENOD,ADEPAG,ADEPKG,ADESN,ADEVER,ADEJ
  1.  Q
  1.  ;
  1. DQRUN D EOP Q:ADEQIT
  1.  W !!,"[DENTAL BACKGROUND PROCESSOR]",!
  1.  S (ADECNT,ADEJN)=0 I $D(^ADEUTL("ADELOCK")) F  S ADEJN=$O(^ADEUTL("ADELOCK",ADEJN)) Q:'+ADEJN  S ADECNT=ADECNT+1
  1.  W !,$S(ADECNT=0:"No",1:ADECNT)," dental patient record(s) flagged as 'awaiting update'."
  1.  S (ADECNT,ADEJN)=0 I $D(^ADEPOST(0)) F  S ADEJN=$O(^ADEPOST(ADEJN)) Q:'+ADEJN  S ADECNT=ADECNT+1
  1.  D EOP Q:ADEQIT
  1.  W !,$S(ADECNT=0:"No",1:ADECNT)," dental visit record(s) queued in the ADEPOST global."
  1.  I ADECNT>0 W !,"^ADEPOST(0)=",^ADEPOST(0)
  1.  S ADEMSG="0^No dental background job running according to KERNEL."
  1.  S ADEJN=0 F  S ADEJN=$O(^XUTL("XQ",ADEJN)) Q:'+ADEJN  I $D(^XUTL("XQ",ADEJN,"ZTSK")),^XUTL("XQ",ADEJN,"ZTSK")="DENTAL DISC WRITES" D DQ1 Q
  1.  D EOP Q:ADEQIT
  1.  W !,$P(ADEMSG,U,2)
  1.  I '+ADEMSG,$D(^ADEUTL("ADEDQUE")) D DQ2
  1.  Q
  1. DQ1 S ADEMSG="1^Dental background job running as Job# "_ADEJN
  1.  I $D(^XUTL("XQ",ADEJN,0)) S Y=^XUTL("XQ",ADEJN,0) X ^DD("DD") S ADEMSG=ADEMSG_". Start time was "_Y
  1.  Q
  1. DQ2 W !!,"***It appears that the dental background routine is NOT running",!,"but that the dental package THINKS that it is.  To remedy, execute the",!,"EBAK option in the DEO submenu of the Dental Supervisor's menu.***"
  1.  Q
  1. PKG D EOP Q:ADEQIT
  1.  ;W !,"RPMS SITE: ",$P(^DIC(4,$O(^AUTTSITE(0)),0),U)
  1.  W !,"RPMS SITE: ",$P(^DIC(4,$P(^AUTTSITE($O(^AUTTSITE(0)),0),U),0),U)
  1.  S ADEPKG=$O(^DIC(9.4,"B","IHS DENTAL",0))
  1.  I '+ADEPKG W !,"No entry in PACKAGE file for IHS DENTAL" Q
  1.  D EOP Q:ADEQIT
  1.  W !,"CURRENT IHS DENTAL VERSION: ",$P(^DIC(9.4,ADEPKG,"VERSION"),U)
  1.  I '$D(^DIC(9.4,ADEPKG,22)) W !,"No Installation history in PACKAGE file" Q
  1.  D EOP Q:ADEQIT
  1.  W !,"INSTALLATION HISTORY--",!?5,"VERSION",?20,"DATE INSTALLED"
  1.  S ADEVER=0 F  S ADEVER=$O(^DIC(9.4,ADEPKG,22,ADEVER)) Q:'+ADEVER  D PKG1 D EOP Q:ADEQIT
  1.  Q
  1. PKG1 Q:'$D(^DIC(9.4,ADEPKG,22,ADEVER,0))
  1.  S ADENOD=^DIC(9.4,ADEPKG,22,ADEVER,0)
  1.  W !?5,$P(ADENOD,U)
  1.  Q:'+$P(ADENOD,U,3)
  1.  S Y=$P(ADENOD,U,3) X ^DD("DD") W ?20,Y
  1.  Q
  1. ENTRIES ;
  1.  D EOP Q:ADEQIT
  1.  W !!,"The DENTAL PROCEDURE File global (^ADEPCD) has ",$P(^ADEPCD(0),U,4)," entries."
  1.  W !,"The first visit date in ADEPCD is "
  1.  S Y=$O(^ADEPCD("AC",0))
  1.  X ^DD("DD")
  1.  W Y,"."
  1.  Q
  1. PARAM ;
  1.  D EOP Q:ADEQIT
  1.  W !!,"DENTAL SITE PARAMETER FILE"
  1.  S ADESN=$O(^ADEPARAM(0))
  1.  I '+ADESN W " HAS NOT BEEN SET UP!" Q
  1.  S ADENOD=^ADEPARAM(ADESN,0)
  1. PA W !?5,"DENTAL SITE NAME:   ",$P(^DIC(4,$P(ADENOD,U),0),U)
  1.  W !?5,"LIMITED DATA ENTRY: ",$P(ADENOD,U,2) D EOP Q:ADEQIT
  1.  W !?5,"BACKGROUND MODE:    ",$P(ADENOD,U,4) D EOP Q:ADEQIT
  1.  W !?5,"PCC LINK ENABLED:   ",$P(ADENOD,U,5) D EOP Q:ADEQIT
  1.  W !?5,"EXTRACT CONTRACT:   ",$P(ADENOD,U,6) D EOP Q:ADEQIT
  1.  W !?5,"LOCAL FACILITIES:"
  1.  S ADELF=0 F  S ADELF=$O(^ADEPARAM(ADESN,1,ADELF)) Q:'+ADELF  D PAR1,EOP Q:ADEQIT
  1.  Q
  1. PAR1 S ADENOD=^ADEPARAM(ADESN,1,ADELF,0)
  1.  W !?10,$P(^DIC(4,$P(ADENOD,U),0),U)," (Universal Lookup ",$S($P(ADENOD,U,2)'=1:"not",1:"")," allowed.)"
  1.  Q
  1. INIT ;
  1.  S U="^",ADEPAG=1,$P(ADELIN,"-",79)="",ADEQIT=0
  1.  ;
  1. ASKDEV S %ZIS="Q" D ^%ZIS Q:POP
  1.  I $D(IO("Q")) D QUE W !,"REQUEST QUEUED." Q
  1.  U IO
  1.  Q
  1.  ;
  1. QUE S ZTDESC="DENTAL SOFTWARE DIAGNOSTICS"
  1.  F ADEJ="ADEPAG","ADELIN","ADEQIT" S ZTSAVE(ADEJ)=""
  1.  D ^%ZTLOAD
  1.  K ADEJ
  1.  Q
  1.  ;
  1. EOP I ADEPAG=1 D HEADER Q
  1.  Q:$Y'>(IOSL-5)
  1. EOP1 I $P(IOST,"-")["C" S DIR(0)="E" D ^DIR I 'Y!($D(DTOUT)) S ADEQIT=1 Q
  1.  D HEADER
  1.  Q
  1.  ;
  1. LINE W ?(IOM\2)-($L("DENTAL SOFTWARE DIAGNOSTICS -- Page "_ADEPAG)\2),"DENTAL SOFTWARE DIAGNOSTICS -- Page "_ADEPAG,!
  1.  S ADEPAG=ADEPAG+1
  1.  Q