SCDXPOV2.m

SCDXPOV2 ;ALB/SCK - VISIT REPORT BY NPCDB TRANSMISSION STATUS ; 10/31/96

 ;;5.3;Scheduling;**73,1015**;Aug 13, 1993;Build 21

 Q

GETDATE(CAPTION) ;  Get and return a date value

 ;  Input:

 ;     Caption  -  Prompt to be displayed in reader call

 ;

 D NOW^%DTC S Y=X D DD^%DT

 S DIR(0)="DA^::EP",DIR("A")=CAPTION,DIR("B")=Y,DIR("??")="^D HELP^%DTC"

 D ^DIR K DIR

 S:$D(DIRUT) Y=-1

 D CLEAR

 Q Y

 ;

SHWTOT() ; Selects wether only the grand total page is shown

 S DIR(0)="YA",DIR("A")="PRINT FACILITY TOTAL ONLY? ",DIR("B")="NO"

 S DIR("A",2)="THIS IS A MULTI-DIVISIONAL FACILITY.",DIR("A",1)=""

 S DIR("?")="IF YOU ANSWER YES (Y), YOU WILL GIVEN THE FACILITY TOTAL ONLY."

 D ^DIR K DIR

 S:$D(DIRUT) Y=-1

 D CLEAR

 Q Y

 ;

RPTOPT() ; Selects which parts of the report are shown

 S DIR(0)="S^1:TRANSMISSION STATUS ONLY;2:VISIT COUNT;3:BOTH"

 S DIR("A")="SELECT REPORT OPTION",DIR("B")=3

 D ^DIR K DIR

 S:$D(DIRUT) Y=-1

 D CLEAR

 Q Y

 ;

QUE ;  Sets up the report for queueing

 N LV

 S ZTRTN="START^SCDXPOV"

 S ZTDESCR="VISIT REPORT, TRANSMISSION STATUS TO NPCDB"

 F LV="SCXOPT","SCXBEG","SCXEND","SCXMD","SCXTFLG" S ZTSAVE(LV)=""

 D ^%ZTLOAD W:$D(ZTSK) !,"TASK #: ",ZTSK

 D HOME^%ZIS K IO("Q")

 Q

CHKELG(SCELG) ; checks for inactive entries in the ELIGIBILTIT CODE File, #8

 ;

 Q +$P($G(^DIC(8,SCELG,0)),U,7)

 ;

ELGPRI(SCEL,SCCUR) ; Returns whether heirarchy level of eligibility should change

 ;   Input

 ;      SCEL - Eligibility

 ;      SCCUR - Current Hierarchy level

 ;   Returns  

 ;      SCPRI = 1 Change current hierarchy to new

 ;      SCPRI = 0 Do not change

 ;

 N SCPRI,SCNEW

 S SCPRI=4,SCNEW=+$P($G(^DIC(8,SCEL,0)),U,9)

 S:SCNEW=1!(SCNEW=3) SCPRI=1

 S:SCNEW=2!(SCNEW=15)!(SCNEW=16)!(SCNEW=17)!(SCNEW=18) SCPRI=2

 S:SCNEW=4!(SCNEW=5) SCPRI=3

 Q SCPRI_U_(SCPRI<SCCUR)

 ;

COVPRI(SCNEW,SCCUR) ; Returns whether heirarchy level of visit should change

 ;   Input

 ;      SCNEW - Eligibility

 ;      SCCUR - Current Hierarchy level

 ;   Returns  

 ;      SCPRI = 1 Change current hierarchy to new

 ;      SCPRI = 0 Do not change

 ;

 N SCPRI

 S SCPRI=3

 S:SCNEW=1 SCPRI=2

 S:SCNEW=2 SCPRI=3

 S:SCNEW=3 SCPRI=1

 Q SCPRI_U_(SCPRI<SCCUR)

 ;

CLEAR ;  Clear DIR variables

 K DIR,DTOUT,DUOUT,DIRUT,DIROUT

 Q

SCDXPOV2  ;ALB/SCK - VISIT REPORT BY NPCDB TRANSMISSION STATUS ; 10/31/96

 +1       ;;5.3;Scheduling;**73,1015**;Aug 13, 1993;Build 21

 +2        QUIT 

GETDATE(CAPTION) ;  Get and return a date value

 +1       ;  Input:

 +2       ;     Caption  -  Prompt to be displayed in reader call

 +3       ;

 +4        DO NOW^%DTC

           SET Y=X

           DO DD^%DT

 +5        SET DIR(0)="DA^::EP"

           SET DIR("A")=CAPTION

           SET DIR("B")=Y

           SET DIR("??")="^D HELP^%DTC"

 +6        DO ^DIR

           KILL DIR

 +7        IF $DATA(DIRUT)

               SET Y=-1

 +8        DO CLEAR

 +9        QUIT Y

 +10      ;

SHWTOT()  ; Selects wether only the grand total page is shown

 +1        SET DIR(0)="YA"

           SET DIR("A")="PRINT FACILITY TOTAL ONLY? "

           SET DIR("B")="NO"

 +2        SET DIR("A",2)="THIS IS A MULTI-DIVISIONAL FACILITY."

           SET DIR("A",1)=""

 +3        SET DIR("?")="IF YOU ANSWER YES (Y), YOU WILL GIVEN THE FACILITY TOTAL ONLY."

 +4        DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               SET Y=-1

 +6        DO CLEAR

 +7        QUIT Y

 +8       ;

RPTOPT()  ; Selects which parts of the report are shown

 +1        SET DIR(0)="S^1:TRANSMISSION STATUS ONLY;2:VISIT COUNT;3:BOTH"

 +2        SET DIR("A")="SELECT REPORT OPTION"

           SET DIR("B")=3

 +3        DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               SET Y=-1

 +5        DO CLEAR

 +6        QUIT Y

 +7       ;

QUE       ;  Sets up the report for queueing

 +1        NEW LV

 +2        SET ZTRTN="START^SCDXPOV"

 +3        SET ZTDESCR="VISIT REPORT, TRANSMISSION STATUS TO NPCDB"

 +4        FOR LV="SCXOPT","SCXBEG","SCXEND","SCXMD","SCXTFLG"

               SET ZTSAVE(LV)=""

 +5        DO ^%ZTLOAD

           IF $DATA(ZTSK)

               WRITE !,"TASK #: ",ZTSK

 +6        DO HOME^%ZIS

           KILL IO("Q")

 +7        QUIT 

CHKELG(SCELG) ; checks for inactive entries in the ELIGIBILTIT CODE File, #8

 +1       ;

 +2        QUIT +$PIECE($GET(^DIC(8,SCELG,0)),U,7)

 +3       ;

ELGPRI(SCEL,SCCUR) ; Returns whether heirarchy level of eligibility should change

 +1       ;   Input

 +2       ;      SCEL - Eligibility

 +3       ;      SCCUR - Current Hierarchy level

 +4       ;   Returns  

 +5       ;      SCPRI = 1 Change current hierarchy to new

 +6       ;      SCPRI = 0 Do not change

 +7       ;

 +8        NEW SCPRI,SCNEW

 +9        SET SCPRI=4

           SET SCNEW=+$PIECE($GET(^DIC(8,SCEL,0)),U,9)

 +10       IF SCNEW=1!(SCNEW=3)

               SET SCPRI=1

 +11       IF SCNEW=2!(SCNEW=15)!(SCNEW=16)!(SCNEW=17)!(SCNEW=18)

               SET SCPRI=2

 +12       IF SCNEW=4!(SCNEW=5)

               SET SCPRI=3

 +13       QUIT SCPRI_U_(SCPRI<SCCUR)

 +14      ;

COVPRI(SCNEW,SCCUR) ; Returns whether heirarchy level of visit should change

 +1       ;   Input

 +2       ;      SCNEW - Eligibility

 +3       ;      SCCUR - Current Hierarchy level

 +4       ;   Returns  

 +5       ;      SCPRI = 1 Change current hierarchy to new

 +6       ;      SCPRI = 0 Do not change

 +7       ;

 +8        NEW SCPRI

 +9        SET SCPRI=3

 +10       IF SCNEW=1

               SET SCPRI=2

 +11       IF SCNEW=2

               SET SCPRI=3

 +12       IF SCNEW=3

               SET SCPRI=1

 +13       QUIT SCPRI_U_(SCPRI<SCCUR)

 +14      ;

CLEAR     ;  Clear DIR variables

 +1        KILL DIR,DTOUT,DUOUT,DIRUT,DIROUT

 +2        QUIT