| 1 | SCDXPOV2 ;ALB/SCK - VISIT REPORT BY NPCDB TRANSMISSION STATUS ; 10/31/96
 | 
|---|
| 2 |  ;;5.S;Scheduling;**73**;Aug 13, 1993
 | 
|---|
| 3 |  Q
 | 
|---|
| 4 | GETDATE(CAPTION) ;  Get and return a date value
 | 
|---|
| 5 |  ;  Input:
 | 
|---|
| 6 |  ;     Caption  -  Prompt to be displayed in reader call
 | 
|---|
| 7 |  ;
 | 
|---|
| 8 |  D NOW^%DTC S Y=X D DD^%DT
 | 
|---|
| 9 |  S DIR(0)="DA^::EP",DIR("A")=CAPTION,DIR("B")=Y,DIR("??")="^D HELP^%DTC"
 | 
|---|
| 10 |  D ^DIR K DIR
 | 
|---|
| 11 |  S:$D(DIRUT) Y=-1
 | 
|---|
| 12 |  D CLEAR
 | 
|---|
| 13 |  Q Y
 | 
|---|
| 14 |  ;
 | 
|---|
| 15 | SHWTOT() ; Selects wether only the grand total page is shown
 | 
|---|
| 16 |  S DIR(0)="YA",DIR("A")="PRINT FACILITY TOTAL ONLY? ",DIR("B")="NO"
 | 
|---|
| 17 |  S DIR("A",2)="THIS IS A MULTI-DIVISIONAL FACILITY.",DIR("A",1)=""
 | 
|---|
| 18 |  S DIR("?")="IF YOU ANSWER YES (Y), YOU WILL GIVEN THE FACILITY TOTAL ONLY."
 | 
|---|
| 19 |  D ^DIR K DIR
 | 
|---|
| 20 |  S:$D(DIRUT) Y=-1
 | 
|---|
| 21 |  D CLEAR
 | 
|---|
| 22 |  Q Y
 | 
|---|
| 23 |  ;
 | 
|---|
| 24 | RPTOPT() ; Selects which parts of the report are shown
 | 
|---|
| 25 |  S DIR(0)="S^1:TRANSMISSION STATUS ONLY;2:VISIT COUNT;3:BOTH"
 | 
|---|
| 26 |  S DIR("A")="SELECT REPORT OPTION",DIR("B")=3
 | 
|---|
| 27 |  D ^DIR K DIR
 | 
|---|
| 28 |  S:$D(DIRUT) Y=-1
 | 
|---|
| 29 |  D CLEAR
 | 
|---|
| 30 |  Q Y
 | 
|---|
| 31 |  ;
 | 
|---|
| 32 | QUE ;  Sets up the report for queueing
 | 
|---|
| 33 |  N LV
 | 
|---|
| 34 |  S ZTRTN="START^SCDXPOV"
 | 
|---|
| 35 |  S ZTDESCR="VISIT REPORT, TRANSMISSION STATUS TO NPCDB"
 | 
|---|
| 36 |  F LV="SCXOPT","SCXBEG","SCXEND","SCXMD","SCXTFLG" S ZTSAVE(LV)=""
 | 
|---|
| 37 |  D ^%ZTLOAD W:$D(ZTSK) !,"TASK #: ",ZTSK
 | 
|---|
| 38 |  D HOME^%ZIS K IO("Q")
 | 
|---|
| 39 |  Q
 | 
|---|
| 40 | CHKELG(SCELG) ; checks for inactive entries in the ELIGIBILTIT CODE File, #8
 | 
|---|
| 41 |  ;
 | 
|---|
| 42 |  Q +$P($G(^DIC(8,SCELG,0)),U,7)
 | 
|---|
| 43 |  ;
 | 
|---|
| 44 | ELGPRI(SCEL,SCCUR) ; Returns whether heirarchy level of eligibility should change
 | 
|---|
| 45 |  ;   Input
 | 
|---|
| 46 |  ;      SCEL - Eligibility
 | 
|---|
| 47 |  ;      SCCUR - Current Hierarchy level
 | 
|---|
| 48 |  ;   Returns  
 | 
|---|
| 49 |  ;      SCPRI = 1 Change current hierarchy to new
 | 
|---|
| 50 |  ;      SCPRI = 0 Do not change
 | 
|---|
| 51 |  ;
 | 
|---|
| 52 |  N SCPRI,SCNEW
 | 
|---|
| 53 |  S SCPRI=4,SCNEW=+$P($G(^DIC(8,SCEL,0)),U,9)
 | 
|---|
| 54 |  S:SCNEW=1!(SCNEW=3) SCPRI=1
 | 
|---|
| 55 |  S:SCNEW=2!(SCNEW=15)!(SCNEW=16)!(SCNEW=17)!(SCNEW=18) SCPRI=2
 | 
|---|
| 56 |  S:SCNEW=4!(SCNEW=5) SCPRI=3
 | 
|---|
| 57 |  Q SCPRI_U_(SCPRI<SCCUR)
 | 
|---|
| 58 |  ;
 | 
|---|
| 59 | COVPRI(SCNEW,SCCUR) ; Returns whether heirarchy level of visit should change
 | 
|---|
| 60 |  ;   Input
 | 
|---|
| 61 |  ;      SCNEW - Eligibility
 | 
|---|
| 62 |  ;      SCCUR - Current Hierarchy level
 | 
|---|
| 63 |  ;   Returns  
 | 
|---|
| 64 |  ;      SCPRI = 1 Change current hierarchy to new
 | 
|---|
| 65 |  ;      SCPRI = 0 Do not change
 | 
|---|
| 66 |  ;
 | 
|---|
| 67 |  N SCPRI
 | 
|---|
| 68 |  S SCPRI=3
 | 
|---|
| 69 |  S:SCNEW=1 SCPRI=2
 | 
|---|
| 70 |  S:SCNEW=2 SCPRI=3
 | 
|---|
| 71 |  S:SCNEW=3 SCPRI=1
 | 
|---|
| 72 |  Q SCPRI_U_(SCPRI<SCCUR)
 | 
|---|
| 73 |  ;
 | 
|---|
| 74 | CLEAR ;  Clear DIR variables
 | 
|---|
| 75 |  K DIR,DTOUT,DUOUT,DIRUT,DIROUT
 | 
|---|
| 76 |  Q
 | 
|---|