ADEPV.m

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