- 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 Feb 19, 2025@00:14:25 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 ;