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