Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDAMOL

SDAMOL.m

Go to the documentation of this file. 
  1. SDAMOL ;ALB/CAW - Retroactive Appt. List; 4/15/92
  1.  ;;5.3;Scheduling;**132**;Aug 13, 1993
  1.  ;
  1.  ;
  1. EN ; main entry point
  1.  ;
  1.  N DIC,SDBEG,SDEND,SDBD,SDED,SDSEL,VAUTD,VAUTC,VAUTS,SDNPDB
  1.  I '$$INIT G ENQ
  1.  I '$$NPDB G ENQ
  1.  I '$$RANGE() G ENQ
  1.  I '$$DIV() G ENQ
  1.  I '$$SELECT() G ENQ
  1.  I SDSEL=1,'$$STOP() G ENQ
  1.  I SDSEL=2,'$$CLINIC() G ENQ
  1.  W !! S %ZIS="PMQ" D ^%ZIS I POP G ENQ
  1.  I '$D(IO("Q")) D MAIN^SDAMOL1 G ENQ
  1.  S Y=$$QUE
  1. ENQ D:'$D(ZTQUEUED) ^%ZISC
  1.  K ^TMP("SDRL",$J),^TMP("SDRAL",$J)
  1.  Q
  1.  ;
  1. INIT() ; -- init vars
  1.  S SDDIV=0
  1.  Q 1
  1.  ;
  1. RANGE() ; select date range
  1.  ;  input: none
  1.  ; output: SDBEG := begin date
  1.  ;         SDEND := end date
  1.  ; return: was selection made [ 1|yes   0|no]
  1.  ;
  1.  W !!,$$LINE("Date Range Selection")
  1.  N BEGDATE,ENDDATE
  1.  S (SDBEG,SDEND)=0
  1.  S SDT00="AEX" D DATE^SDUTL I $D(SDED) S SDBEG=SDBD,SDEND=SDED+.2359
  1.  Q SDEND
  1. DIV() ; -- get division data
  1.  ;  input: none
  1.  ; output: VAUTD := divs selected (VAUTD=1 for all)
  1.  ; return: was selection made [ 1|yes   0|no]
  1.  ;
  1.  W !!,$$LINE("Division Selection")
  1.  D ASK2^SDDIV I Y<0 K VAUTD
  1.  Q $D(VAUTD)>0
  1. STOP() ; -- get stop code data
  1.  ;  input: none
  1.  ; output: VAUTS := stop codes selected (VAUTS=1 for all)
  1.  ; return: was selection made [ 1|yes   0|no]
  1.  ;
  1.  W !!,$$LINE("Stop Code Selection")
  1.  S VAUTSTR="Stop Code",VAUTNI=2,VAUTVB="VAUTS"
  1.  S DIC="^DIC(40.7,",DIC(0)="AEMQZ",DIC("S")="I $P(^(0),U,3)="""""
  1.  D FIRST^VAUTOMA I Y<0 K VAUTS
  1.  Q $D(VAUTS)>0
  1. SELECT() ; -- get selection criteria
  1.  ;  input: none
  1.  ; output: SDSEL := criteria selected
  1.  ; return: was selection made [ 1|yes   0|no]
  1.  ;
  1.  W !!,$$LINE("Visit Selection Criteria")
  1.  S DIR(0)="S^1:Stop Code(s);2:Clinic(s)"
  1.  S DIR("A")="Find Visits By",DIR("B")="Stop Code(s)"
  1.  D ^DIR K DIR S SDSEL=$S($D(DIRUT):0,1:+Y)
  1.  Q SDSEL>0
  1.  ;
  1. CLINIC() ; -- get clinic data
  1.  ;  input: VAUTD  := divisions selected
  1.  ; output: VAUTC := clinic selected (VAUTC=1 for all)
  1.  ; return: was selection made [ 1|yes   0|no]
  1.  ;
  1.  W !!,$$LINE("Clinic Selection")
  1.  D CLINIC^SDAMO0
  1.  I Y<0 K VAUTC
  1. CLINICQ Q $D(VAUTC)>0
  1.  ;
  1. NPDB() ; -- get which type of database check (credit or database)
  1.  ;  input: none
  1.  ; output: SDNPDB -- type of database check [WORLOAD | DATABASE]
  1.  ; return: was selection made [ 1|yes   0|no]
  1.  ;
  1.  W !!,$$LINE("NPDB Close-Out Check Selection")
  1.  S DIR(0)="S^D:Database Update Only;W:Workload Credit"
  1.  S DIR("A")="Type of Close-Out Check",DIR("B")="Workload Credit"
  1.  D ^DIR K DIR
  1.  ;
  1.  ; -- set piece number related to CLOSEOUT^SCDXFU04 call or 0
  1.  S SDNPDB=$S($D(DIRUT):0,Y="D":1,Y="W":2,1:0)
  1.  Q SDNPDB>0
  1.  ;
  1. LINE(STR) ; -- print line
  1.  ;  input: STR := text to insert
  1.  ; output: none
  1.  ; return: text to use
  1.  ;
  1.  N X
  1.  S:STR]"" STR=" "_STR_" "
  1.  S $P(X,"_",(IOM/2)-($L(STR)/2))=""
  1.  Q X_STR_X
  1.  ;
  1. QUE() ; -- que job
  1.  ; return: did job que [ 1|yes   0|no ]
  1.  ;
  1.  K ZTSK,IO("Q")
  1.  S ZTDESC="Retroactive Appointment List",ZTRTN="MAIN^SDAMOL1"
  1.  F X="VAUTD(","SDBEG","SDEND","VAUTD","VAUTC","VAUTC(","VAUTS","VAUTS(","SDSEL","SDBD","SDED","SDNPDB" S ZTSAVE(X)=""
  1.  D ^%ZTLOAD W:$D(ZTSK) "   (Task: ",ZTSK,")"
  1.  Q $D(ZTSK)
  1.  ;