- 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 Feb 19, 2025@00:05:50 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