- 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
