105 lines
6.4 KiB
Mathematica
105 lines
6.4 KiB
Mathematica
SCRPW17 ;RENO/KEITH/MRY - Prompts for clinic related outputs ; 21 JUL 2000 1:45 PM
|
|
;;5.3;Scheduling;**139,144,155,222**;AUG 13, 1993
|
|
ASK(SDADD,SDRES,SD,SDFMT,SDORD,SDSDT) ;Ask for clinic report parameters
|
|
;Required input: SDADD='1' to prompt user for "addons", "0" to not ask
|
|
;Required input: SDRES='1' to prompt user for clinic to restart run from, '0' to not ask
|
|
;Required input: SD=array name to return clinic selection parameters
|
|
;Optional input: SDFMT=default format^suppress prompt (1=yes, 0=no)
|
|
;Optional input: SDORD=default print order (A:alphabetic, D:date/time, T:terminal digit)^suppress prompt (1=yes, 0=no)
|
|
;Optional input: SDSDT='1' to suppress date prompt
|
|
;Output: SD("ADDON")=add-ons date, if selected
|
|
; SD("RESTART")="clinic IFN^clinic name" to restart run from, if selected
|
|
; SD("DATE")=appointment date to print
|
|
; SD("CLINIC",clinicname)=clinic IFN
|
|
; SD("FORMAT")=report format (AC:all clinics, SC:selected clinics, RC:range of clinics, SS:selected stop codes, RS:range of stop codes, AG:all clinic groups, SG:selected clinic group)
|
|
; SD("GROUP")="clinic group IFN^clinic group name"
|
|
; SD("ORDER")=output order (A:alphabetic, D:date/time, T:terminal digit)
|
|
; SD("STOPCODE",stopcodenumber)=stop code name
|
|
;Output: '0' if abnormal exit occured, '1' otherwise
|
|
;
|
|
N %DT,SDCL1,SDCL2,SDDICA,SDI,SDOUT,SDSC1,SDSC2,DIC,DIR,DTOUT,DUOUT,X,Y
|
|
DT I $G(SDSDT) S SD("DATE")="" G ADD
|
|
S %DT="AEFX",%DT("A")="Select Appointment Date to Print: " W ! D ^%DT Q:(Y'>0!$D(DTOUT)) 0 S SD("DATE")=$P(Y,".")
|
|
ADD I SDADD K SD("ADDON"),DIR S DIR(0)="S^A:ALL;O:ONLY ADD-ONS",DIR("A")="Include (A)LL or (O)NLY ADD-ONS",DIR("B")="ALL" D ^DIR Q:($D(DTOUT)!$D(DUOUT)) 0 I Y="O" D ADDON Q:'$D(SD("ADDON")) 0
|
|
I SDRES K SD("RESTART"),DIR S DIR(0)="Y",DIR("A")="Would you like to re-start output from specific clinic",DIR("B")="NO" W ! D ^DIR Q:($D(DTOUT)!$D(DUOUT)) 0 I Y D CLIN Q:'$D(SD("RESTART")) 0
|
|
I $L($G(SDFMT)),$P(SDFMT,U,2)=1 S SD("FORMAT")=$P(SDFMT,U) G ORD
|
|
K DIR I $L($G(SDFMT)) S DIR("B")=$S(SDFMT="AC":"ALL CLINICS",SDFMT="SC":"SELECTED CLINICS",SDFMT="RC":"RANGE OF CLINICS",SDFMT="AG":"ALL CLINIC GROUPS",SDFMT="SG":"SELECTED CLINIC GROUP",1:"")
|
|
I $L($G(SDFMT)) S DIR("B")=$S(SDFMT="SS":"SELECTED STOP CODES",SDFMT="RS":"RANGE OF STOP CODES",1:DIR("B")) K:'$L(DIR("B")) DIR("B")
|
|
S DIR(0)="S^AC:ALL CLINICS;SC:SELECTED CLINICS;RC:RANGE OF CLINICS;SS:SELECTED STOP CODES;RS:RANGE OF STOP CODES;AG:ALL CLINIC GROUPS;SG:SELECTED CLINIC GROUP",DIR("A")="Select report format"
|
|
D ^DIR Q:$D(DTOUT)!$D(DUOUT) 0 S SD("FORMAT")=Y
|
|
K SD("CLINIC") I "SC^RC"[SD("FORMAT") D @SD("FORMAT") Q:'$D(SD("CLINIC")) 0
|
|
I "SS^RS"[SD("FORMAT") K SD("STOPCODE") D @SD("FORMAT") Q:'$D(SD("STOPCODE")) 0
|
|
I SD("FORMAT")="SG" K SD("GROUP") D SG Q:'$D(SD("GROUP")) 0
|
|
ORD I $P($G(SDORD),U,2)=1,$L($P(SDORD,U)),"ADT"[$P(SDORD,U) S SD("ORDER")=$P(SDORD,U) G END
|
|
K DIR S DIR(0)="S^A:ALPHABETIC;D:DATE/TIME;T:TERMINAL DIGIT",DIR("A")="Within clinic, print patients in what order"
|
|
I $L($P($G(SDORD),U)) S SDORD=$P(SDORD,U),SDORD=$S(SDORD="A":"ALPHABETIC",SDORD="D":"DATE/TIME",SDORD="T":"TERMINAL DIGIT",1:"")
|
|
S:$L($G(SDORD)) DIR("B")=SDORD D ^DIR Q:$D(DTOUT)!$D(DUOUT) 0 S SD("ORDER")=Y
|
|
END Q 1
|
|
;
|
|
CLIN S DIC="^SC(",DIC(0)="AEMQZ",DIC("A")="Select CLINIC: " W ! D ^DIC Q:($D(DTOUT)!$D(DUOUT)) I $P(Y(0),U,3)'="C" W !!,$C(7),"Location selected must be a clinic!",! G CLIN
|
|
S:+Y>0 SD("RESTART")=Y Q
|
|
;
|
|
ADDON K DIR S DIR(0)="D^::AEPX",%DT("A")="Produce output for patients scheduled since what date?",DIR("?",1)="Enter the date of your initial run of this appointment date, that way only"
|
|
S DIR("?")="appointments scheduled since that date will be included in this run." D ^DIR Q:$D(DTOUT)!$D(DUOUT) S:Y>0 SD("ADDON")=Y Q
|
|
;
|
|
SC ;Clinic selector
|
|
S SDOUT=0 F SDI=1:1:30 S SDCL1=$$SC1("Select CLINIC: ") Q:SDOUT
|
|
Q
|
|
;
|
|
RC ;Clinic range selector
|
|
S SDCL1=$$SC1("Select beginning CLINIC: ") Q:'$L(SDCL1)
|
|
RCE S SDCL2=$$SC1("Select ending CLINIC: ") I '$L(SDCL2) W !,"Ending clinic must be specified!" K SD("CLINIC") Q
|
|
I SDCL2']SDCL1 K SD("CLINIC",SDCL2) W !!,$C(7),"Ending clinic must collate after beginning clinic!" G RCE
|
|
Q
|
|
;
|
|
SS ;Stop Code selector
|
|
S SDOUT=0 F SDI=1:1:30 S SDSC1=$$SS1("Select STOP CODE: ") Q:SDOUT
|
|
Q
|
|
;
|
|
RS ;Stop Code range selector
|
|
S SDSC1=$$SS1("Select beginning STOP CODE: ") Q:'$L(SDSC1)
|
|
RSE S SDSC2=$$SS1("Select ending STOP CODE: ") I '$L(SDSC2) W !,"Ending Stop Code must be specified!" K SD("STOPCODE") Q
|
|
I SDSC2']SDSC1 K SD("STOPCODE",SDSC2) W !!,$C(7),"Ending Stop Code must collate after beginning Stop Code!" G RSE
|
|
Q
|
|
;
|
|
SS1(SDDICA) ;Select a Stop Code
|
|
SS2 K DIC S DIC("A")=SDDICA,DIC="^DIC(40.7,",DIC(0)="AEMQZ" D ^DIC I $D(DTOUT)!$D(DUOUT)!(X="") S SDOUT=1 Q ""
|
|
I '$P(Y(0),U,2) W $C(7)," ???" G SS2
|
|
I $P(Y(0),U,3),$P(Y(0),U,3)'>DT W !,"Only active Stop Codes can be selected!",! G SS2
|
|
S SD("STOPCODE",$P(Y(0),U,2))=$P(Y,U,2) Q $P(Y(0),U,2)
|
|
;
|
|
SG ;Select clinic group
|
|
K DIC S DIC="^SD(409.67,",DIC(0)="AEMQ" D ^DIC Q:$D(DTOUT)!$D(DUOUT) S:+Y>0 SD("GROUP")=Y Q
|
|
;
|
|
SC1(SDDICA) ;Select a clinic
|
|
SC2 K DIC S DIC("A")=SDDICA,DIC="^SC(",DIC(0)="AEMQZ" D ^DIC I $D(DTOUT)!$D(DUOUT)!(X="") S SDOUT=1 Q ""
|
|
I $P(Y(0),U,3)'="C" W !,"Location selected must be a clinic!",! G SC2
|
|
S SD("CLINIC",$P(Y,U,2))=$P(Y,U) Q $P(Y,U,2)
|
|
;
|
|
DIVA(SDDIV) ;Ask for division(s)
|
|
;Required input: SDDIV=array to return responses (pass by reference)
|
|
;Output: '1' if successful, '0' if not
|
|
;Output: SDDIV='0' if 'all', '1' if specific divisions^text: "all" or institution name^division ifn, for non-multidivisional
|
|
;Output: SDDIV(division ifn)=division name
|
|
N SDX,SDOUT S SDOUT=0 K SDDIV
|
|
S SDX=$G(^DG(43,1,"GL")) I '$$PRIM^VASITE() W !!,$C(7),"No medical center defined in site parameters!" Q 0
|
|
I '$P(SDX,U,2) S SDDIV="0^"_$P($G(^DG(40.8,$$PRIM^VASITE(),0)),U)_U_$$PRIM^VASITE() Q 1
|
|
F SDX=1:1 D DIVA1 Q:SDOUT
|
|
I $D(SDDIV)>1 S SDDIV="1^SELECTED DIVISIONS" Q 1
|
|
Q $D(SDDIV)
|
|
;
|
|
DIVA1 N DIC W ! S DIC="^DG(40.8,",DIC(0)="AEMQ",DIC("A")=$S(SDX=1:"For Medical Center Division: ALL// ",1:"Select another division: ")
|
|
D ^DIC I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
|
|
I SDX=1,X="" S SDOUT=1,SDDIV="0^ALL DIVISIONS" Q
|
|
I X="" S SDOUT=1 Q
|
|
I Y>0 S SDDIV(+Y)=$P(Y,U,2)
|
|
Q
|
|
;
|
|
ERRSUB(SDX) ;Return substitute error message for ^SD(409.76) entry
|
|
;Required input: SDX=external message code from ^SD(409.76) file
|
|
;Output: Substitute error message if successful, null if not
|
|
Q $P($T(@("Z"_SDX)),";",3)
|
|
;
|
|
;Substitute error messages for ^SD(409.76)
|
|
Z0009 ;0009;No Procedures defined for encounter (PR1 segment)
|