ADEPLV ; IHS/HQT/MJL - DENTAL LVL OF SVC ; [ 03/24/1999 9:04 AM ]
;;6.0;ADE;;APRIL 1999
S ADEGBL=$$ADEU("ADEPDIR")
S ADEGBL="^TMP(""ADEPDIR"","_ADEGBL_")"
S ADETITL=" -- Direct Indian" ;IHS/HMW ADEK Added "Indian"
S ADEDIR=1,ADECON=0,ADEPRO=4,ADEPDET=1,ADENON=0
;
START W !!,"Dental Level of Service Report",ADETITL,!!
D ^XBKVAR
;
DATE K ADEBDT,ADEND
S U="^",%DT="AXEP",%DT("A")="SELECT BEGINNING DATE: "
D ^%DT K %DT
G:Y<0 QUIT
S ADEBDT=Y,%DT="AXEP",%DT(0)=ADEBDT,%DT("A")="SELECT ENDING DATE: "
D ^%DT K %DT
G:X="^" DATE
G:Y<0 QUIT
S ADEND=Y_".9999"
I ADEBDT>ADEND W !,*7,"Beginning date must be before ending date." G DATE
;
ASKDEV K ADEIOP,IOP,ZTSK,ADEIOPAR
W !!,"Enter 'Q' at the DEVICE prompt to queue this report to run in the background."
S %ZIS="NQ"
D ^%ZIS
I POP L -@ADEGBL K @ADEGBL G QUIT ;@ADEGBL is a subscripted node
;of ^TMP, a transient report global
S ADEIOP=ION_";"_IOM_";"_IOSL
S ADEIOPAR=IOPAR
I $D(IO("Q")) D G QUIT
. D QUE
. L -@ADEGBL
. W !,"REQUEST QUEUED."
. D HOME^%ZIS
;
G START^ADEPLV1
;
QUIT K ADEOTYP,ADEBDT,ADEND,ADEOLD,ADEGBL,ADETITL,ADEDIR,ADECON,ADEJ,ADEPRO,ADEPDET,ADENON,ADEIOP,ADEIOPAR
Q
;
QUE N ADEJ
S ZTDESC="DENTAL LEVEL OF CARE RPT"
F ADEJ="ADEGBL","ADEND","ADEBDT","ADETITL","ADEDIR","ADECON","ADEPRO","ADEPDET","ADENON","ADEIOP","ADEIOPAR" S ZTSAVE(ADEJ)=""
S ZTRTN="START^ADEPLV1"
S ZTIO=""
I $D(IO("HFSIO")) D
. S ZTIO=ADEIOP
D ^%ZTLOAD
K ADEJ
Q
;
CONTRACT ;EP ENTER HERE FOR CONTRACT SERVICES REPORT
S ADEGBL=$$ADEU("ADEPCHS")
S ADEGBL="^TMP(""ADEPCHS"","_ADEGBL_")"
S ADETITL=" -- Contract"
S ADEDIR=0,ADECON=1,ADEPRO=4,ADEPDET=1,ADENON=0
G START
AUXIL ;EP ENTER HERE FOR AUXILIARY REPORT
S ADETITL=" -- Auxiliary"
S ADEGBL=$$ADEU("ADEPAUX")
S ADEGBL="^TMP(""ADEPAUX"","_ADEGBL_")"
S ADEDIR=0,ADECON=0,ADEPRO=5,ADEPDET=1,ADENON=0
G START
NON ;EP ENTER HERE FOR NON-INDIAN REPORT
S ADEGBL=$$ADEU("ADEPNON")
S ADEGBL="^TMP(""ADEPNON"","_ADEGBL_")"
S ADETITL=" -- Non-Indian"
S ADEDIR=0,ADECON=0,ADEPRO=4,ADEPDET=0,ADENON=1
G START
;
ADEU(ADEGBL) ;GET UNIQUE SUBSCRIPT NUMBER AND LOCK REPORT NODE
;RETURNS SUBSCRIPT NUMBER
N ADEU
S ADEU=$J
ADEU1 F L +^TMP(ADEGBL,ADEU):.1 Q:$T S ADEU=ADEU+1
I $G(^TMP(ADEGBL,ADEU))]"" L -^TMP(ADEGBL,ADEU) S ADEU=ADEU+1 G ADEU1
K ^TMP(ADEGBL,ADEU) ;^TMP is a transient report global
S ^TMP(ADEGBL,ADEU)="RUNNING"
Q ADEU
K ADEU ;*NE
ADEPLV ; IHS/HQT/MJL - DENTAL LVL OF SVC ; [ 03/24/1999 9:04 AM ]
+1 ;;6.0;ADE;;APRIL 1999
+2 SET ADEGBL=$$ADEU("ADEPDIR")
+3 SET ADEGBL="^TMP(""ADEPDIR"","_ADEGBL_")"
+4 ;IHS/HMW ADEK Added "Indian"
SET ADETITL=" -- Direct Indian"
+5 SET ADEDIR=1
SET ADECON=0
SET ADEPRO=4
SET ADEPDET=1
SET ADENON=0
+6 ;
START WRITE !!,"Dental Level of Service Report",ADETITL,!!
+1 DO ^XBKVAR
+2 ;
DATE KILL ADEBDT,ADEND
+1 SET U="^"
SET %DT="AXEP"
SET %DT("A")="SELECT BEGINNING DATE: "
+2 DO ^%DT
KILL %DT
+3 IF Y<0
GOTO QUIT
+4 SET ADEBDT=Y
SET %DT="AXEP"
SET %DT(0)=ADEBDT
SET %DT("A")="SELECT ENDING DATE: "
+5 DO ^%DT
KILL %DT
+6 IF X="^"
GOTO DATE
+7 IF Y<0
GOTO QUIT
+8 SET ADEND=Y_".9999"
+9 IF ADEBDT>ADEND
WRITE !,*7,"Beginning date must be before ending date."
GOTO DATE
+10 ;
ASKDEV KILL ADEIOP,IOP,ZTSK,ADEIOPAR
+1 WRITE !!,"Enter 'Q' at the DEVICE prompt to queue this report to run in the background."
+2 SET %ZIS="NQ"
+3 DO ^%ZIS
+4 ;@ADEGBL is a subscripted node
IF POP
LOCK -@ADEGBL
KILL @ADEGBL
GOTO QUIT
+5 ;of ^TMP, a transient report global
+6 SET ADEIOP=ION_";"_IOM_";"_IOSL
+7 SET ADEIOPAR=IOPAR
+8 IF $DATA(IO("Q"))
Begin DoDot:1
+9 DO QUE
+10 LOCK -@ADEGBL
+11 WRITE !,"REQUEST QUEUED."
+12 DO HOME^%ZIS
End DoDot:1
GOTO QUIT
+13 ;
+14 GOTO START^ADEPLV1
+15 ;
QUIT KILL ADEOTYP,ADEBDT,ADEND,ADEOLD,ADEGBL,ADETITL,ADEDIR,ADECON,ADEJ,ADEPRO,ADEPDET,ADENON,ADEIOP,ADEIOPAR
+1 QUIT
+2 ;
QUE NEW ADEJ
+1 SET ZTDESC="DENTAL LEVEL OF CARE RPT"
+2 FOR ADEJ="ADEGBL","ADEND","ADEBDT","ADETITL","ADEDIR","ADECON","ADEPRO","ADEPDET","ADENON","ADEIOP","ADEIOPAR"
SET ZTSAVE(ADEJ)=""
+3 SET ZTRTN="START^ADEPLV1"
+4 SET ZTIO=""
+5 IF $DATA(IO("HFSIO"))
Begin DoDot:1
+6 SET ZTIO=ADEIOP
End DoDot:1
+7 DO ^%ZTLOAD
+8 KILL ADEJ
+9 QUIT
+10 ;
CONTRACT ;EP ENTER HERE FOR CONTRACT SERVICES REPORT
+1 SET ADEGBL=$$ADEU("ADEPCHS")
+2 SET ADEGBL="^TMP(""ADEPCHS"","_ADEGBL_")"
+3 SET ADETITL=" -- Contract"
+4 SET ADEDIR=0
SET ADECON=1
SET ADEPRO=4
SET ADEPDET=1
SET ADENON=0
+5 GOTO START
AUXIL ;EP ENTER HERE FOR AUXILIARY REPORT
+1 SET ADETITL=" -- Auxiliary"
+2 SET ADEGBL=$$ADEU("ADEPAUX")
+3 SET ADEGBL="^TMP(""ADEPAUX"","_ADEGBL_")"
+4 SET ADEDIR=0
SET ADECON=0
SET ADEPRO=5
SET ADEPDET=1
SET ADENON=0
+5 GOTO START
NON ;EP ENTER HERE FOR NON-INDIAN REPORT
+1 SET ADEGBL=$$ADEU("ADEPNON")
+2 SET ADEGBL="^TMP(""ADEPNON"","_ADEGBL_")"
+3 SET ADETITL=" -- Non-Indian"
+4 SET ADEDIR=0
SET ADECON=0
SET ADEPRO=4
SET ADEPDET=0
SET ADENON=1
+5 GOTO START
+6 ;
ADEU(ADEGBL) ;GET UNIQUE SUBSCRIPT NUMBER AND LOCK REPORT NODE
+1 ;RETURNS SUBSCRIPT NUMBER
+2 NEW ADEU
+3 SET ADEU=$JOB
ADEU1 FOR
LOCK +^TMP(ADEGBL,ADEU):.1
IF $TEST
QUIT
SET ADEU=ADEU+1
+1 IF $GET(^TMP(ADEGBL,ADEU))]""
LOCK -^TMP(ADEGBL,ADEU)
SET ADEU=ADEU+1
GOTO ADEU1
+2 ;^TMP is a transient report global
KILL ^TMP(ADEGBL,ADEU)
+3 SET ^TMP(ADEGBL,ADEU)="RUNNING"
+4 QUIT ADEU
+5 ;*NE
KILL ADEU
