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