- ADEPV ; IHS/HQT/MJL - VISIT REPORTS ;03:28 PM [ 03/24/1999 9:04 AM ]
- ;;6.0;ADE;;APRIL 1999
- W !!,"Do not enter from top!",!! G QUIT
- 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 scratch 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^ADEPV1
- ;
- QUIT K ADEOTYP,ADEOPT,ADEBDT,ADEND,ADEOLD,ADEGBL,ADETITL,ZTSK,ADEJ Q
- ;
- QUE N ADEJ
- S ZTRTN="START^ADEPV1"
- S ZTDESC="DENTAL SERVICE VISIT RPT"
- F ADEJ="ADEND","ADEBDT","ADEGBL","ADETITL","ADEIOP","ADEIOPAR" S ZTSAVE(ADEJ)=""
- S ZTIO=""
- I $D(IO("HFSIO")) D
- . S ZTIO=ADEIOP
- D ^%ZTLOAD
- K ADEJ
- Q
- ;
- FACILITY ;EP
- ;Enter Here to print Dental Visits by Facility
- S ADEGBL=$$ADEU("ADEPFAC")
- S ADEGBL="^TMP(""ADEPFAC"","_ADEGBL_")"
- S ADETITL="FACILITY VISIT REPORT"
- G DATE
- COMMUN ;EP
- ;Enter here to print Dental Visits by Community
- S ADEGBL=$$ADEU("ADEPCOM")
- S ADEGBL="^TMP(""ADEPCOM"","_ADEGBL_")"
- S ADETITL="COMMUNITY VISIT REPORT"
- G DATE
- TRIBE ;EP
- ;Enter here to print Dental Visits by Tribe
- S ADEGBL=$$ADEU("ADEPTRIB")
- S ADEGBL="^TMP(""ADEPTRIB"","_ADEGBL_")"
- S ADETITL="TRIBAL VISIT REPORT"
- G DATE
- ;
- 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
- ZZ K ADEU ;*NE
- ADEPV ; IHS/HQT/MJL - VISIT REPORTS ;03:28 PM [ 03/24/1999 9:04 AM ]
- +1 ;;6.0;ADE;;APRIL 1999
- +2 WRITE !!,"Do not enter from top!",!!
- GOTO QUIT
- +3 DO ^XBKVAR
- 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
- SET ADEND=Y_".9999"
- +8 IF ADEBDT>ADEND
- WRITE !,*7,"Beginning date must be before ending date."
- GOTO DATE
- +9 ;
- 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 scratch global
- IF POP
- LOCK -@ADEGBL
- KILL @ADEGBL
- GOTO QUIT
- +5 SET ADEIOP=ION_";"_IOM_";"_IOSL
- +6 SET ADEIOPAR=IOPAR
- +7 IF $DATA(IO("Q"))
- Begin DoDot:1
- +8 DO QUE
- +9 LOCK -@ADEGBL
- +10 WRITE !,"REQUEST QUEUED."
- +11 DO HOME^%ZIS
- End DoDot:1
- GOTO QUIT
- +12 ;
- +13 GOTO START^ADEPV1
- +14 ;
- QUIT KILL ADEOTYP,ADEOPT,ADEBDT,ADEND,ADEOLD,ADEGBL,ADETITL,ZTSK,ADEJ
- QUIT
- +1 ;
- QUE NEW ADEJ
- +1 SET ZTRTN="START^ADEPV1"
- +2 SET ZTDESC="DENTAL SERVICE VISIT RPT"
- +3 FOR ADEJ="ADEND","ADEBDT","ADEGBL","ADETITL","ADEIOP","ADEIOPAR"
- SET ZTSAVE(ADEJ)=""
- +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 ;
- FACILITY ;EP
- +1 ;Enter Here to print Dental Visits by Facility
- +2 SET ADEGBL=$$ADEU("ADEPFAC")
- +3 SET ADEGBL="^TMP(""ADEPFAC"","_ADEGBL_")"
- +4 SET ADETITL="FACILITY VISIT REPORT"
- +5 GOTO DATE
- COMMUN ;EP
- +1 ;Enter here to print Dental Visits by Community
- +2 SET ADEGBL=$$ADEU("ADEPCOM")
- +3 SET ADEGBL="^TMP(""ADEPCOM"","_ADEGBL_")"
- +4 SET ADETITL="COMMUNITY VISIT REPORT"
- +5 GOTO DATE
- TRIBE ;EP
- +1 ;Enter here to print Dental Visits by Tribe
- +2 SET ADEGBL=$$ADEU("ADEPTRIB")
- +3 SET ADEGBL="^TMP(""ADEPTRIB"","_ADEGBL_")"
- +4 SET ADETITL="TRIBAL VISIT REPORT"
- +5 GOTO DATE
- +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
- ZZ ;*NE
- KILL ADEU
