SCDXPOV2 ;ALB/SCK - VISIT REPORT BY NPCDB TRANSMISSION STATUS ; 10/31/96
;;5.S;Scheduling;**73**;Aug 13, 1993
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCDXPOV2 2261 printed Apr 09, 2024@22:04:01 Page 2
SCDXPOV2 ;ALB/SCK - VISIT REPORT BY NPCDB TRANSMISSION STATUS ; 10/31/96
+1 ;;5.S;Scheduling;**73**;Aug 13, 1993
+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
