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